File Coverage

blib/lib/Lab/Moose/DataFile/Read.pm
Criterion Covered Total %
statement 65 70 92.8
branch 16 26 61.5
condition 2 3 66.6
subroutine 13 13 100.0
pod 1 2 50.0
total 97 114 85.0


line stmt bran cond sub pod time code
1             package Lab::Moose::DataFile::Read;
2             $Lab::Moose::DataFile::Read::VERSION = '3.881';
3             #ABSTRACT: Read a gnuplot-style 2D data file
4              
5 6     6   2592105 use v5.20;
  6         72  
6              
7 6     6   46 use warnings;
  6         13  
  6         195  
8 6     6   33 use strict;
  6         14  
  6         151  
9 6     6   34 use MooseX::Params::Validate 'validated_list';
  6         17  
  6         50  
10 6     6   1577 use Moose::Util::TypeConstraints 'enum';
  6         15  
  6         52  
11 6     6   2897 use List::Util qw//;
  6         22  
  6         124  
12 6     6   38 use PDL;
  6         22  
  6         66  
13              
14             #use PDL::Core qw/pdl cat dog/;
15 6     6   21943 use Fcntl 'SEEK_SET';
  6         14  
  6         295  
16 6     6   39 use Carp;
  6         17  
  6         270  
17 6     6   50 use Exporter 'import';
  6         15  
  6         224  
18 6     6   2103 use Data::Dumper;
  6         20019  
  6         4454  
19              
20             our @EXPORT = qw/read_gnuplot_format/;
21              
22              
23             # produce 2D PDL for each block. Cat them into a 3d PDL
24             sub get_blocks {
25 2     2 0 24 my ( $fh, $num_columns ) = validated_list(
26             \@_,
27             fh => { isa => 'FileHandle', optional => 1 },
28             num_columns => { isa => 'Int' },
29             );
30              
31 2         914 my @blocks;
32             my @rows;
33 2         62 while ( my $line = <$fh> ) {
34 15 100       45 if ( $line =~ /^#/ ) {
35 2         11 next;
36             }
37 13 100       41 if ( $line =~ /^\s*$/ ) {
38              
39             # Finish block. Need check for number of rows if we have
40             # multiple subsequent blank lines
41 2 50       6 if ( @rows > 0 ) {
42              
43             # Give \@rows, not @rows to get a 2D piddle if we
44             # only have a single row.
45 2         11 push @blocks, pdl( \@rows );
46 2         342 @rows = ();
47             }
48 2         22 next;
49             }
50              
51             # awk splitting behaviour
52 11         32 my @nums = split( ' ', $line );
53 11 50       26 if ( @nums != $num_columns ) {
54 0         0 die "num cols not $num_columns";
55             }
56 11         65 push @rows, [@nums];
57             }
58 2 50       11 if ( @rows > 0 ) {
59 2         9 push @blocks, pdl( \@rows );
60             }
61              
62             # bring blocks to same number of rows: reshape and add NaNs.
63 2         281 my $max_rows = List::Util::max( map { ( $_->dims )[1] } @blocks );
  4         24  
64              
65 2         7 for my $block (@blocks) {
66 4         130 my $rows = ( $block->dims() )[1];
67 4 100       18 if ( $rows < $max_rows ) {
68 2         9 $block->reshape( $num_columns, $max_rows );
69 2         455 $block->slice(":,${rows}:-1") .= "NaN";
70             }
71             }
72              
73 2         9 return PDL::cat(@blocks);
74             }
75              
76             sub read_gnuplot_format {
77 2     2 1 2675 my ( $type, $fh, $file, $num_columns ) = validated_list(
78             \@_,
79             type => { isa => enum( [qw/columns maps bare/] ) },
80             fh => { isa => 'FileHandle', optional => 1 },
81             file => { isa => 'Str', optional => 1 },
82             num_columns => { isa => 'Int' },
83             );
84              
85 2 50 66     5257 if ( !( $fh || $file ) ) {
86 0         0 croak "read_2d_gnuplot_format needs either 'fh' or 'file' argument";
87             }
88              
89 2 100       10 if ( !$fh ) {
90 1 50       49 open $fh, '<', $file
91             or croak "cannot open file $file: $!";
92             }
93              
94             # Rewind filehandle.
95 2 50       77 seek $fh, 0, SEEK_SET
96             or croak "cannot seek: $!";
97              
98 2         19 my $blocks = get_blocks( fh => $fh, num_columns => $num_columns );
99              
100             # $blocks is 3D PDL with following dims
101             # 0st dim: column
102             # 1st dim: row (in block)
103             # 2nd dim: block
104              
105 2 50       341 if ( $type eq 'bare' ) {
    50          
    0          
106 0         0 return $blocks;
107             }
108             elsif ( $type eq 'columns' ) {
109              
110             # merge blocks
111 2         9 my $result = $blocks->clump( 1, 2 );
112              
113             # switch row/column dimensions
114 2         180 $result = $result->xchg( 0, 1 );
115              
116             # return one pdl for each column
117 2         13 return dog($result);
118             }
119             elsif ( $type eq 'maps' ) {
120              
121             # 3D gnuplot data file (two x values, three y value):
122             # x11 y11 z11
123             # x12 y12 z12
124             # x13 y13 z13
125             #
126             # x21 y21 z21
127             # x22 y22 z22
128             # x23 y23 z23
129             #
130             # x-cordinate changes with each block: x11, x12 and x13 will be equal
131             # in most cases (exception: sweep of B-field or temperature where
132             # they will be almost equal.
133             #
134             # Parse into three 2x3 piddles for x, y and z data
135             # (first piddle dim (x) goes to the right):
136              
137             # x11 x21
138             # x12 x22
139             # x13 x23
140              
141             # y11 y21
142             # y12 y22
143             # y13 y23
144              
145             # and same for z
146 0           my $result = $blocks->xchg( 0, 2 );
147 0           return dog($result);
148             }
149             }
150              
151             1;
152              
153             __END__
154              
155             =pod
156              
157             =encoding UTF-8
158              
159             =head1 NAME
160              
161             Lab::Moose::DataFile::Read - Read a gnuplot-style 2D data file
162              
163             =head1 VERSION
164              
165             version 3.881
166              
167             =head1 SYNOPSIS
168              
169             use Lab::Moose::DataFile::Read;
170            
171             # Read gnuplot ASCII datafile and return each column as a 1D PDL
172             my @columns = read_gnuplot_format(
173             type => 'columns',
174             file => 'data.dat',
175             num_columns => 2,
176             );
177              
178             # Read block structured 3D gnuplot ASCII datafile and return
179             # 2D PDL for each parameter (column)
180             my @pixel_maps = read_gnuplot_format(
181             type => 'maps',
182             file => '3d_data.dat',
183             num_columns => 3,
184             );
185              
186             # Read 3D gnuplot ASCII datafile and return 3D PDL with dimensions
187             # [column, line, block]
188             my $pdl = read_gnuplot_format(
189             type => 'bare',
190             file => '3d_data.dat',
191             num_columns => 3,
192             );
193              
194             =head1 Functions
195              
196             =head2 read_gnuplot_format
197              
198             Exported by default. Allowed parameters:
199              
200             =over
201              
202             =item * type
203              
204             Either C<'columns'>, C<'maps'>, or C<'bare'>.
205              
206             =item * file
207              
208             =item * fh
209              
210             Provide an open file handle instead of a filename.
211              
212             =item * num_columns (mandatory)
213              
214             Number of columns in the datafile. Used for a consistency check.
215              
216             =back
217              
218             =head1 COPYRIGHT AND LICENSE
219              
220             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
221              
222             Copyright 2016 Simon Reinhardt
223             2017 Andreas K. Huettel, Simon Reinhardt
224             2018 Simon Reinhardt
225             2020 Andreas K. Huettel
226              
227              
228             This is free software; you can redistribute it and/or modify it under
229             the same terms as the Perl 5 programming language system itself.
230              
231             =cut