|
1 #====================================================================== |
|
2 # . M A T C H _ W A R P . S T R E T C H |
|
3 # doc: Tue Aug 22 18:31:22 2006 |
|
4 # dlm: Wed Aug 23 23:51:25 2006 |
|
5 # (c) 2006 A.M. Thurnherr |
|
6 # uE-Info: 52 0 NIL 0 0 72 2 2 4 NIL ofnI |
|
7 #====================================================================== |
|
8 |
|
9 # stretch (and shift!) monotonically increasing coordinate |
|
10 |
|
11 #====================================================================== |
|
12 |
|
13 sub MW_usage(@) |
|
14 { |
|
15 croak("match-warp usage: -w stretch(<field>)\n") |
|
16 unless (@_ == 1); |
|
17 ($MW_cfname) = @_; |
|
18 |
|
19 $MW_cfnr = fnr($MW_cfname); |
|
20 $MW_cwfnr = wfnr($MW_cfname); |
|
21 |
|
22 croak("$0: field $MW_cfname must be numeric\n") |
|
23 unless numberp($ants_[0][$MW_cfnr]); |
|
24 for (my($r)=1; $r<@ants_; $r++) { |
|
25 croak("$0: field $MW_cfname of rec $r must be numeric ($ants_[$r][$MW_cfnr])\n") |
|
26 unless numberp($ants_[$r][$MW_cfnr]); |
|
27 croak("$0: field $MW_cfname must be monotonically increasing (" . |
|
28 "$ants_[$r][$MW_cfnr]=>$ants_[$r-1][$MW_cfnr]" . |
|
29 ")\n") |
|
30 unless ($ants_[$r][$MW_cfnr] >= $ants_[$r-1][$MW_cfnr]); |
|
31 } |
|
32 |
|
33 croak("$0: warp-file field $MW_cfname must be numeric\n") |
|
34 unless numberp($wf_[0][$MW_cwfnr]); |
|
35 for (my($r)=1; $r<@wf_; $r++) { |
|
36 croak("$0: warp-file field $MW_cfname of rec $r must be numeric ($wf_[$r][$MW_cwfnr])\n") |
|
37 unless numberp($wf_[$r][$MW_cwfnr]); |
|
38 croak("$0: warp-file field $MW_cfname must be monotonically increasing (" . |
|
39 "$wf_[$r][$MW_cwfnr]=>$wf_[$r-1][$MW_cwfnr]" . |
|
40 ")\n") |
|
41 unless ($wf_[$r][$MW_cwfnr] >= $wf_[$r-1][$MW_cwfnr]); |
|
42 $MW_unwarped[$r] = $wf_[$r][$MW_cwfnr]; |
|
43 } |
|
44 } |
|
45 |
|
46 #====================================================================== |
|
47 |
|
48 sub MW_warp(@) |
|
49 { |
|
50 my($offset,$scale) = @_; |
|
51 |
|
52 for (my($r)=0; $r<@wf_; $r++) { |
|
53 $wf_[$r][$MW_cwfnr] = $MW_unwarped[$r]*$scale + $offset; |
|
54 } |
|
55 } |
|
56 |
|
57 #====================================================================== |
|
58 |
|
59 1; |