antsfilters.pl
changeset 0 a5233793bf69
child 4 ff72b00b4342
equal deleted inserted replaced
-1:000000000000 0:a5233793bf69
       
     1 #======================================================================
       
     2 #                    A N T S F I L T E R S . P L 
       
     3 #                    doc: Sun Mar 14 15:17:29 1999
       
     4 #                    dlm: Wed Jan  5 23:34:57 2011
       
     5 #                    (c) 1999 A.M. Thurnherr
       
     6 #                    uE-Info: 15 48 NIL 0 0 72 2 2 4 NIL ofnI
       
     7 #======================================================================
       
     8 
       
     9 # HISTORY:
       
    10 #	Mar 14, 1999: - created for filters
       
    11 #	Dec 11, 1999: - made &antsXCheck() return mean dx
       
    12 #				  - BUG: dx was calculated independently of from val
       
    13 #	Mar 31, 2004: - added $fac optional param
       
    14 #	Jul  1, 2006: - Version 3.3 [HISTORY]
       
    15 #	Jan  5, 2011: - BUG: did not work for -ve dx
       
    16 
       
    17 # Implement commonly used fuctions for filters (but not worth including
       
    18 # into [./antsutils.pl] because of efficiency considerations)
       
    19 
       
    20 { my($dx) = 0;										# static vars
       
    21 
       
    22 sub antsXCheck($$$) # ($xfnr,$from,$to,$fac) -> mean dx	# sanity check on @ants_
       
    23 {
       
    24 	my($xfnr,$from,$to,$fac) = @_;
       
    25 	my($cdx,$r,$sdx);
       
    26 
       
    27 	$fac = 2 unless defined($fac);
       
    28 
       
    29 	unless ($dx) {									# find goal dx
       
    30 		croak("$0: can't handle nan (x field)\n")
       
    31 			unless (numberp($ants_[0][$xfnr]) && numberp($ants_[1][$xfnr]));
       
    32 		$dx = $ants_[$from+1][$xfnr] - $ants_[$from][$xfnr];
       
    33 	}
       
    34 	for ($r=$from+1; $r <= $to; $r++) {
       
    35 		croak("$0: can't handle $ants_[$r][$xfnr] (x field)\n")
       
    36 			unless (numberp($ants_[$r][$xfnr]));
       
    37 		$cdx = $ants_[$r][$xfnr] - $ants_[$r-1][$xfnr];
       
    38 		croak("$0: input badly non-uniformly spaced " .
       
    39 			"(rec# $r is $ants_[$r][$xfnr]; previous is $ants_[$r-1][$xfnr];" .
       
    40 			" target difference is $dx)\n")
       
    41 			if (($dx > 0) && ($cdx > $fac*$dx || $cdx < $dx/$fac)) ||
       
    42 			   (($dx < 0) && ($cdx < $fac*$dx || $cdx > $dx/$fac));
       
    43 		$sdx += $cdx;
       
    44 	}
       
    45 	return $sdx/($to-$from);
       
    46 }
       
    47 
       
    48 } # end of $dx static scope
       
    49 
       
    50 1;