File Coverage

blib/lib/Text/NumericData/App/txdconstruct.pm
Criterion Covered Total %
statement 43 44 97.7
branch 9 18 50.0
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 2 0.0
total 61 74 82.4


line stmt bran cond sub pod time code
1             package Text::NumericData::App::txdconstruct;
2              
3 5     5   338792 use Math::Trig;
  5         74917  
  5         959  
4 5     5   2408 use Text::NumericData;
  5         15  
  5         219  
5 5     5   2486 use Text::NumericData::Calc qw(formula_function);
  5         18  
  5         315  
6 5     5   1815 use Text::NumericData::App;
  5         127  
  5         192  
7              
8 5     5   36 use strict;
  5         9  
  5         2220  
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 construction
18              
19             I will produce some TextData following the formula you give me. Syntax is like that of txdcalc with only the STDOUT data; which means: You access the current data set via variables [1].. [x] (or [0,1]..[0,x] if you really want) and the global arrays A and C via A0..Ax and C0..Cx. You can initialze A and are encouraged to work with that array for custom operations. C has at the moment the only function to provide the data set number with C0 (set it to -1 to stop).
20             A data set is printed to STDOUT only when there is actually some data - so you can check for a condition in the formula and end the construction without creating a last futile line. You can, though, enable easy recursive calculation by initializing the data array (via --data parameter) in which case the data fields will always hold their last values when entering the formula.
21              
22             Variables: A is for you, C is special: C0 is used for the data set number, C1 for the number of data sets to create, C2 for (C0-1)/(C1-1); (and maybe other stat stuff in C following in future...)
23              
24             The formula can also be given as stand-alone command line argument (this overrides the other setting).
25              
26             Example:
27              
28             txdconstruct -n=200 -i="0,1/3" "[1] += 1; [2] = 4*[2]*(1-[2]);"
29              
30             gives a trajectory (some steps of iteration) for the logistic map.';
31              
32             our @ISA = ('Text::NumericData::App');
33              
34             sub new
35             {
36 6     6 0 135 my $class = shift;
37 6         52 my @pars =
38             (
39             # 'header','','H','use this header (\n becomes an appropriate line end, end of string by itself)',
40             'formula','[1] = C0','f','specify formula here'
41             ,'vars','','v','initialize the additional variable array A (comma-separeted for eval)'
42             ,'debug',0,'D','give some info that may help debugging'
43             ,'number',10,'n','number of datasets to create (when < 0: until _you_ set C0 to -1)'
44             ,'init','','i','initialize data - comma-separated for eval... this enables easy recursive calculations by always preserving the last values'
45             ,'plainperl',0,'',
46             'Use plain Perl syntax for formula for full force without confusing the intermediate parser.'
47             );
48              
49 6         67 return $class->SUPER::new
50             ({
51             parconf=>{ info=>$infostring # default version
52             # default author
53             # default copyright
54             }, pardef=>\@pars});
55             }
56              
57             sub main
58             {
59 7     7 0 19 my $self = shift;
60 7         18 my $param = $self->{param};
61 7         21 my $out = $self->{out};
62 7         31 my $txd = Text::NumericData->new($self->{param});
63 7 50       21 if(@{$self->{argv}}){ $param->{formula} = shift(@{$self->{argv}}); }
  7         33  
  7         17  
  7         33  
64             my $ff = formula_function( $param->{formula},
65             {
66             verbose=>$param->{debug}
67             , plainperl=>$param->{plainperl}
68 7         68 } );
69 7 50       45 die "Cannot parse your formula, try --debug\n" unless defined $ff;
70              
71 7         38 my @C = (0, $param->{number}, 0);
72 7         373 my @A = eval '('.$param->{vars}.')';
73              
74             # Dangerous ... change that!
75 7         380 my $odata = eval '[('.$param->{init}.')]';
76 7 50       33 my $recursive = @{$odata} ? 1 : 0;
  7         37  
77              
78 7 50       31 print $out ${$txd->data_line($odata)} if $recursive;
  0         0  
79              
80 7 50 66     79 while(++$C[0] and $param->{number} >= 0 ? $C[0] <= $param->{number} : 1)
81             {
82 242 50       784 my @data = $recursive ? ($odata) : ([]);
83 242 50       854 $C[2] = $C[1] > 1 ? ($C[0]-1)/($C[1]-1) : 0;
84 242         7558 &$ff(\@data,\@A,\@C);
85 242 50       499 print $out ${$txd->data_line($data[0])} if @{$data[0]};
  242         904  
  242         775  
86 242 50       1862 $odata = $data[0] if $recursive;
87             }
88              
89 7         248 return 0;
90             }
91              
92             1;
93