|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
  
 
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Text::NumericData::App::txdconstruct;  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
354141
 | 
 use Math::Trig;  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
81085
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
773
 | 
    | 
| 
4
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
2602
 | 
 use Text::NumericData;  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
232
 | 
    | 
| 
5
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
2580
 | 
 use Text::NumericData::Calc qw(formula_function);  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
352
 | 
    | 
| 
6
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
2296
 | 
 use Text::NumericData::App;  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
174
 | 
    | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
8
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
33
 | 
 use strict;  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2487
 | 
    | 
| 
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
  
 | 
117
 | 
 	my $class = shift;  | 
| 
37
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
56
 | 
 	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
 | 
 
 | 
 
 | 
 
 | 
 
 | 
95
 | 
 	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
  
 | 
18
 | 
 	my $self = shift;  | 
| 
60
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	my $param = $self->{param};  | 
| 
61
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	my $out = $self->{out};  | 
| 
62
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
 	my $txd = Text::NumericData->new($self->{param});  | 
| 
63
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	if(@{$self->{argv}}){ $param->{formula} = shift(@{$self->{argv}}); }  | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
    | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my $ff = formula_function( $param->{formula},  | 
| 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	{  | 
| 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  verbose=>$param->{debug}  | 
| 
67
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	, plainperl=>$param->{plainperl}  | 
| 
68
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
 	} );  | 
| 
69
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
37
 | 
 	die "Cannot parse your formula, try --debug\n" unless defined $ff;  | 
| 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
71
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
 	my @C = (0, $param->{number}, 0);  | 
| 
72
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
297
 | 
 	my @A = eval '('.$param->{vars}.')';  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
74
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Dangerous ... change that!  | 
| 
75
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
303
 | 
 	my $odata = eval '[('.$param->{init}.')]';  | 
| 
76
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
26
 | 
 	my $recursive = @{$odata} ? 1 : 0;  | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
78
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
28
 | 
 	print $out ${$txd->data_line($odata)} if $recursive;  | 
| 
 
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
79
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
80
 | 
7
 | 
  
 50
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
70
 | 
 	while(++$C[0] and $param->{number} >= 0 ? $C[0] <= $param->{number} : 1)  | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	{  | 
| 
82
 | 
242
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
664
 | 
 		my @data = $recursive ? ($odata) : ([]);  | 
| 
83
 | 
242
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
610
 | 
 		$C[2] = $C[1] > 1 ? ($C[0]-1)/($C[1]-1) : 0;  | 
| 
84
 | 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6060
 | 
 		&$ff(\@data,\@A,\@C);  | 
| 
85
 | 
242
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
383
 | 
 		print $out ${$txd->data_line($data[0])} if @{$data[0]};  | 
| 
 
 | 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
623
 | 
    | 
| 
 
 | 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
657
 | 
    | 
| 
86
 | 
242
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1400
 | 
 		$odata = $data[0] if $recursive;  | 
| 
87
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
89
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
166
 | 
 	return 0;  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
92
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    |