Skip to content

Commit

Permalink
LegacyComplex tests replace tapprox with is_pdl - #34
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Oct 30, 2024
1 parent 21979bb commit 5bb5088
Showing 1 changed file with 81 additions and 108 deletions.
189 changes: 81 additions & 108 deletions Libtmp/LegacyComplex/t/complex.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,7 @@ use PDL::Lite;
use PDL::Complex;
use PDL::Math;
use Test::More;

sub tapprox {
my($x,$y) = @_;
my $c = abs($x-$y);
my $d = PDL::max($c);
$d < 0.0001;
}
use Test::PDL;

# capture error in PDL::LinearAlgebra
{
Expand Down Expand Up @@ -53,20 +47,20 @@ my $ref = pdl(-1,1);
$x = i - 1;

is(ref $x, 'PDL::Complex', 'type promotion i - real scalar');
ok(tapprox($x->real,$ref), 'value from i - real scalar') or diag "x=$x, real=", $x->real, "\nexpected: $ref";
is_pdl $x->real,$ref, 'value from i - real scalar';

$x = 1 - i();
is(ref $x, 'PDL::Complex', 'type promotion real scalar - i');
ok(tapprox($x->real,-$ref), 'value from real scalar - i');
is_pdl $x->real,-$ref, 'value from real scalar - i';

my $native = pdl('[1+2i 3+4i]');
is $native.'', '[1+2i 3+4i]', 'immediate check of native and stringification'
or diag PDL::Core::pdump($native), "_ci:", PDL::Core::pdump(PDL::_ci);
my $fromn = eval { PDL::Complex->from_native($native) };
$ref = pdl([1, 2], [3, 4]);
ok tapprox($fromn->real,$ref), 'from_native works'
or diag "fromn=$fromn, fromn->real=", $fromn->real, "\nexpected: $ref",
"native:", PDL::Core::pdump($native), "fromn:", PDL::Core::pdump($fromn);
is_pdl $fromn->real,$ref, 'from_native works'
or diag "native:", PDL::Core::pdump($native),
"fromn:", PDL::Core::pdump($fromn);
is $fromn->as_native.'', $native.'', 'as_native'
or diag "fromn:", PDL::Core::pdump($fromn), "native:", PDL::Core::pdump($native);
is $fromn->as_native->type, 'cdouble', 'as_native right type';
Expand All @@ -75,141 +69,131 @@ $ref = pdl([[-2,1],[-3,1]]);
$x = i() - pdl(2,3);

is(ref $x, 'PDL::Complex', 'type promotion i - real ndarray');
ok(tapprox($x->real,$ref), 'value from i - real ndarray') or diag "x=$x, real=", $x->real;
is_pdl $x->real,$ref, 'value from i - real ndarray';

$x = pdl(2,3) - i;
is(ref $x, 'PDL::Complex', 'type promotion real ndarray - i');
ok(tapprox($x->real,-$ref), 'value from real ndarray - i');
is_pdl $x->real,-$ref, 'value from real ndarray - i';

# dataflow from complex to real
my $ar = $x->real;
$ar++;
ok(tapprox($x->real, -$ref+1), 'complex to real dataflow');
is_pdl $x->real, -$ref+1, 'complex to real dataflow';

# dataflow from real to complex when using cplx

my $refc=$ref->copy;
my $ac = $refc->cplx;
$ac .= $ac - 1 - i;
ok(tapprox($refc, $ref-1), 'real to complex dataflow') or diag "refc=$refc\nref=$ref\nac=$ac";
is_pdl $refc, $ref-1, 'real to complex dataflow';

# no dataflow from real to complex when complex

$refc=$ref->copy;
$ac = $refc->complex;
$ac .= $ac - 1 - i;
ok(tapprox($refc->real, $ref-1), 'real to complex dataflow');
is_pdl $refc->real, $ref-1, 'real to complex dataflow';

#Check Cr2p and Cp2r
ok(tapprox(Cr2p(pdl(1,1)), pdl(sqrt(2),atan2(1,1))), 'rectangular to polar');
ok(tapprox(Cp2r(pdl(sqrt(2),atan2(1,1))), pdl(1,1)), 'polar to rectangular');
is_pdl Cr2p(pdl(1,1)), pdl(sqrt(2),atan2(1,1)), 'rectangular to polar';
is_pdl Cp2r(pdl(sqrt(2),atan2(1,1))), pdl(1,1), 'polar to rectangular';

# Check that converting from re/im to mag/ang and
# back we get the same thing
$x = cplx($ref);
$y = $x->Cr2p()->Cp2r();
ok(tapprox($x-$y, 0), 'check re/im and mag/ang equivalence');
is_pdl $x, $y, 'check re/im and mag/ang equivalence';

# Test Cadd, Csub, Cmul, Cscale, Cdiv
$x=1+2*i;
$y=3+4*i;
$a=3;
my $pa=pdl(3);
is(ref Cadd($x,$y), 'PDL::Complex', 'Type of Cadd');
ok(tapprox(Cadd($x,$y)->real, $x->real+$y->real), 'Value of Cadd');
is_pdl Cadd($x,$y)->real, $x->real+$y->real, 'Value of Cadd';
is(ref Csub($x,$y), 'PDL::Complex', 'Type of Csub');
ok(tapprox(Csub($x,$y)->real, $x->real-$y->real), 'Value of Csub');
#is(ref Cmul($x,$y), 'PDL::Complex', 'Type of Cmul');
#ok(tapprox(Cmul($x,$y)->real,
# pdl($x->re*$y->re-$x->im*$y->im,
# $x->re*$y->im+$x->im*$y->re)), 'Value of Cmul');
is_pdl Csub($x,$y)->real, $x->real-$y->real, 'Value of Csub';
is(ref Cscale($x,$a), 'PDL::Complex', 'Type of Cscale with scalar');
ok(tapprox(Cscale($x,$a)->real, $x->real*$a), 'Value of Cscale with scalar');
is_pdl Cscale($x,$a)->real, $x->real*$a, 'Value of Cscale with scalar';
is(ref Cscale($x,$pa), 'PDL::Complex', 'Type of Cscale with pdl');
ok(tapprox(Cscale($x,$pa)->real, $x->real*$pa), 'Value of Cscale with pdl');
#is(ref Cdiv($x,$y), 'PDL::Complex', 'Type of Cdiv');
#ok(tapprox(Cdiv($x,$y)->real,
# Cscale(Cmul($x,$y->Cconj), 1/$y->Cabs2)->real), 'Value of Cdiv');
# to test Cabs, Cabs2, Carg (ref PDL)
is_pdl Cscale($x,$pa)->real, $x->real*$pa, 'Value of Cscale with pdl';

ok(tapprox($x->Cconj->im, -2), 'Cconj works');
ok(tapprox($x->conj->im, -2), 'conj works');
is_pdl $x->Cconj->im, pdl(-2), 'Cconj works';
is_pdl $x->conj->im, pdl(-2), 'conj works';

$x = cplx($ref);
my $cabs = sqrt($x->re**2+$x->im**2);

is(ref Cabs $x, 'PDL', 'Cabs type');
is(ref Cabs2 $x, 'PDL', 'Cabs2 type');
is(ref Carg $x, 'PDL', 'Carg type');
ok(tapprox($cabs, Cabs $x), 'Cabs value');
ok(tapprox($cabs**2, Cabs2 $x), 'Cabs2 value');
ok(tapprox(atan2($x->im, $x->re), Carg $x), 'Carg value');
is_pdl $cabs, Cabs($x), 'Cabs value';
is_pdl $cabs**2, Cabs2($x), 'Cabs2 value';
is_pdl atan2($x->im, $x->re), Carg($x), 'Carg value';

#Csin, Ccos, Ctan

is(ref Csin(i), 'PDL::Complex', 'Csin type');
ok(tapprox(Csin($x->re->r2C)->re, sin($x->re)), 'Csin of reals');
ok(tapprox(Csin(i()*$x->im)->im, sinh($x->im)), 'Csin of imags');
is_pdl Csin($x->re->r2C)->re, sin($x->re), 'Csin of reals';
is_pdl Csin(i()*$x->im)->im, sinh($x->im), 'Csin of imags';
is(ref Ccos(i), 'PDL::Complex', 'Ccos type');
ok(tapprox(Ccos($x->re->r2C)->re, cos($x->re)), 'Ccos of reals');
ok(tapprox(Ccos(i()*$x->im)->re, cosh($x->im)), 'Ccos of imags');
is_pdl Ccos($x->re->r2C)->re, cos($x->re), 'Ccos of reals';
is_pdl Ccos(i()*$x->im)->re, cosh($x->im), 'Ccos of imags';
is(ref Ctan(i), 'PDL::Complex', 'Ctan type');
ok(tapprox(Ctan($x->re->r2C)->re, tan($x->re)), 'Ctan of reals');
ok(tapprox(Ctan(i()*$x->im)->im, tanh($x->im)), 'Ctan of imags');
is_pdl Ctan($x->re->r2C)->re, tan($x->re), 'Ctan of reals';
is_pdl Ctan(i()*$x->im)->im, tanh($x->im), 'Ctan of imags';

#Cexp, Clog, Cpow
is(ref Cexp(i), 'PDL::Complex', 'Cexp type');
ok(tapprox(Cexp($x->re->r2C)->re, exp($x->re)), 'Cexp of reals');
ok(tapprox(Cexp(i()*$x->im->r2C)->real, pdl(cos($x->im), sin($x->im))->mv(1,0)),
'Cexp of imags ');
is_pdl Cexp($x->re->r2C)->re, exp($x->re), 'Cexp of reals';
is_pdl Cexp(i()*$x->im->r2C)->real, pdl(cos($x->im), sin($x->im))->mv(1,0),
'Cexp of imags ';
is(ref Clog(i), 'PDL::Complex', 'Clog type');
ok(tapprox(Clog($x)->real,
pdl(log($x->Cabs), atan2($x->im, $x->re))->mv(1,0)),
'Clog of reals');
is_pdl Clog($x)->real,
pdl(log($x->Cabs), atan2($x->im, $x->re))->mv(1,0),
'Clog of reals';
is(ref Cpow($x, r2C(2)), 'PDL::Complex', 'Cpow type');
ok(tapprox(Cpow($x,r2C(2))->real,
pdl($x->re**2-$x->im**2, 2*$x->re*$x->im)->mv(1,0)),
'Cpow value');
is_pdl Cpow($x,r2C(2))->real,
pdl($x->re**2-$x->im**2, 2*$x->re*$x->im)->mv(1,0),
'Cpow value';

#Csqrt
is(ref Csqrt($x), 'PDL::Complex', 'Csqrt type');
ok(tapprox((Csqrt($x)*Csqrt($x))->real, $x->real), 'Csqrt value');
is_pdl +(Csqrt($x)*Csqrt($x))->real, $x->real, 'Csqrt value';

ok(tapprox(Cpow(i,2)->real, pdl(-1,0)), 'scalar power of i');
ok(tapprox(Cpow(i,pdl(2))->real, pdl(-1,0)), 'real pdl power of i');
is_pdl Cpow(i,2)->real, pdl(-1,0), 'scalar power of i';
is_pdl Cpow(i,pdl(2))->real, pdl(-1,0), 'real pdl power of i';

#Casin, Cacos, Catan
is(ref Casin($x), 'PDL::Complex', 'Casin type');
ok(tapprox(Csin(Casin($x))->real, $x->real), 'Casin value');
is_pdl Csin(Casin($x))->real, $x->real, 'Casin value';
is(ref Cacos($x), 'PDL::Complex', 'Cacos type');
ok(tapprox(Ccos(Cacos($x))->real, $x->real), 'Cacos value');
is_pdl Ccos(Cacos($x))->real, $x->real, 'Cacos value';
is(ref Catan($x), 'PDL::Complex', 'Catan type');
ok(tapprox(Ctan(Catan($x))->real, $x->real), 'Catan value');
is_pdl Ctan(Catan($x))->real, $x->real, 'Catan value';

#Csinh, Ccosh, Ctanh
is(ref Csinh($x), 'PDL::Complex', 'Csinh type');
ok(tapprox(Csinh($x)->real, (i()*Csin($x/i()))->real), 'Csinh value');
is_pdl Csinh($x)->real, (i()*Csin($x/i()))->real, 'Csinh value';
is(ref Ccosh($x), 'PDL::Complex', 'Ccosh type');
ok(tapprox(Ccosh($x)->real, (Ccos($x/i()))->real), 'Ccosh value');
is_pdl Ccosh($x)->real, (Ccos($x/i()))->real, 'Ccosh value';
is(ref Ctanh($x), 'PDL::Complex', 'Ctanh type');
ok(tapprox(Ctanh($x)->real, (i()*Ctan($x/i()))->real), 'Ctanh value');
is_pdl Ctanh($x)->real, (i()*Ctan($x/i()))->real, 'Ctanh value';

#Casinh, Cacosh, Catanh
is(ref Casinh($x), 'PDL::Complex', 'Casinh type');
ok(tapprox(Csinh(Casinh($x))->real, $x->real), 'Casinh value');
is_pdl Csinh(Casinh($x))->real, $x->real, 'Casinh value';
is(ref Cacosh($x), 'PDL::Complex', 'Cacosh type');
ok(tapprox(Ccosh(Cacosh($x))->real, $x->real), 'Cacosh value');
is_pdl Ccosh(Cacosh($x))->real, $x->real, 'Cacosh value';
is(ref Catanh($x), 'PDL::Complex', 'Catanh type');
ok(tapprox(Ctanh(Catanh($x))->real, $x->real), 'Catanh value');

is_pdl Ctanh(Catanh($x))->real, $x->real, 'Catanh value';

# Croots

is(ref Croots($x, 5), 'PDL::Complex', 'Croots type');
ok(tapprox(Cpow(Croots($x, 5), r2C(5))->real, $x->real->slice(':,*1')),
'Croots value');
ok(tapprox(Croots($x, 5)->sumover, pdl(0)),
'Croots center of mass');
is(ref +(my $croots = Croots($x, 5)), 'PDL::Complex', 'Croots type');
is_pdl Cpow($croots, r2C(5))->real, $x->real->slice(':,*5'),
'Croots value';
is_pdl $croots->sumover, r2C(pdl [0,0]),
'Croots center of mass';

#Check real and imaginary parts
is((2+3*i())->re, 2, 'Real part');
Expand All @@ -218,9 +202,8 @@ is((2+3*i())->im, 3, 'Imaginary part');
#rCpolynomial
is(ref rCpolynomial(pdl(1,2,3), $x), 'PDL::Complex',
'rCpolynomial type');
ok(tapprox(rCpolynomial(pdl(1,2,3), $x)->real,
(1+2*$x+3*$x**2)->real), 'rCpolynomial value');

is_pdl rCpolynomial(pdl(1,2,3), $x)->real,
(1+2*$x+3*$x**2)->real, 'rCpolynomial value';

# Check cat'ing of PDL::Complex
$y = $x->copy + 1;
Expand Down Expand Up @@ -271,51 +254,41 @@ $x=PDL->sequence(2,3)+1;
$y=$x->copy->complex;
is(ref $y->Csumover, 'PDL::Complex', 'Type of Csumover');
is($y->Csumover->dim(0), 2, 'Dimension 0 of Csumover');
ok(tapprox($y->Csumover->real, $x->mv(1,0)->sumover),
'Csumover value');
is_pdl $y->Csumover->real, $x->mv(1,0)->sumover,
'Csumover value';
is(ref $y->sumover, 'PDL::Complex', 'Type of sumover');
is($y->sumover->dim(0), 2, 'Dimension 0 of sumover');
ok(tapprox($y->sumover->real, $x->mv(1,0)->sumover), 'sumover value');
is_pdl $y->sumover->real, $x->mv(1,0)->sumover, 'sumover value';
is(ref PDL::sumover($y), 'PDL::Complex', 'Type of sumover');
TODO: {
local $TODO="sumover as method and as function differ";
is(PDL::sumover($y)->dim(0), 2, 'Dimension 0 of sumover');
SKIP: {
todo_skip "sumover as function is real sumover", 1;
ok(tapprox(PDL::sumover($y)->real, $x->mv(1,0)->sumover), 'sumover
value');
}
}

is(ref $y->Cprodover, 'PDL::Complex', 'Type of Cprodover');
is($y->Cprodover->dim(0), 2, 'Dimension 0 of Cprodover');
my @els = map $y->slice(":,($_)"), 0..2;
ok(tapprox($y->Cprodover->real,
($els[0]*$els[1]*$els[2])->real),
'Value of Cprodover');
is_pdl $y->Cprodover->real,
($els[0]*$els[1]*$els[2])->real,
'Value of Cprodover';
is(ref $y->prodover, 'PDL::Complex', 'Type of prodover');
is($y->prodover->dim(0), 2, 'Dimension 0 of prodover');
ok(tapprox($y->prodover->real,
($els[0]*$els[1]*$els[2])->real),
'Value of prodover');

is_pdl $y->prodover->real,
($els[0]*$els[1]*$els[2])->real,
'Value of prodover';

#Check sum
$x=PDL->sequence(2,3)+1;
$y=$x->copy->complex;
is(ref $y->sum, 'PDL::Complex', 'Type of sum');
is($y->sum->dims, 1, 'Dimensions of sum');
is($y->sum->dim(0), 2, 'Dimension 0 of sum');
ok(tapprox($y->sum->real, $x->mv(1,0)->sumover), 'Value of sum');
is_pdl $y->sum->real, $x->mv(1,0)->sumover, 'Value of sum';

#Check prod
$x=PDL->sequence(2,3)+1;
$y=$x->copy->complex;
is(ref $y->prod, 'PDL::Complex', 'Type of prod');
is($y->prod->dims, 1, 'Dimensions of prod');
is($y->prod->dim(0), 2, 'Dimension 0 of prod');
ok(tapprox($y->prod->real, $y->prodover->real),
'Value of prod');
is_pdl $y->prod->real, $y->prodover->real,
'Value of prod';

{
# Check stringification of complex ndarray
Expand All @@ -333,7 +306,7 @@ TODO: {
$x=i;
$y=$x;
$y++;
ok(tapprox($x->real, $y->real), 'autoincrement flow');
is_pdl $x->real, $y->real, 'autoincrement flow';
diag("$x should have equaled $y");
}

Expand All @@ -343,7 +316,7 @@ TODO: {
$x=i;
$y=$x;
$y+=1;
ok(tapprox($x->real, $y->real), 'computed assignment flow');
is_pdl $x->real, $y->real, 'computed assignment flow';
diag("$x should have equaled $y");
}
TODO: {
Expand All @@ -353,7 +326,7 @@ TODO: {
$y=$x->copy;
$x+=$x;
$y->slice('')+=$y;
ok(tapprox($x->real, $y->real), 'computed assignment to slice');
is_pdl $x->real, $y->real, 'computed assignment to slice';
diag("$x should have equaled $y");
}

Expand All @@ -362,7 +335,7 @@ ok(Cmul($x,$y) == 4+22*i,"Cmul");
ok($x*$y == 4+22*i,"overloaded *");
ok(Cdiv($x,$y) == 1 + 0.5*i,"Cdiv");
ok($x/$y == 1+0.5*i,"overloaded /");
ok(tapprox(Cabs(atan2(pdl(1)->r2C,pdl(0)->r2C)),PDL::Math::asin(1)),"atan2");
is_pdl Cabs(atan2(pdl(1)->r2C,pdl(0)->r2C)),PDL::Math::asin(1.0),"atan2";

TODO: {
local $TODO="Transpose of complex data should leave 0-th dimension alone";
Expand Down Expand Up @@ -398,16 +371,16 @@ TODO: {
my $aa = PDL->sequence(2,3,3)->cplx;
my $up = pdl('[[0 1; 2 3; 4 5] [0 0; 8 9; 10 11] [0 0; 0 0; 16 17]]')->cplx;
my $lo = pdl('[[0 1; 0 0; 0 0] [6 7; 8 9; 0 0] [12 13; 14 15; 16 17]]')->cplx;
ok tapprox($aa->tricpy(0), $up);
ok tapprox($aa->tricpy, $up);
ok tapprox($aa->tricpy(1), $lo);
ok tapprox($aa->mstack($up), pdl('[[0 1; 2 3; 4 5] [6 7; 8 9; 10 11] [12 13; 14 15; 16 17] [0 1; 2 3; 4 5] [0 0; 8 9; 10 11] [0 0; 0 0; 16 17]]')->cplx);
is_pdl $aa->tricpy(0), $up;
is_pdl $aa->tricpy, $up;
is_pdl $aa->tricpy(1), $lo;
is_pdl $aa->mstack($up), pdl('[[0 1; 2 3; 4 5] [6 7; 8 9; 10 11] [12 13; 14 15; 16 17] [0 1; 2 3; 4 5] [0 0; 8 9; 10 11] [0 0; 0 0; 16 17]]')->cplx;
my $got;
ok tapprox($got = PDL->sequence(2,2,3)->cplx->augment(PDL->sequence(2,3,3)->cplx+10), PDL::Complex->from_native(pdl('[i 2+3i 10+i 12+3i 14+5i; 4+5i 6+7i 16+7i 18+9i 20+11i; 8+9i 10+11i 22+13i 24+15i 26+17i]'))) or diag "got: $got";
is_pdl $got = PDL->sequence(2,2,3)->cplx->augment(PDL->sequence(2,3,3)->cplx+10), PDL::Complex->from_native(pdl('[i 2+3i 10+i 12+3i 14+5i; 4+5i 6+7i 16+7i 18+9i 20+11i; 8+9i 10+11i 22+13i 24+15i 26+17i]'));
my $B = PDL::Complex->from_native(pdl('[i 2+4i 3+5i; 0 3i 7+9i]'));
ok tapprox($got = $B->t, PDL::Complex->from_native(pdl('[i 0; 2+4i 3i; 3+5i 7+9i]'))) or diag "got: $got";
ok tapprox($got = $B->t(1), PDL::Complex->from_native(pdl('[-i 0; 2-4i -3i; 3-5i 7-9i]'))) or diag "got: $got";
ok tapprox($got = PDL::Complex->from_native(PDL->sequence(3)->r2C)->t, PDL::Complex->from_native(pdl('[0; 1; 2]')->r2C)) or diag "got: $got";
is_pdl $got = $B->t, PDL::Complex->from_native(pdl('[i 0; 2+4i 3i; 3+5i 7+9i]'));
is_pdl $got = $B->t(1), PDL::Complex->from_native(pdl('[-i 0; 2-4i -3i; 3-5i 7-9i]'));
is_pdl $got = PDL::Complex->from_native(PDL->sequence(3)->r2C)->t, PDL::Complex->from_native(pdl('[0; 1; 2]')->r2C);
is_deeply $got = [PDL::Complex->from_native(pdl(3)->r2C)->t->dims], [2,1,1] or diag "got: ", explain $got;
}

Expand Down

0 comments on commit 5bb5088

Please sign in to comment.