From 20d06d89742dd8e88dc06aa55a38dc89ba06e2da Mon Sep 17 00:00:00 2001 From: Ed J Date: Fri, 6 Sep 2024 16:01:19 +0100 Subject: [PATCH] moved augment, mstack, tricpy, t to PDL 2.091 --- Changes | 2 + Complex/complex.pd | 56 ---------------------- Makefile.PL | 4 +- Real/real.pd | 101 --------------------------------------- lib/PDL/LinearAlgebra.pm | 13 +---- t/1.t | 11 ----- t/legacy.t | 4 -- 7 files changed, 5 insertions(+), 186 deletions(-) diff --git a/Changes b/Changes index dea5b74..1326c4b 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +- moved augment, mstack, tricpy, t to PDL 2.091 + 0.39 2024-07-23 - bump minimum PDL to 2.083 as tricpy needs ArgOrder diff --git a/Complex/complex.pd b/Complex/complex.pd index 504526c..3a635c2 100644 --- a/Complex/complex.pd +++ b/Complex/complex.pd @@ -4890,62 +4890,6 @@ EOF &(integer){1}); '); -################################################################################ -# -# OTHER AUXILIARY ROUTINES -# -################################################################################ -pp_def( - 'ctricpy', - Pars => 'A(c=2,m,n);[o] C(c=2,m,n)', - OtherPars => 'int uplo', - OtherParsDefaults => {uplo => 0}, - ArgOrder => [qw(A uplo C)], - Code => ' - if ($COMP(uplo)) - { - broadcastloop %{ - loop (n,m) %{ - loop(c) %{ $C() = $A(); %} - if (m >= n) break; - %} - %} - } - else - { - broadcastloop %{ - loop (m,n) %{ - loop(c) %{ $C() = $A(); %} - if (n >= m) break; - %} - %} - } - ', - Doc => undef -); - -pp_bless('PDL'); -pp_def('cmstack', - DefaultFlow => 1, - TwoWay => 1, - Pars => 'x(c,n,m);y(c,n,p);[o]out(c,n,q=CALC($SIZE(m)+$SIZE(p)));', - Code => ' -loop (m,n,c) %{ $out(q=>m) = $x(); %} -loop (q=$SIZE(m),n,c) %{ $out() = $y(p=>q-$SIZE(m)); %} -', - BackCode => ' -loop (m,n,c) %{ $x() = $out(q=>m); %} -loop (q=$SIZE(m),n,c) %{ $y(p=>q-$SIZE(m)) = $out(); %} -', - Doc => < 'irc://irc.perl.org/#pdl', }, CONFIGURE_REQUIRES => { - "PDL" => '2.083', + "PDL" => '2.091', "Devel::CheckLib" => 0, "ExtUtils::F77" => '1.26', }, PREREQ_PM => { - "PDL" => '2.088', # =CALC + "PDL" => '2.091', # tricpy etc }, TEST_REQUIRES => { "Test::More" => '0.88', # done_testing diff --git a/Real/real.pd b/Real/real.pd index 18b10ee..d67516f 100644 --- a/Real/real.pd +++ b/Real/real.pd @@ -10452,63 +10452,6 @@ the exponent range, as is found on a Cray. labad ($underflow, $overflow); '); -################################################################################ -# -# OTHER AUXILIARY ROUTINES -# -################################################################################ -pp_def( - 'tricpy', - Pars => 'A(m,n);[o] C(m,n)', - OtherPars => 'int uplo', - OtherParsDefaults => {uplo => 0}, - ArgOrder => [qw(A uplo C)], - GenericTypes => [ppdefs_all()], - Code => ' - if ($COMP(uplo)) - { - broadcastloop %{ - loop(n,m) %{ - $C() = $A(); - if (m >= n) break; - %} - %} - } - else - { - broadcastloop %{ - loop(m,n) %{ - $C() = $A(); - if (n >= m) break; - %} - %} - } - ', - Doc => <<'EOT' -=for usage - -tricpy(PDL(A), int(uplo), PDL(C)) - -=for example - - use PDL::LinearAlgebra; - - $c = $a->tricpy($uplo); # explicit uplo - $c = $a->tricpy; # default upper -or - use PDL::LinearAlgebra::Real; - - tricpy($a, $uplo, $c); # modify c - -=for ref - -Copy triangular part to another matrix. If uplo == 0 copy upper triangular part. - -=cut - -EOT - -); pp_def( 'cplx_eigen', @@ -10583,50 +10526,6 @@ as computed by geev or geevx. EOT ); - -pp_def('augment', - DefaultFlow => 1, - TwoWay => 1, - Pars => 'x(n); y(p);[o]out(q=CALC($SIZE(n)+$SIZE(p)))', - GenericTypes => [ppdefs_all()], - Code => ' -loop (q=:$SIZE(n)) %{ $out() = $x(n=>q); %} -loop (q=$SIZE(n)) %{ $out() = $y(p=>q-$SIZE(n)); %} -', - BackCode => ' -loop (q=:$SIZE(n)) %{ $x(n=>q) = $out(); %} -loop (q=$SIZE(n)) %{ $y(p=>q-$SIZE(n)) = $out(); %} -', - Doc => < 1, - TwoWay => 1, - Pars => 'x(n,m);y(n,p);[o]out(n,q=CALC($SIZE(m)+$SIZE(p)));', - GenericTypes => [ppdefs_all()], - Code => ' -loop (m,n) %{ $out(q=>m) = $x(); %} -loop (q=$SIZE(m),n) %{ $out() = $y(p=>q-$SIZE(m)); %} -', - BackCode => ' -loop (m,n) %{ $x() = $out(q=>m); %} -loop (q=$SIZE(m),n) %{ $y(p=>q-$SIZE(m)) = $out(); %} -', - Doc => <t*$scale->dummy(2) : $m*$scale->dummy(2)->t; } -*t = \&PDL::t; -sub PDL::t { - my $d = $_[0]->dims_internal; - my ($m, $conj) = @_; - my $r = ($m->dims > $d+1) ? $m->xchg($d,$d+1) : $m->dummy($d); - $conj ? $r->conj : $r; -} - =head2 issym =for usage @@ -361,7 +351,6 @@ use attributes 'PDL', \&PDL::diag, 'lvalue'; Returns symmetric or Hermitian matrix from lower or upper triangular matrix. Supports inplace and threading. -Uses L or L from Lapack. =for usage diff --git a/t/1.t b/t/1.t index a8643d9..b1475c7 100644 --- a/t/1.t +++ b/t/1.t @@ -81,15 +81,4 @@ $B = identity(2); ok fapprox($got = $A x $B, $A), 'complex first' or diag "got: $got"; ok fapprox($got = $B x $A, $A), 'complex second' or diag "got: $got"; -$A = pdl '[[1 2 3] [4 5 6] [7 8 9]]'; -my $up = pdl '[[1 2 3] [0 5 6] [0 0 9]]'; -my $lo = pdl '[[1 0 0] [4 5 0] [7 8 9]]'; -ok fapprox($got = $A->tricpy(0), $up), 'upper triangle #1' or diag "got: $got"; -tricpy($A, 0, $got = null); -ok fapprox($got, $up), 'upper triangle #2' or diag "got: $got"; -ok fapprox($got = $A->tricpy, $up), 'upper triangle #3' or diag "got: $got"; -ok fapprox($got = $A->tricpy(1), $lo), 'lower triangle #1' or diag "got: $got"; -tricpy($A, 1, $got = null); -ok fapprox($got, $lo), 'lower triangle #2' or diag "got: $got"; - done_testing; diff --git a/t/legacy.t b/t/legacy.t index 87ba8db..e5a3e42 100644 --- a/t/legacy.t +++ b/t/legacy.t @@ -41,10 +41,6 @@ $aa = pdl('[[[0 1] [2 3] [4 5]] [[6 7] [8 9] [10 11]] [[12 13] [14 15] [16 17] 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; -runtest($aa, 'ctricpy', $up, [0]); -runtest($aa, 'ctricpy', $up); -runtest($aa, 'ctricpy', $lo, [1]); - do './t/common.pl'; die if $@; done_testing;