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   364625 use Math::Trig;
  5         83109  
  5         743  
4 5     5   2542 use Text::NumericData;
  5         14  
  5         194  
5 5     5   2533 use Text::NumericData::Calc qw(formula_function);
  5         13  
  5         306  
6 5     5   2316 use Text::NumericData::App;
  5         15  
  5         162  
7              
8 5     5   32 use strict;
  5         10  
  5         2391  
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 97 my $class = shift;
37 6         48 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         99 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 15 my $self = shift;
60 7         17 my $param = $self->{param};
61 7         15 my $out = $self->{out};
62 7         26 my $txd = Text::NumericData->new($self->{param});
63 7 50       18 if(@{$self->{argv}}){ $param->{formula} = shift(@{$self->{argv}}); }
  7         26  
  7         14  
  7         24  
64             my $ff = formula_function( $param->{formula},
65             {
66             verbose=>$param->{debug}
67             , plainperl=>$param->{plainperl}
68 7         45 } );
69 7 50       44 die "Cannot parse your formula, try --debug\n" unless defined $ff;
70              
71 7         33 my @C = (0, $param->{number}, 0);
72 7         292 my @A = eval '('.$param->{vars}.')';
73              
74             # Dangerous ... change that!
75 7         283 my $odata = eval '[('.$param->{init}.')]';
76 7 50       29 my $recursive = @{$odata} ? 1 : 0;
  7         41  
77              
78 7 50       21 print $out ${$txd->data_line($odata)} if $recursive;
  0         0  
79              
80 7 50 66     61 while(++$C[0] and $param->{number} >= 0 ? $C[0] <= $param->{number} : 1)
81             {
82 242 50       621 my @data = $recursive ? ($odata) : ([]);
83 242 50       569 $C[2] = $C[1] > 1 ? ($C[0]-1)/($C[1]-1) : 0;
84 242         5604 &$ff(\@data,\@A,\@C);
85 242 50       376 print $out ${$txd->data_line($data[0])} if @{$data[0]};
  242         577  
  242         578  
86 242 50       1260 $odata = $data[0] if $recursive;
87             }
88              
89 7         153 return 0;
90             }
91              
92             1;
93