File Coverage

funcs.pl
Criterion Covered Total %
statement 32 46 69.5
branch 5 18 27.7
condition 3 4 75.0
subroutine 5 6 83.3
pod n/a
total 45 74 60.8


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   1612 my ($a, $b, $msg) = @_;
7 69         705 my $res = abs($a-$b);
8 69         538 ok( similar($a,$b) , $msg);
9 69 50       40590 print " (|Delta| = $res)\n" if $DEBUG;
10             }
11             sub ok_matrix_orthogonal ($)
12             {
13 7     7   38 my ($M) = @_;
14 7         30 my $tmp = $M->shadow();
15 7         27 $tmp->one();
16 7         25 my $transp = $M->shadow();
17 7         27 $transp->transpose($M);
18 7         32 $tmp->subtract($M->multiply($transp), $tmp);
19 7         91 my $v = $tmp->norm_one();
20 7         42 ok(($v < $eps), 'matrix is orthogonal');
21 7 50       2985 print " (|M * ~M - I| = $v)\n" if $DEBUG;
22             }
23             sub ok_eigenvectors ($$$;$)
24             {
25 7     7   169 my ($M, $L, $V, $msg) = @_;
26 7   50     46 $msg ||= 'eigenvectors computed correctly';
27             # Now check that all of them correspond to eigenvalue * eigenvector
28 7         40 my ($rows, $columns) = $M->dim();
29 7 50       28 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         37 my $test = $M * $V;
35 7         49 my $test2 = $V->clone();
36 7         33 for (my $i = 1; $i <= $columns; $i++)
37             {
38 105         203 my $lambda = $L->element($i,1);
39 105         174 for (my $j = 1; $j <= $rows; $j++)
40             { # Compute new vector via lambda * x
41 2541         4292 $test2->assign($j, $i, $lambda * $test2->element($j, $i));
42             }
43             }
44 7         33 ok_matrix($test,$test2, $msg );
45 7         206 return;
46             }
47             sub similar($$;$) {
48 108     108   879 my ($x,$y, $eps) = @_;
49 108   100     525 $eps ||= 1e-8;
50 108 100       398 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   3793 my ($code,$msg) = @_;
68 13         22 eval { &$code };
  13         30  
69 13         422 ok($@, $msg);
70             }
71              
72             1;