← Back to branch summary

~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to t/ops.t

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
Import upstream version 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/ops.t
 
1
use PDL::LiteF;
 
2
kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
3
 
 
4
sub ok {
 
5
        my $no = shift ;
 
6
        my $result = shift ;
 
7
        print "not " unless $result ;
 
8
        print "ok $no\n" ;
 
9
}
 
10
 
 
11
sub tapprox {
 
12
        my($a,$b,$c,$d) = @_;
 
13
        $c = abs($a-$b);
 
14
        $d = max($c);
 
15
        return $d < 0.01;
 
16
}
 
17
 
 
18
print "1..38\n";
 
19
 
 
20
# $a0 = zeroes 3,5;
 
21
# $b0 = xvals $a0;
 
22
 
 
23
$a = xvals zeroes 3,5;
 
24
 
 
25
$b = yvals zeroes 3,5;
 
26
 
 
27
$c = $a + $b;
 
28
 
 
29
ok(1,$c->at(2,2) == 4);
 
30
ok(2,$c->at(2,3) == 5);
 
31
eval '$c->at(3,3)';
 
32
ok(3,$@ =~ /Position out of range/);
 
33
 
 
34
$d = pdl 5,6;
 
35
 
 
36
$e = $d - 1;
 
37
ok(4,$e->at(0) == 4);
 
38
ok(5,$e->at(1) == 5);
 
39
$f = 1 - $d;
 
40
ok(6,$f->at(0) == -4);
 
41
ok(7,$f->at(1) == -5);
 
42
 
 
43
# Now, test one operator from each group
 
44
# biop1 tested already
 
45
 
 
46
$a = pdl 0,1,2;
 
47
$b = pdl 1.5;
 
48
 
 
49
$c = $a > $b;
 
50
 
 
51
ok(8,$c->at(1) == 0);
 
52
ok(9,$c->at(2) == 1);
 
53
 
 
54
$a = byte pdl 0,1,3;
 
55
$c = $a << 2;
 
56
 
 
57
ok(10,$c->at(0) == 0);
 
58
ok(11,$c->at(1) == 4);
 
59
ok(12,$c->at(2) == 12);
 
60
 
 
61
 
 
62
$a = pdl 16,64,9;
 
63
$b = sqrt($a);
 
64
 
 
65
ok(13,tapprox($b,(pdl 4,8,3)));
 
66
 
 
67
# See that a is unchanged.
 
68
 
 
69
ok(14,$a->at(0) == 16);
 
70
 
 
71
$a = pdl 1,0;
 
72
$b = ! $a;
 
73
ok(15,$b->at(0) == 0);
 
74
ok(16,$b->at(1) == 1);
 
75
 
 
76
$a = pdl 12,13,14,15,16,17;
 
77
$b = $a % 3;
 
78
 
 
79
ok(17,$b->at(0) == 0);
 
80
ok(18,$b->at(1) == 1);
 
81
ok(19,$b->at(3) == 0);
 
82
 
 
83
# Might as well test this also
 
84
 
 
85
ok(20,tapprox((pdl 2,3),(pdl 2,3)));
 
86
ok(21,!tapprox((pdl 2,3),(pdl 2,4)));
 
87
 
 
88
# Simple function tests
 
89
 
 
90
$a = pdl(2,3);
 
91
ok(22, tapprox(exp($a), pdl(7.3891,20.0855)));
 
92
ok(23, tapprox(sqrt($a), pdl(1.4142, 1.7321)));
 
93
 
 
94
# And and Or
 
95
 
 
96
ok(24, tapprox(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0)));
 
97
ok(25, tapprox(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1)));
 
98
 
 
99
# atan2
 
100
ok (26, tapprox(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1)));
 
101
 
 
102
$a = sequence (3,4);
 
103
$b = sequence (3,4) + 1;
 
104
 
 
105
ok (27, tapprox($a->or2($b,0), $a | $b));
 
106
ok (28, tapprox($a->and2($b,0), $a & $b));
 
107
ok (29, tapprox($b->minus($a,0), $b - $a));
 
108
ok (30, tapprox($b - $a, ones(3,4)));
 
109
 
 
110
# inplace tests
 
111
 
 
112
$a = pdl 1;
 
113
$sq2 = sqrt 2; # perl sqrt
 
114
$a->inplace->plus(1,0);  # trailing 0 is ugly swap-flag
 
115
ok(31, tapprox $a, pdl 2);
 
116
$warning_shutup = $warning_shutup = sqrt $a->inplace;
 
117
ok(32, tapprox $a, pdl($sq2));
 
118
$a = pdl 4;
 
119
ok(33, tapprox 2, sqrt($a->inplace));
 
120
 
 
121
# log10 now uses C library
 
122
# check using scalars and piddles
 
123
$a = log10(110);
 
124
$b = log(110) / log(10);
 
125
print "a: $a  [ref(\$a)='", ref($a),"']\n";
 
126
print "b: $b\n";
 
127
ok(34, abs($a-$b) < 1.0e-5 );
 
128
$a = log10(pdl(110,23));
 
129
$b = log(pdl(110,23)) / log(10);
 
130
print "a: $a\n";
 
131
print "b: $b\n";
 
132
ok(35, tapprox $a, $b );
 
133
 
 
134
# check inplace
 
135
ok(36, tapprox pdl(110,23)->inplace->log10(), $b );
 
136
$data = ones 5;
 
137
$data &= 0;
 
138
ok(37, all $data == 0);
 
139
$data |= 1;
 
140
ok(38, all $data == 1);