39
|
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;
|