1 #!/usr/bin/perl |
1 #!/usr/bin/perl |
2 #====================================================================== |
2 #====================================================================== |
3 # A N T S I O . P L |
3 # A N T S I O . P L |
4 # doc: Fri Jun 19 19:22:51 1998 |
4 # doc: Fri Jun 19 19:22:51 1998 |
5 # dlm: Wed Apr 10 16:57:59 2019 |
5 # dlm: Tue Nov 30 12:28:03 2021 |
6 # (c) 1998 A.M. Thurnherr |
6 # (c) 1998 A.M. Thurnherr |
7 # uE-Info: 217 48 NIL 0 0 70 2 2 4 NIL ofnI |
7 # uE-Info: 220 50 NIL 0 0 70 10 2 4 NIL ofnI |
8 #====================================================================== |
8 #====================================================================== |
9 |
9 |
10 # HISTORY: |
10 # HISTORY: |
11 # Jun 19, 1998: - created |
11 # Jun 19, 1998: - created |
12 # Dec 29, 1998: - added antsLineFlag and antsLinePrefix |
12 # Dec 29, 1998: - added antsLineFlag and antsLinePrefix |
213 # Sep 13, 2016: - modified &antsAddParams to make more flexible |
213 # Sep 13, 2016: - modified &antsAddParams to make more flexible |
214 # Mar 10, 2017: - BUG: antsCheckDeps() used ctime instead of mtime!!! |
214 # Mar 10, 2017: - BUG: antsCheckDeps() used ctime instead of mtime!!! |
215 # Apr 5, 2017: - BUG: stale file mtime dependency info was not printed correctly |
215 # Apr 5, 2017: - BUG: stale file mtime dependency info was not printed correctly |
216 # Apr 23, 2018: - BUG: @antsLayout was not kept up-to-date when layout-changes are allowed |
216 # Apr 23, 2018: - BUG: @antsLayout was not kept up-to-date when layout-changes are allowed |
217 # Apr 10, 2019: - disabled dependency warnings |
217 # Apr 10, 2019: - disabled dependency warnings |
|
218 # Oct 14, 2021: - changed nan to NaN, to make gnuplot work nicely again |
|
219 # Nov 30, 2021: - finally made -F not croak on division-by-zero, etc. |
|
220 # - BUG: some NaNs were still nans |
|
221 # HISTORY END |
218 |
222 |
219 # GENERAL NOTES: |
223 # GENERAL NOTES: |
220 # - %P was named without an ants-prefix because associative arrays |
224 # - %P was named without an ants-prefix because associative arrays |
221 # are rare (and perl supports multiple name spaces for the |
225 # are rare (and perl supports multiple name spaces for the |
222 # different variable types) and to facilitate its use in |
226 # different variable types) and to facilitate its use in |
489 # DONE WITH HEADER PARSING |
493 # DONE WITH HEADER PARSING |
490 |
494 |
491 # Handle Layout changes: |
495 # Handle Layout changes: |
492 # - only allow when $antsAllowEmbeddedLayoutChange is set |
496 # - only allow when $antsAllowEmbeddedLayoutChange is set |
493 # - ensure that antsLayout always contains up-to-date Layout |
497 # - ensure that antsLayout always contains up-to-date Layout |
494 croak("$0: embedded layout change when reading file $ARGV <@antsLayout> -> <@Layout>") |
498 if (!$antsAllowEmbeddedLayoutChange && @Layout && @antsLayout && ("@Layout" ne "@antsLayout")) { |
495 if (!$antsAllowEmbeddedLayoutChange && @Layout && @antsLayout && ("@Layout" ne "@antsLayout")); |
499 my(@OL) = @antsLayout; |
|
500 my(@NL) = @Layout; |
|
501 while ($OL[0] eq $NL[0]) { |
|
502 shift(@OL); shift(@NL); |
|
503 } |
|
504 croak("$0: embedded layout change when reading file $ARGV <@OL[0..3] ...> -> <@NL[0..3] ...>") |
|
505 } |
496 @antsLayout = @Layout if (@Layout); |
506 @antsLayout = @Layout if (@Layout); |
497 |
507 |
498 $P{RECNO} = -1 unless defined($P{RECNO}); # set pseudo %PARAMs |
508 $P{RECNO} = -1 unless defined($P{RECNO}); # set pseudo %PARAMs |
499 $P{LINENO} = -1 unless defined($P{LINENO}); |
509 $P{LINENO} = -1 unless defined($P{LINENO}); |
500 $P{DEPS} = "@antsDeps"; |
510 $P{DEPS} = "@antsDeps"; |
523 } |
533 } |
524 |
534 |
525 $P{RECNO}++; # update pseudo %PARAMs |
535 $P{RECNO}++; # update pseudo %PARAMs |
526 $P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
536 $P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
527 |
537 |
528 s/[Nn][Aa][Nn]/nan/g; # make all nans lower case |
538 s/[Nn][Aa][Nn]/NaN/g; # turn all nan into NaN |
529 |
539 |
530 local(@in) = split($opt_I); # needs to be local for -S |
540 local(@in) = split($opt_I); # needs to be local for -S |
531 if (@in > $antsBufNFields) { # increase # of fields to expect |
541 if (@in > $antsBufNFields) { # increase # of fields to expect |
532 $antsBufNFields = @in; |
542 $antsBufNFields = @in; |
533 for ($i=0; $i<$#ants_; $i++) { # update recs already in buffer |
543 for ($i=0; $i<$#ants_; $i++) { # update recs already in buffer |
534 push(@{$ants_[$i]},nan) |
544 push(@{$ants_[$i]},NaN) |
535 while ($#{$ants_[$i]}+1 < $antsBufNFields); |
545 while ($#{$ants_[$i]}+1 < $antsBufNFields); |
536 } |
546 } |
537 } |
547 } |
538 push(@in,nan) # pad current record |
548 push(@in,NaN) # pad current record |
539 while (@in<$antsBufNFields); |
549 while (@in<$antsBufNFields); |
540 |
550 |
541 if (defined($opt_S)) { # -S)elect |
551 if (defined($opt_S)) { # -S)elect |
542 $opt_S = &antsCompileAddrExpr($opt_S,\'$in\') |
552 $opt_S = &antsCompileAddrExpr($opt_S,\'$in\') |
543 unless ref($opt_S); |
553 unless ref($opt_S); |
568 |
578 |
569 ### if ($#{$ants_[$#ants_]}+1 > $antsBufNFields) { # grow # of fields |
579 ### if ($#{$ants_[$#ants_]}+1 > $antsBufNFields) { # grow # of fields |
570 ### $antsBufNFields = $#{$ants_[$#ants_]} + 1; |
580 ### $antsBufNFields = $#{$ants_[$#ants_]} + 1; |
571 #### print("antsBufNFields := $antsBufNFields --- $_"); |
581 #### print("antsBufNFields := $antsBufNFields --- $_"); |
572 ### for ($i=0; $i<$#ants_; $i++) { |
582 ### for ($i=0; $i<$#ants_; $i++) { |
573 ### push(@{$ants_[$i]},nan) |
583 ### push(@{$ants_[$i]},NaN) |
574 ### while ($#{$ants_[$i]}+1 < $antsBufNFields); |
584 ### while ($#{$ants_[$i]}+1 < $antsBufNFields); |
575 ### } |
585 ### } |
576 ### } |
586 ### } |
577 ### } |
587 ### } |
578 ### push(@{$ants_[$#ants_]},nan) # pad this |
588 ### push(@{$ants_[$#ants_]},NaN) # pad this |
579 ### while ($#{$ants_[$#ants_]}+1 < $antsBufNFields); |
589 ### while ($#{$ants_[$#ants_]}+1 < $antsBufNFields); |
580 } |
590 } |
581 |
591 |
582 $ants_ = ($#ants_ - $#ants_%2) / 2; # set current idx to centre |
592 $ants_ = ($#ants_ - $#ants_%2) / 2; # set current idx to centre |
583 # print(STDERR "reading done; $#ants_+1 recs in buf, $ants_ is cur\n"); |
593 # print(STDERR "reading done; $#ants_+1 recs in buf, $ants_ is cur\n"); |
668 if ($OEparam[$f]) { |
678 if ($OEparam[$f]) { |
669 $out[$f] = $P{$ofn[$f]}; |
679 $out[$f] = $P{$ofn[$f]}; |
670 } elsif (defined($OEfield[$f])) { |
680 } elsif (defined($OEfield[$f])) { |
671 $out[$f] = $out_buf[$OEfield[$f]]; |
681 $out[$f] = $out_buf[$OEfield[$f]]; |
672 } else { |
682 } else { |
673 $out[$f] = &{$OEexpr[$f]}; |
683 eval(\'$out[$f] = &{$OEexpr[$f]};\'); # print errors and continue |
|
684 print(STDERR $@) unless ($@ eq ""); |
674 } |
685 } |
675 } |
686 } |
676 } |
687 } |
677 |
688 |
678 # STEP 3: PRINT HEADERS |
689 # STEP 3: PRINT HEADERS |
690 |
701 |
691 |
702 |
692 # STEP 5: PRINT DATA |
703 # STEP 5: PRINT DATA |
693 |
704 |
694 $antsPadOut = @ofn if ($antsPadOut >= 0 && @ofn); |
705 $antsPadOut = @ofn if ($antsPadOut >= 0 && @ofn); |
695 push(@out,nan) while (@out < $antsPadOut); |
706 push(@out,NaN) while (@out < $antsPadOut); |
696 |
707 |
697 my($outStr); |
708 my($outStr); |
698 for (my($fnr)=0; $fnr<=$#out; $fnr++) { |
709 for (my($fnr)=0; $fnr<=$#out; $fnr++) { |
699 $out[$fnr] = |
710 $out[$fnr] = |
700 fmtNum($out[$fnr], |
711 fmtNum($out[$fnr], |
701 @antsNewLayout ? $antsNewLayout[$fnr] : $antsLayout[$fnr]); |
712 @antsNewLayout ? $antsNewLayout[$fnr] : $antsLayout[$fnr]); |
702 $outStr .= (defined($out[$fnr]) && $out[$fnr] ne "" ? $out[$fnr] : nan) |
713 $outStr .= (defined($out[$fnr]) && $out[$fnr] ne "" ? $out[$fnr] : NaN) |
703 . ($fnr == $#out ? $opt_R : $opt_O); |
714 . ($fnr == $#out ? $opt_R : $opt_O); |
704 } |
715 } |
705 print($outStr); |
716 print($outStr); |
706 |
717 |
707 # STEP 6: DONE, DUE TO -F WITH PARAMS ONLY |
718 # STEP 6: DONE, DUE TO -F WITH PARAMS ONLY |
753 sub antsSetR_($$$) # set field in any rec |
764 sub antsSetR_($$$) # set field in any rec |
754 { my($r,$f,$v) = @_; |
765 { my($r,$f,$v) = @_; |
755 $antsBufNFields = $f+1 # auto extension |
766 $antsBufNFields = $f+1 # auto extension |
756 if ($antsBufNFields-1 < $f); |
767 if ($antsBufNFields-1 < $f); |
757 while ($#{$ants_[$r]} < $f-1) { |
768 while ($#{$ants_[$r]} < $f-1) { |
758 push(@{$ants_[$r]},nan); |
769 push(@{$ants_[$r]},NaN); |
759 } |
770 } |
760 $ants_[$r][$f] = $v; |
771 $ants_[$r][$f] = $v; |
761 } |
772 } |
762 |
773 |
763 sub antsSet_($$) # set field in current rec |
774 sub antsSet_($$) # set field in current rec |