line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::NumericData::App::txdcalc; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
532
|
use Text::NumericData::App; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
29
|
|
4
|
1
|
|
|
1
|
|
482
|
use Text::NumericData::File; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
34
|
|
5
|
1
|
|
|
1
|
|
8
|
use Text::NumericData::Calc qw(formula_function); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
53
|
|
6
|
1
|
|
|
1
|
|
431
|
use Text::NumericData::FileCalc qw(file_calc); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
106
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1520
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# This is just a placeholder because of a past build system bug. |
11
|
|
|
|
|
|
|
# The one and only version for Text::NumericData is kept in |
12
|
|
|
|
|
|
|
# the Text::NumericData module itself. |
13
|
|
|
|
|
|
|
our $VERSION = '1'; |
14
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
#the infostring says it all |
17
|
|
|
|
|
|
|
my $infostring = 'text data calculations |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Usage: |
20
|
|
|
|
|
|
|
pipe | txdcalc [--] [files] | pipe |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
It takes STDIN as primary data source and the files as secondary sources. Operation is line-wise in and out. So, this program is just a filter for data in ASCII files with quite some freedom in manipulating the data. |
23
|
|
|
|
|
|
|
About formula syntax: |
24
|
|
|
|
|
|
|
It is Perl, mostly. The variables (elements of corresponding rows) are denoted [n,m] in general. n is the file number (0 is the data from STDIN) and m the column (starting at 1). Short form [m] means implicitly n=0. Also there are $x or x for [0,1], $y or y for [0,2] and $z for [0,3]. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Additionally there are two arrays: A0, A1, A2, ... and C0, C1, C2, ... in the formula or references $A and $C in the plain Perl code. Both arrays are usable as you like (global scope) with the difference that @C gets initialized via the const parameter. Apart from the special syntax added here you can just use Perl to build advanced expressions, so that |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
[3] = [1,2] != 0 ? [2]/[1,2] : 0 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
catches the division by zero. You can switch to plain Perl syntax, too (see --plainperl). |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
To discard a data line, place a "return 1" (or some other true --- not 0 or undefined --- value): |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
return 1 if [3] != 85000; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
will only include data lines with the third column being equal to 85000. |
37
|
|
|
|
|
|
|
'; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our @ISA = ('Text::NumericData::App'); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub new |
42
|
|
|
|
|
|
|
{ |
43
|
1
|
|
|
1
|
0
|
87
|
my $class = shift; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Note: deleted the feature of differing strictness for the several input files. |
46
|
|
|
|
|
|
|
# As I did not need it in all these years, It's apparently not worth the hassle. |
47
|
1
|
|
|
|
|
9
|
my @pars = |
48
|
|
|
|
|
|
|
( |
49
|
|
|
|
|
|
|
# 'file',undef,'f','file(s) with data to be brought together with STDIN (comma-separated... you do not have any filenames with commas, do you?)', |
50
|
|
|
|
|
|
|
'filehead',0,'F', |
51
|
|
|
|
|
|
|
'use header from file (use number starting at 1 for a file in provided list) - overriden by manual header' |
52
|
|
|
|
|
|
|
,'header',undef,'H', |
53
|
|
|
|
|
|
|
'use this header instead (\n becomes an appropriate line end, end of string by itself) - this one overrides the others' |
54
|
|
|
|
|
|
|
,'stdhead',1,'s', |
55
|
|
|
|
|
|
|
'use header from STDIN (overridden by other options)' |
56
|
|
|
|
|
|
|
,'byrow',0,'r', |
57
|
|
|
|
|
|
|
'correlate data sets simply by row number (0 / 1)' |
58
|
|
|
|
|
|
|
,'bycol',1,'c', |
59
|
|
|
|
|
|
|
'correlate data via this column in STDIN data(1..#columns)' |
60
|
|
|
|
|
|
|
,'fromcol',0,'l', |
61
|
|
|
|
|
|
|
'specify diferent columns (commalist) for correlation for each input file' |
62
|
|
|
|
|
|
|
,'lin',0,'', |
63
|
|
|
|
|
|
|
'shortcut for enforcing linear interpolation' |
64
|
|
|
|
|
|
|
,'spline',0,'', |
65
|
|
|
|
|
|
|
'shortcut for enforcing spline interpolation (overrules --lin)' |
66
|
|
|
|
|
|
|
,'headcode','','C', |
67
|
|
|
|
|
|
|
'FullFun: Some code that gets eval()ed with possibility to parse/modify every head line (variable $line; line number is $num).' |
68
|
|
|
|
|
|
|
,'aftercode','','A', |
69
|
|
|
|
|
|
|
'FullFun: Some code that gets eval()ed after the input file is through (only useful together with justcalc and ignored otherwise)' |
70
|
|
|
|
|
|
|
,'beforecode','','B', |
71
|
|
|
|
|
|
|
'FullFun: Some code that gets eval()ed before input processing (yes, first B, then A, because B[efore] A[fter];-)' |
72
|
|
|
|
|
|
|
,'formula',undef,'m', |
73
|
|
|
|
|
|
|
'specify formula here or as first command line parameter' |
74
|
|
|
|
|
|
|
,'const',undef,'n', |
75
|
|
|
|
|
|
|
'specify a constant array (separated by spaces)' |
76
|
|
|
|
|
|
|
,'debug',0,'d', |
77
|
|
|
|
|
|
|
'give some info that may help debugging' |
78
|
|
|
|
|
|
|
,'justcalc',0,'j', |
79
|
|
|
|
|
|
|
'just print values of the A array after calculation and not the resulting data (for simply doing some calculation like summing, averaging...)' |
80
|
|
|
|
|
|
|
,'plainperl',0,'', |
81
|
|
|
|
|
|
|
'Use plain Perl syntax for formula for full force without confusing the intermediate parser.' |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
15
|
return $class->SUPER::new |
85
|
|
|
|
|
|
|
({ |
86
|
|
|
|
|
|
|
parconf => |
87
|
|
|
|
|
|
|
{ |
88
|
|
|
|
|
|
|
info=>$infostring |
89
|
|
|
|
|
|
|
# default copyright |
90
|
|
|
|
|
|
|
# default version |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
,pardef => \@pars |
93
|
|
|
|
|
|
|
,pipemode => 1 |
94
|
|
|
|
|
|
|
,pipe_init => \&preinit |
95
|
|
|
|
|
|
|
,pipe_begin => \&init |
96
|
|
|
|
|
|
|
,pipe_header => \&process_header |
97
|
|
|
|
|
|
|
,pipe_data => \&process_data |
98
|
|
|
|
|
|
|
,pipe_end => \&endoffile |
99
|
|
|
|
|
|
|
}); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub preinit |
104
|
|
|
|
|
|
|
{ |
105
|
6
|
|
|
6
|
0
|
11
|
my $self = shift; |
106
|
6
|
|
|
|
|
13
|
my $param = $self->{param}; |
107
|
|
|
|
|
|
|
|
108
|
6
|
50
|
|
|
|
19
|
$param->{interpolate} = 'linear' if $param->{lin}; |
109
|
6
|
50
|
|
|
|
16
|
$param->{interpolate} = 'spline' if $param->{spline}; |
110
|
|
|
|
|
|
|
|
111
|
6
|
50
|
|
|
|
20
|
if(defined $param->{header}){ $param->{stdhead} = 0; $param->{filehead} = 0; } |
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
112
|
0
|
|
|
|
|
0
|
elsif($param->{filehead}){ $param->{stdhead} = 0; } |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# That should return an error, shouldn't it?\ |
115
|
|
|
|
|
|
|
# Changed it so. |
116
|
6
|
50
|
33
|
|
|
19
|
if(!defined $param->{formula} and !@{$self->{argv}}){ print STDERR "That's not enough... see $0 --help\n"; return -1; } |
|
6
|
|
|
|
|
19
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
117
|
|
|
|
|
|
|
|
118
|
6
|
|
|
|
|
79
|
$self->{files} = []; |
119
|
6
|
50
|
|
|
|
17
|
my $form = defined $param->{formula} ? $param->{formula} : shift(@{$self->{argv}}); |
|
6
|
|
|
|
|
16
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
#remember: on the outside col 1..cols; inside 0..cols-1 ! |
122
|
6
|
100
|
|
|
|
15
|
unless($param->{byrow}) |
123
|
|
|
|
|
|
|
{ |
124
|
5
|
50
|
|
|
|
22
|
if($param->{bycol} < 1) |
125
|
|
|
|
|
|
|
{ |
126
|
0
|
|
|
|
|
0
|
print STDERR "invalid column for correlation!\n"; |
127
|
0
|
|
|
|
|
0
|
return -1; |
128
|
|
|
|
|
|
|
} |
129
|
5
|
|
|
|
|
13
|
--$param->{bycol}; |
130
|
|
|
|
|
|
|
} |
131
|
6
|
50
|
|
|
|
20
|
$self->{fromcol} = $param->{fromcol} ? [split(',', $param->{fromcol})] : []; |
132
|
6
|
|
|
|
|
11
|
my $si = 0; |
133
|
|
|
|
|
|
|
|
134
|
6
|
|
|
|
|
11
|
for(@{$self->{argv}}) |
|
6
|
|
|
|
|
18
|
|
135
|
|
|
|
|
|
|
{ |
136
|
6
|
|
|
|
|
43
|
my $f = Text::NumericData::File->new($param, $_); |
137
|
6
|
|
|
|
|
12
|
push(@{$self->{files}}, $f); |
|
6
|
|
|
|
|
19
|
|
138
|
6
|
|
|
|
|
12
|
my $lastf = $#{$self->{files}}; |
|
6
|
|
|
|
|
13
|
|
139
|
|
|
|
|
|
|
print STDERR "Warning: Got no data out of $_!\n" |
140
|
6
|
50
|
|
|
|
11
|
unless @{$f->{data}}; |
|
6
|
|
|
|
|
22
|
|
141
|
6
|
50
|
|
|
|
29
|
$self->{fromcol}[$lastf] = defined $self->{fromcol}[$lastf] ? $self->{fromcol}[$lastf]-1 : $param->{bycol}; |
142
|
|
|
|
|
|
|
print STDERR "warning: $_ doesn't have a column $self->{fromcol}[$lastf]\n" |
143
|
6
|
50
|
33
|
|
|
41
|
if($self->{fromcol}[$lastf] < 0 or $self->{fromcol}[$lastf] >= $self->{files}[$lastf]->columns()) |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
6
|
0
|
0
|
|
|
18
|
if($param->{filehead} and ($param->{filehead} > @{$self->{files}} or $param->{filehead} < 0)) |
|
|
|
33
|
|
|
|
|
147
|
|
|
|
|
|
|
{ |
148
|
0
|
|
|
|
|
0
|
print STDERR "Invalid file number for header!\n"; |
149
|
0
|
|
|
|
|
0
|
return -1; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# Formula function with configuration for file_calc, only row offset is changed per line. |
153
|
6
|
|
|
|
|
38
|
$self->{ff} = formula_function($form,{verbose=>$param->{debug},plainperl=>$param->{plainperl}}); |
154
|
|
|
|
|
|
|
$self->{ffconf} = |
155
|
|
|
|
|
|
|
{ |
156
|
|
|
|
|
|
|
bycol => $param->{bycol} |
157
|
|
|
|
|
|
|
, fromcol => $self->{fromcol} |
158
|
|
|
|
|
|
|
, byrow => $param->{byrow} |
159
|
6
|
|
|
|
|
49
|
, skipempty => 1 # They're skipped before, anyway ... |
160
|
|
|
|
|
|
|
, rowoffset => 0 |
161
|
|
|
|
|
|
|
}; |
162
|
|
|
|
|
|
|
|
163
|
6
|
50
|
|
|
|
20
|
unless(defined $self->{ff}) |
164
|
|
|
|
|
|
|
{ |
165
|
0
|
|
|
|
|
0
|
print STDERR "Error in formula!\n"; |
166
|
0
|
|
|
|
|
0
|
return -1; |
167
|
|
|
|
|
|
|
} |
168
|
6
|
50
|
|
|
|
21
|
$self->{C} = defined $param->{const} ? [split(' ', $param->{const})] : []; |
169
|
6
|
|
|
|
|
12
|
foreach my $c (@{$self->{C}}) |
|
6
|
|
|
|
|
33
|
|
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
# Another such eval ... this one really is supposed to be context-free. |
172
|
0
|
|
|
|
|
0
|
$c = eval $c; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Evil eval ... make it safer? Its purpose is to give endless possibilities, after all. |
177
|
|
|
|
|
|
|
sub context_eval |
178
|
|
|
|
|
|
|
{ |
179
|
6
|
|
|
6
|
0
|
11
|
my $self = shift; |
180
|
6
|
50
|
|
|
|
27
|
return unless $self->{param}{$_[0]} ne ''; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
0
|
my $A = $self->{A}; |
183
|
0
|
|
|
|
|
0
|
my $C = $self->{C}; |
184
|
0
|
|
|
|
|
0
|
eval $self->{param}{$_[0]}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub init |
188
|
|
|
|
|
|
|
{ |
189
|
6
|
|
|
6
|
0
|
450
|
my $self = shift; |
190
|
6
|
|
|
|
|
26
|
$self->new_txd(); |
191
|
6
|
|
|
|
|
14
|
$self->{row} = -1; |
192
|
6
|
|
|
|
|
14
|
$self->{num} = 0; |
193
|
6
|
|
|
|
|
11
|
$self->{A} = []; |
194
|
6
|
|
|
|
|
13
|
$self->{parheader} = $self->{param}{header}; |
195
|
6
|
|
|
|
|
12
|
$self->{parfilehead} = $self->{param}{filehead}; |
196
|
6
|
|
|
|
|
17
|
$self->context_eval('beforecode'); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub process_header |
200
|
|
|
|
|
|
|
{ |
201
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
202
|
0
|
|
|
|
|
0
|
my $param = $self->{param}; |
203
|
0
|
|
|
|
|
0
|
++$self->{num}; #increase head line counter |
204
|
0
|
|
|
|
|
0
|
$self->context_eval('headcode'); |
205
|
0
|
0
|
0
|
|
|
0
|
$_[0] = '' unless($param->{stdhead} and not $param->{justcalc}); |
206
|
|
|
|
|
|
|
|
207
|
0
|
0
|
|
|
|
0
|
unless($param->{justcalc}) |
208
|
|
|
|
|
|
|
{ |
209
|
|
|
|
|
|
|
#now we should at least know the line ending |
210
|
0
|
0
|
|
|
|
0
|
if(defined $self->{parheader}) |
|
|
0
|
|
|
|
|
|
211
|
|
|
|
|
|
|
{ |
212
|
0
|
|
|
|
|
0
|
$self->{parheader} =~ s/\\n/$self->{txd}{config}{lineend}/g; |
213
|
0
|
|
|
|
|
0
|
$_[0] = $self->{parheader}.$self->{txd}{config}{lineend}; |
214
|
0
|
|
|
|
|
0
|
$self->{parheader} = undef; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
elsif($self->{parfilehead}) |
217
|
|
|
|
|
|
|
{ |
218
|
0
|
|
|
|
|
0
|
$_[0] = ''; |
219
|
0
|
|
|
|
|
0
|
foreach my $l (@{$self->{files}[$self->{parfilehead}-1]->{raw_header}}) |
|
0
|
|
|
|
|
0
|
|
220
|
|
|
|
|
|
|
{ |
221
|
0
|
|
|
|
|
0
|
$_[0] .= $l.$self->{txd}{config}{lineend}; |
222
|
|
|
|
|
|
|
} |
223
|
0
|
|
|
|
|
0
|
$self->{parfilehead} = 0; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub process_data |
230
|
|
|
|
|
|
|
{ |
231
|
420
|
|
|
420
|
0
|
615
|
my $self = shift; |
232
|
420
|
|
|
|
|
708
|
my $param = $self->{param}; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# Preserve empty lines that may have a meaning |
235
|
|
|
|
|
|
|
# In strict mode, though, multiple spaces may have meaning, |
236
|
|
|
|
|
|
|
# so let's have file_calc() worry about ignoring. |
237
|
420
|
50
|
33
|
|
|
1932
|
if(not $param->{strict} and $_[0] =~ /^\s*$/){ return; } |
|
0
|
|
|
|
|
0
|
|
238
|
|
|
|
|
|
|
|
239
|
420
|
|
|
|
|
1149
|
my $data = $self->{txd}->line_data($_[0]); |
240
|
420
|
|
|
|
|
855
|
$self->{ffconf}{rowoffset} = ++$self->{row}; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Doing calculation for a fake file with one data set only. |
243
|
|
|
|
|
|
|
# This keeps the logic in one common place and also leads the |
244
|
|
|
|
|
|
|
# mind to the idea of optional caching of lines and block operation. |
245
|
|
|
|
|
|
|
# But, the semantics of one line in and one line out, immediately are |
246
|
|
|
|
|
|
|
# probably not to change. |
247
|
|
|
|
|
|
|
my $ignore = file_calc( $self->{ff}, $self->{ffconf} |
248
|
|
|
|
|
|
|
, [$data] # Don't forget: This is the actual data we work on ... |
249
|
420
|
|
|
|
|
1385
|
, $self->{files}, $self->{A}, $self->{C} ); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# On error, ignore the line. Else, the returned array has |
252
|
|
|
|
|
|
|
# one entry if the line should be purposefully ignored. |
253
|
|
|
|
|
|
|
my $nothing = defined $ignore |
254
|
420
|
50
|
|
|
|
907
|
? @{$ignore} # == 0 normally |
|
420
|
|
|
|
|
695
|
|
255
|
|
|
|
|
|
|
: 1; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
$_[0] = ($nothing or $param->{justcalc}) |
258
|
|
|
|
|
|
|
? '' |
259
|
420
|
100
|
66
|
|
|
1450
|
: ${$self->{txd}->data_line($data)}; |
|
330
|
|
|
|
|
1005
|
|
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub endoffile |
263
|
|
|
|
|
|
|
{ |
264
|
6
|
|
|
6
|
0
|
158
|
my $self = shift; |
265
|
|
|
|
|
|
|
# Prepend a line with results. |
266
|
|
|
|
|
|
|
# The line end should match input since it comes from the Text::NumericData instance. |
267
|
6
|
50
|
|
|
|
26
|
$_[0] = ${$self->justcalc_result()}.$_[0] if $self->{param}{justcalc}; |
|
0
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
sub justcalc_result |
271
|
|
|
|
|
|
|
{ |
272
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
273
|
0
|
|
|
|
|
|
$self->context_eval('aftercode'); |
274
|
0
|
|
|
|
|
|
return $self->{txd}->data_line($self->{A}); |
275
|
|
|
|
|
|
|
} |