/
common.pl
140 lines (138 loc) · 8.48 KB
/
common.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
runtest(sequence(2,2), 'issym', 0);
my $a = pdl([[1.7,3.2],[9.2,7.3]]);
runtest($a, 't', $a->xchg(0,1));
my $x = pdl([0.43,0.03],[0.75,0.72]);
my $wide = pdl([0.43,0.03,0.7],[0.75,0.72,0.2]);
my $rank2 = pdl([1,0,1],[-2,-3,1],[3,3,0]);
my $schur_soln = pdl([0.36637354,-0.72],[0,0.78362646]);
$schur_soln = [$schur_soln,[pdl([0.36637354,0.72],[0,0.78362646]),$schur_soln]];
runtest($x, 'mschur', $schur_soln);
runtest($x, 'mschur', $schur_soln, [1,1,1,sub {1}]);
runtest($x, 'mschur', $schur_soln, [1,1,1,undef]);
runtest($x, 'mschur', $schur_soln, [0,1,2,sub {1},0,0]);
runtest($x, 'mschur', $schur_soln, [2,2,2,sub {1},0]);
runtest($x, 'mschur', $schur_soln, [2,2,2,sub {1},1]);
runtest($x, 'mschur', $schur_soln, [2,2,2,sub {1},0,0]);
runtest($x, 'mschur', $schur_soln, [2,2,2,undef,0,0]);
runtest($x, 'mschur', $schur_soln, [0,2,2,undef,0,0]);
runtest(sequence(2,2), 'diag', pdl(0,3));
runtest(sequence(2,2), 'diag', pdl(1), [1]);
runtest(sequence(2,2), 'diag', pdl(2), [-1]);
runtest(sequence(2,2), 'diag', pdl([[0,0],[0,1]],[[2,0],[0,3]]), [0,1]);
runtest(sequence(3,3), 'tritosym', pdl [0,1,2],[1,4,5],[2,5,8]);
runtest(pdl([1,2],[1,0]), 'mrcond', 1/3);
runtest($x, 'mtriinv', pdl([2.3255814,-0.096899225],[0.75,1.3888889]));
runtest($x, 'msyminv', pdl([2.3323615,-0.09718173],[-0.09718173,1.3929381]));
runtest($x->crossprod($x), 'mchol', pdl([0.86452299,0.63954343],[0,0.33209065]));
my $schurx_soln = [pdl([-1.605735,-6],[0,10.605735]),pdl([-1.605735,6],[0,10.605735])];
runtest($a, 'mschurx', $schurx_soln);
runtest($a, 'mschurx', $schurx_soln, [1,1,1,sub {1}]);
runtest($a, 'mschurx', $schurx_soln, [2,2,2,sub {1},0,0]);
runtest($a, 'mschurx', $schurx_soln, [2,2,2,undef,0,0]);
runtest($a, 'mschurx', $schurx_soln, [0,2,2,sub {1},1,0]);
runtest($a, 'mschurx', $schurx_soln, [0,2,2,undef,1,1]);
runtest($a, 'mschurx', $schurx_soln, [0,2,2,sub {1},1,1]);
runtest($a, 'mschurx', $schurx_soln, [0,2,2,sub {1},3,1]);
my @mgschur_exp = (pdl([-0.35099581,-0.68880032],[0,0.81795847]),
pdl([1.026674, -0.366662], [0, -0.279640]));
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2)]);
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2),1,1,1,1,sub {1}]);
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2),2,2,2,2,sub {1},0]);
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2),2,2,2,2,undef,0]);
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2),0,0,2,2,sub {1},1,0]);
runtest($x, 'mgschur', \@mgschur_exp, [sequence(2,2),0,0,2,2,undef]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2)]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),1,1,1,1,sub {1}]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),2,2,2,2,sub {1},0,0,0]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),2,2,2,2,undef,0,0,0]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),1,1,1,1,sub {1},2]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),1,1,1,1,sub {1},3]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),0,0,1,1,sub {1},1,1,0]);
runtest($x, 'mgschurx', \@mgschur_exp, [sequence(2,2),0,0,2,2,undef]);
runtest($x, 'mqr', pdl([-0.49738411,-0.86753043],[-0.86753043,0.49738411]));
runtest($wide->t, 'mqr', pdl([-0.523069,-0.5023351],[-0.0364932,-0.793903],[-0.851508,0.34260173]));
runtest($x, 'mrq', pdl([0.27614707,-0.3309725],[0,-1.0396634]));
runtest($wide, 'mrq', pdl([0,0.68317233,-0.45724782],[0,0,-1.0587256]), [1]);
runtest($wide->t, 'mrq', pdl([-0.603012,-0.619496],[-0.684055,-0.226644],[0,-0.728010]));
runtest($x, 'mql', pdl([0.99913307,-0.041630545],[-0.041630545,-0.99913307]));
runtest($wide, 'mql', pdl([0.274721,-0.961523],[-0.961523,-0.274721]));
runtest($wide->t, 'mql', pdl([0.6885185,0.155284,-0.708398],[-0.606947,-0.411253,-0.680062],[-0.396935,0.898196,-0.188906]), [1]);
runtest($x, 'mlq', pdl([-0.43104524,0],[-0.79829207,0.66605538]));
runtest($wide, 'mlq', pdl([-0.822070,0,0],[-0.588878,-0.879841,0]), [1]);
runtest($wide, 'mlq', pdl([-0.822070,0],[-0.588878,-0.879841]), [0]);
runtest($wide->t, 'mlq', pdl([-0.864522,0],[-0.639543,0.332090],[-0.521674,-0.507794]));
my $x_soln = pdl([-0.20898642,2.1943574],[2.995472,1.8808777]);
runtest($x, 'msolve', $x_soln, [sequence(2,2)]);
runtest($x, 'msolvex', $x_soln, [sequence(2,2), equilibrate=>1]);
runtest($x, 'mtrisolve', pdl([0,2.3255814],[2.7777778,1.744186]), [1,sequence(2,2)]);
my $x_symsoln = pdl([5.9311981,6.0498221],[-3.4005536,-2.1352313]);
runtest($x, 'msymsolve', $x_symsoln, [1,sequence(2,2)]);
runtest($x, 'msymsolvex', $x_symsoln, [1,sequence(2,2),1]);
runtest($x, 'mlls', $x_soln, [sequence(2,2)]);
my $wide_soln = pdl([1.712813,2.511051,3.30928],[2.706977,3.007326,3.30767],[-1.168170,-0.242816,0.682536]);
my $tall_soln = pdl([4.055021,4.995087],[0.247090,1.330964]);
runtest($wide, 'mlls', $wide_soln, [sequence(3,2)]);
runtest($wide->t, 'mlls', $tall_soln, [sequence(2,3)]);
runtest($x, 'mllsy', $x_soln, [sequence(2,2)]);
runtest($wide, 'mllsy', $wide_soln, [sequence(3,2)]);
runtest($wide->t, 'mllsy', pdl([4.055021,4.995087],[0.247090,1.330964]), [sequence(2,3)]);
runtest($x, 'mllss', $x_soln, [sequence(2,2)]);
runtest($wide, 'mllss', $wide_soln, [sequence(3,2)]);
runtest($wide->t, 'mllss', $tall_soln, [sequence(2,3)]);
runtest(pdl([1,2,3],[2,3,5],[3,4,7],[4,5,9]), 'mllss', pdl([3.333333,2.333333],[-2.666666,-1.666666],[0.666666,0.666666]), [sequence(2,4)]);
runtest($x, 'mlse', pdl([-1,1]), [sequence(2,2),ones(2),ones(2)]);
my ($posdef, $possoln) = (pdl([2,-1,0],[-1,2,-1],[0,-1,2]), pdl([3,4.5,6],[6,8,10],[6,7.5,9]));
runtest($posdef, 'mpossolve', $possoln, [1,sequence(3,3)]);
runtest($posdef, 'mpossolvex', $possoln, [1,sequence(3,3), equilibrate=>1]);
my $x_symgeigen = pdl([-0.271308,0.216112,17.055195]);
runtest(sequence(3,3), 'msymgeigen', $x_symgeigen, [$posdef]);
runtest(sequence(3,3), 'msymgeigenx', $x_symgeigen, [$posdef]);
runtest(sequence(3,3), 'msymgeigenx', $x_symgeigen, [$posdef,0,1]);
runtest($x, 'mglm', pdl([-0.10449321,1.497736],[30.95841,-44.976237]), [sequence(2,2),sequence(2,2)]);
my $x_eigen = pdl([0.366373539549749,0.783626460450251]);
runtest($x, 'meigen', $x_eigen, [1,1]);
runtest($x, 'meigenx', $x_eigen);
runtest($x, 'meigenx', $x_eigen, [rcondition=>'value', vector=>'left']);
runtest($x, 'meigenx', $x_eigen, [rcondition=>'vector', vector=>'right']);
runtest($x, 'meigenx', $x_eigen, [rcondition=>'all', permute=>1, vector=>'all']);
my $x_geigen = [pdl([-0.350995,0.817958]), pdl([1.026674,-0.279640])];
runtest($x, 'mgeigen', $x_geigen, [sequence(2,2),1,1]);
runtest($x, 'mgeigenx', $x_geigen, [sequence(2,2)]);
runtest($x, 'mgeigenx', $x_geigen, [sequence(2,2), rcondition=>'value', vector=>'left']);
runtest($x, 'mgeigenx', $x_geigen, [sequence(2,2), rcondition=>'vector', vector=>'right']);
runtest($x, 'mgeigenx', $x_geigen, [sequence(2,2), rcondition=>'all', error=>1, permute=>1, vector=>'all']);
my $x_symeigen = pdl([0.42692907,0.72307093]);
runtest($x, 'msymeigen', $x_symeigen);
runtest($x, 'msymeigenx', $x_symeigen);
runtest($x, 'msymeigenx', $x_symeigen, [0,1]);
runtest($x, 'msymeigenx', pdl(-0.188888,1.338888), [1]);
runtest($x, 'mdsvd', pdl([0.775249,0.631655],[0.631655,-0.775249]));
runtest($x, 'mgsvd', pdl(0.16914549,0.64159379), [sequence(2,2), all=>1]);
runtest(sequence(5,3)->t+1, 'mgsvd', pdl(0.980672,0.315531,0), [pdl([8,1,6],[3,5,7],[4,9,2]), all=>1]);
runtest($a, 'mdet', -17.03);
my $a_mexp = pdl([10927.432,10577.72],[30410.945,29438.441]);
runtest($a_mexp, 'mlog', $a);
my $a_mpow2 = pdl([32.33,28.8],[82.8,82.73]);
runtest($a, 'mpow', $a_mpow2, [2]);
runtest($a, 'mpow', identity(2), [0]);
runtest($a_mpow2, 'msqrt', pdl([4.042101,2.358438],[6.780510,8.169368]));
runtest($a, 'mexp', $a_mexp);
my $a_mcos = pdl([-0.128354,-0.090435],[-0.260001,-0.286616]);
runtest($a, 'mcos', $a_mcos);
my $a_msin = pdl([-0.979243,0.019501],[0.056066,-0.945116]);
runtest($a, 'msin', $a_msin);
runtest($a_mcos, 'macos', pdl([[1.7018092, 0.093001244],[0.26737858,1.8645614]]));
runtest($a_msin, 'masin', pdl([[-1.4397834,0.093001244],[0.26737858,-1.2770313]]));
runtest($a, 'morth', pdl([-0.762586,-0.646886],[-0.646886,0.762586]));
my $mnull_soln = pdl(-0.751304,0.319700,0.577350)->t;
runtest($rank2, 'mnull', [$mnull_soln, [pdl(-0.751304,0.319700,-0.577350)->t,$mnull_soln]]);
runtest($a, 'mpinv', pdl([0.463087,-0.511014],[0.0678448,-0.201667]));
runtest($a, 'mlu', pdl([1,0],[0.184782,1]));
runtest($wide->t, 'mlu', pdl([1,0],[0.042857,1],[0.614285,0.881526]));
runtest(sequence(3,3), 'mhessen', pdl([0,-2.236068,0],[-6.708203,12,3],[0,1,0]));
runtest($a, 'mrank', 2);
runtest($rank2, 'mrank', 2);
runtest($a, 'mnorm', 12.211267);
runtest($a, 'msvd', pdl(12.211267,1.3946136), [0,0]);
runtest($a, 'mcond', 8.756021);
runtest(pdl([0,1]), 'mtoeplitz', pdl([0,1],[1,0]));