line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
$DEBUG = 0; |
2
|
|
|
|
|
|
|
my $eps = 1e-8; |
3
|
|
|
|
|
|
|
######### help funcs |
4
|
|
|
|
|
|
|
sub ok_matrix ($$$) |
5
|
|
|
|
|
|
|
{ |
6
|
69
|
|
|
69
|
|
1187
|
my ($a, $b, $msg) = @_; |
7
|
69
|
|
|
|
|
220
|
my $res = abs($a-$b); |
8
|
69
|
|
|
|
|
347
|
ok( similar($a,$b) , $msg); |
9
|
69
|
50
|
|
|
|
26520
|
print " (|Delta| = $res)\n" if $DEBUG; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
sub ok_matrix_orthogonal ($) |
12
|
|
|
|
|
|
|
{ |
13
|
7
|
|
|
7
|
|
36
|
my ($M) = @_; |
14
|
7
|
|
|
|
|
24
|
my $tmp = $M->shadow(); |
15
|
7
|
|
|
|
|
25
|
$tmp->one(); |
16
|
7
|
|
|
|
|
16
|
my $transp = $M->shadow(); |
17
|
7
|
|
|
|
|
26
|
$transp->transpose($M); |
18
|
7
|
|
|
|
|
27
|
$tmp->subtract($M->multiply($transp), $tmp); |
19
|
7
|
|
|
|
|
87
|
my $v = $tmp->norm_one(); |
20
|
7
|
|
|
|
|
33
|
ok(($v < $eps), 'matrix is orthogonal'); |
21
|
7
|
50
|
|
|
|
3819
|
print " (|M * ~M - I| = $v)\n" if $DEBUG; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
sub ok_eigenvectors ($$$;$) |
24
|
|
|
|
|
|
|
{ |
25
|
7
|
|
|
7
|
|
125
|
my ($M, $L, $V, $msg) = @_; |
26
|
7
|
|
50
|
|
|
40
|
$msg ||= 'eigenvectors computed correctly'; |
27
|
|
|
|
|
|
|
# Now check that all of them correspond to eigenvalue * eigenvector |
28
|
7
|
|
|
|
|
38
|
my ($rows, $columns) = $M->dim(); |
29
|
7
|
50
|
|
|
|
20
|
unless ($rows == $columns) { |
30
|
0
|
|
|
|
|
0
|
ok(0,'matrix should be square to compute eigenvalues'); |
31
|
0
|
|
|
|
|
0
|
return; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
# Computes the result of all eigenvectors... |
34
|
7
|
|
|
|
|
29
|
my $test = $M * $V; |
35
|
7
|
|
|
|
|
46
|
my $test2 = $V->clone(); |
36
|
7
|
|
|
|
|
21
|
for (my $i = 1; $i <= $columns; $i++) |
37
|
|
|
|
|
|
|
{ |
38
|
105
|
|
|
|
|
164
|
my $lambda = $L->element($i,1); |
39
|
105
|
|
|
|
|
152
|
for (my $j = 1; $j <= $rows; $j++) |
40
|
|
|
|
|
|
|
{ # Compute new vector via lambda * x |
41
|
2541
|
|
|
|
|
3318
|
$test2->assign($j, $i, $lambda * $test2->element($j, $i)); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
7
|
|
|
|
|
26
|
ok_matrix($test,$test2, $msg ); |
45
|
7
|
|
|
|
|
103
|
return; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
sub similar($$;$) { |
48
|
108
|
|
|
108
|
|
465
|
my ($x,$y, $eps) = @_; |
49
|
108
|
|
100
|
|
|
356
|
$eps ||= 1e-8; |
50
|
108
|
100
|
|
|
|
340
|
abs($x-$y) < $eps ? 1 : 0; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _debug_info |
54
|
|
|
|
|
|
|
{ |
55
|
0
|
|
|
0
|
|
0
|
my($text,$object,$argument,$flag) = @_; |
56
|
|
|
|
|
|
|
|
57
|
0
|
0
|
|
|
|
0
|
unless (defined $object) { $object = 'undef'; }; |
|
0
|
|
|
|
|
0
|
|
58
|
0
|
0
|
|
|
|
0
|
unless (defined $argument) { $argument = 'undef'; }; |
|
0
|
|
|
|
|
0
|
|
59
|
0
|
0
|
|
|
|
0
|
unless (defined $flag) { $flag = 'undef'; }; |
|
0
|
|
|
|
|
0
|
|
60
|
0
|
0
|
|
|
|
0
|
if (ref($object)) { $object = ref($object); } |
|
0
|
|
|
|
|
0
|
|
61
|
0
|
0
|
|
|
|
0
|
if (ref($argument)) { $argument = ref($argument); } |
|
0
|
|
|
|
|
0
|
|
62
|
0
|
|
|
|
|
0
|
print "$text: \$obj='$object' \$arg='$argument' \$flag='$flag'\n"; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub assert_dies($;$) |
66
|
|
|
|
|
|
|
{ |
67
|
13
|
|
|
13
|
|
2718
|
my ($code,$msg) = @_; |
68
|
13
|
|
|
|
|
14
|
eval { &$code }; |
|
13
|
|
|
|
|
19
|
|
69
|
13
|
|
|
|
|
287
|
ok($@, $msg); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |