line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::NumericData::App::txdrows; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
72575
|
use Text::NumericData; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
479
|
use Text::NumericData::Calc qw(expression_function); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
59
|
|
5
|
1
|
|
|
1
|
|
619
|
use Text::NumericData::App; |
|
1
|
|
|
|
|
24
|
|
|
1
|
|
|
|
|
31
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
938
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# This is just a placeholder because of a past build system bug. |
10
|
|
|
|
|
|
|
# The one and only version for Text::NumericData is kept in |
11
|
|
|
|
|
|
|
# the Text::NumericData module itself. |
12
|
|
|
|
|
|
|
our $VERSION = '1'; |
13
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $infostring = 'split a section of sets out of singe data file |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
Usage: |
18
|
|
|
|
|
|
|
pipe | txdrows -b=3 -e=10 | pipe |
19
|
|
|
|
|
|
|
pipe | txdrows \'near([1], 3.1)\' | pipe |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
This program extracs rows (data sets, sections, records, ...) of a numerical text file. Either this is a configured range of lines via begin/end indices or a decimation factor, or a set of rows matching a given expression on the command line. |
22
|
|
|
|
|
|
|
The last example employs such an expression to match the first row that has a value near 3.1 in the first column. You could specify a third argument to near() to change the default allowed deviation. If you deal with integer values, using |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
pipe | txdrows \'[1] == 3\' | pipe |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
is fine, too, for selecting value 3.'; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our @ISA = ('Text::NumericData::App'); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub new |
31
|
|
|
|
|
|
|
{ |
32
|
1
|
|
|
1
|
0
|
108
|
my $class = shift; |
33
|
1
|
|
|
|
|
11
|
my @pars = |
34
|
|
|
|
|
|
|
( |
35
|
|
|
|
|
|
|
'begin', 1, 'b', |
36
|
|
|
|
|
|
|
'begin of section (above all other criteria)' |
37
|
|
|
|
|
|
|
,'end', -1, 'e', |
38
|
|
|
|
|
|
|
'end of section (when negative: until end; above all other criteria)' |
39
|
|
|
|
|
|
|
,'reduce', '1', 'r', |
40
|
|
|
|
|
|
|
'Reduce row count by a certain factor: Only include every ...th one. A value of 2 means rows 1,3,5... , a value of 10 means rows 1,11,21... (from the input).' |
41
|
|
|
|
|
|
|
,'justmatch',1,'j', |
42
|
|
|
|
|
|
|
'if an expression to match is given, select what to print out: 0 means all matches including header, >0 means just the first n matches, <0 means all matches, but no header' |
43
|
|
|
|
|
|
|
,'verbose',0,'v', |
44
|
|
|
|
|
|
|
'be verbose about things' |
45
|
|
|
|
|
|
|
,'ranges', [], 'R', 'give multiple ranges (format: "from:to", either may' |
46
|
|
|
|
|
|
|
. ' be omitted or set to negative to extend to beginning/end) inside' |
47
|
|
|
|
|
|
|
. ' the main range given by begin and end indices, this does not' |
48
|
|
|
|
|
|
|
. ' duplicate or rearrange data, just specifies an additional condition' |
49
|
|
|
|
|
|
|
. ' to include a record or not, in input order' |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
|
52
|
1
|
|
|
|
|
14
|
return $class->SUPER::new |
53
|
|
|
|
|
|
|
({ |
54
|
|
|
|
|
|
|
parconf => |
55
|
|
|
|
|
|
|
{ |
56
|
|
|
|
|
|
|
info=>$infostring # default version |
57
|
|
|
|
|
|
|
# default author |
58
|
|
|
|
|
|
|
# default copyright |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
,pardef => \@pars |
61
|
|
|
|
|
|
|
,pipemode => 1 |
62
|
|
|
|
|
|
|
,pipe_init => \&preinit |
63
|
|
|
|
|
|
|
,pipe_begin => \&init |
64
|
|
|
|
|
|
|
,pipe_header => \&process_header |
65
|
|
|
|
|
|
|
,pipe_data => \&process_data |
66
|
|
|
|
|
|
|
}); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub preinit |
70
|
|
|
|
|
|
|
{ |
71
|
4
|
|
|
4
|
0
|
7
|
my $self = shift; |
72
|
4
|
|
|
|
|
9
|
my $p = $self->{param}; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Sanitation... |
75
|
4
|
50
|
|
|
|
16
|
$self->{reduce} = $p->{reduce} < 1 ? 1 : $p->{reduce}; |
76
|
|
|
|
|
|
|
|
77
|
4
|
|
|
|
|
7
|
$self->{match} = shift(@{$self->{argv}}); |
|
4
|
|
|
|
|
13
|
|
78
|
4
|
|
|
|
|
39
|
$self->{matchfun} = undef; |
79
|
4
|
|
|
|
|
8
|
$self->{matchnohead} = 0; |
80
|
4
|
100
|
|
|
|
12
|
if(defined $self->{match}) |
81
|
|
|
|
|
|
|
{ |
82
|
3
|
|
|
|
|
21
|
$self->{matchfun} = expression_function($self->{match}, $p->{verbose}); |
83
|
3
|
50
|
|
|
|
25
|
return print STDERR "Error creating function for matching ($!).\n" unless defined $self->{matchfun}; |
84
|
3
|
|
|
|
|
11
|
$self->{matchnohead} = $p->{justmatch} != 0; |
85
|
|
|
|
|
|
|
} |
86
|
4
|
|
|
|
|
9
|
$self->{ranges} = []; |
87
|
4
|
50
|
|
|
|
9
|
if(@{$p->{ranges}}) |
|
4
|
|
|
|
|
14
|
|
88
|
|
|
|
|
|
|
{ |
89
|
0
|
|
|
|
|
0
|
for(@{$p->{ranges}}) |
|
0
|
|
|
|
|
0
|
|
90
|
|
|
|
|
|
|
{ |
91
|
0
|
0
|
|
|
|
0
|
return print STDERR "Bad range: $_\n" |
92
|
|
|
|
|
|
|
unless /^\s*([+\-]?\d*)\s*:\s*([+\-]?\d*)\s*$/; |
93
|
0
|
0
|
|
|
|
0
|
push(@{$self->{ranges}}, [$1 ne '' ? $1 : -1, $2 ne '' ? $2 : -1]); |
|
0
|
0
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
4
|
|
|
|
|
14
|
return 0; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub init |
100
|
|
|
|
|
|
|
{ |
101
|
4
|
|
|
4
|
0
|
422
|
my $self = shift; |
102
|
4
|
|
|
|
|
25
|
$self->new_txd(); |
103
|
4
|
|
|
|
|
9
|
$self->{line} = 0; |
104
|
4
|
|
|
|
|
12
|
$self->{matched} = 0; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub process_header |
108
|
|
|
|
|
|
|
{ |
109
|
8
|
|
|
8
|
0
|
15
|
my $self = shift; |
110
|
8
|
100
|
|
|
|
29
|
$_[0] = '' if $self->{matchnohead}; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Check if given line index is inside the configured ranges, |
114
|
|
|
|
|
|
|
# including reduction. Everything that works on the line index alone. |
115
|
|
|
|
|
|
|
sub _chosen_line() |
116
|
|
|
|
|
|
|
{ |
117
|
16
|
|
|
16
|
|
25
|
my $self = shift; |
118
|
16
|
|
|
|
|
28
|
my $p = $self->{param}; |
119
|
16
|
|
|
|
|
23
|
my $i = shift; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
return 0 # Global range first. |
122
|
16
|
100
|
100
|
|
|
77
|
unless($i >= $p->{begin} and ($p->{end} < 0 or $i <= $p->{end})); |
|
|
|
100
|
|
|
|
|
123
|
|
|
|
|
|
|
return 0 # Line reduction, the other simple test. |
124
|
14
|
50
|
|
|
|
47
|
unless(($self->{line}-1) % $self->{reduce} == 0); |
125
|
|
|
|
|
|
|
# At last, the more elaborate check of sub-ranges. |
126
|
14
|
50
|
|
|
|
23
|
if(@{$self->{ranges}}) |
|
14
|
|
|
|
|
33
|
|
127
|
|
|
|
|
|
|
{ |
128
|
0
|
|
|
|
|
0
|
for(@{$self->{ranges}}) |
|
0
|
|
|
|
|
0
|
|
129
|
|
|
|
|
|
|
{ |
130
|
0
|
0
|
0
|
|
|
0
|
return 1 |
|
|
|
0
|
|
|
|
|
131
|
|
|
|
|
|
|
if($i >= $_->[0] and ($_->[1] < 0 or $i <= $_->[1])); |
132
|
|
|
|
|
|
|
} |
133
|
0
|
|
|
|
|
0
|
return 0; # There are ranges, but none contain this index. |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
else |
136
|
|
|
|
|
|
|
{ |
137
|
14
|
|
|
|
|
36
|
return 1; # No further sub-ranges. It's in. |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub process_data |
142
|
|
|
|
|
|
|
{ |
143
|
16
|
|
|
16
|
0
|
37
|
my $self = shift; |
144
|
16
|
|
|
|
|
29
|
my $p = $self->{param}; |
145
|
16
|
|
|
|
|
31
|
++$self->{line}; |
146
|
|
|
|
|
|
|
# Checks based on line number. |
147
|
16
|
100
|
|
|
|
38
|
unless($self->_chosen_line($self->{line})) |
148
|
|
|
|
|
|
|
{ |
149
|
2
|
|
|
|
|
7
|
$_[0] = ''; |
150
|
2
|
|
|
|
|
5
|
return; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
# Additional check with match function. |
153
|
14
|
100
|
|
|
|
34
|
if(defined $self->{matchfun}) |
154
|
|
|
|
|
|
|
{ |
155
|
12
|
100
|
100
|
|
|
72
|
if |
|
|
|
100
|
|
|
|
|
156
|
|
|
|
|
|
|
( |
157
|
|
|
|
|
|
|
not($p->{justmatch} > 0 and not $self->{matched} < $p->{justmatch}) |
158
|
|
|
|
|
|
|
and $self->{matchfun}->([$self->{txd}->line_data($_[0])]) |
159
|
4
|
|
|
|
|
14
|
){ ++$self->{matched}; } |
160
|
8
|
|
|
|
|
30
|
else{ $_[0] = ''; } |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
1; |