"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/t/basic.t" (25 May 2022, 4153 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "basic.t": 2.079_vs_2.080.

    1 use strict;
    2 use warnings;
    3 use Test::More;
    4 use PDL::LiteF;
    5 
    6 sub tapprox {
    7     my($x,$y) = @_;
    8     my $d = max( abs($x-$y) );
    9     $d < 1.0e-6;
   10 }
   11 
   12 my $x0 = pdl( [ 2, 1, 2 ], [ 1, 0, 1 ], [ 2, 1, 2 ] );
   13 
   14 my $a1 = rvals(3,3);
   15 ok( tapprox( $x0->sqrt, $a1 ), "centered rvals" ) or diag $a1;
   16 
   17 my $a2 = rvals(3,3,{squared=>1});
   18 ok( tapprox( $x0, $a2 ), "centered rvals squared" ) or diag $a2;
   19 
   20 my $x1 = pdl( [ 8, 5, 4 ], [ 5, 2, 1 ], [ 4, 1, 0 ] );
   21 
   22 my $a3 = rvals(3,3,{centre=>[2,2]});
   23 ok( tapprox( $x1->sqrt, $a3 ), "non-centered rvals" ) or diag $a3;
   24 
   25 my $a4 = rvals(3,3,{center=>[2,2]});
   26 ok( tapprox( $x1->sqrt, $a4 ), "centre/center synonyms" ) or diag $a4;
   27 
   28 my $a5 = rvals(3,3,{ceNteR=>[2,2]});
   29 ok( tapprox( $x1->sqrt, $a5 ), "ceNteR option capitalization" ) or diag $a5;
   30 
   31 my $a6 = rvals(3,3,{center=>[2,2],squared=>1});
   32 ok( tapprox( $x1, $a6 ), "both center and squared options" ) or diag $a6;
   33 
   34 # test (x|y|z)(lin|log)vals: shape and values
   35 {
   36 my $a1=zeroes(101,51,26);
   37 my $x = $a1->xlinvals(0.5,1.5);
   38 my $y = $a1->ylinvals(-2,-1);
   39 my $z = $a1->zlinvals(-3,2);
   40 ok(all($a1->shape==$x->shape), "xlinvals shape"); #7
   41 ok(all($a1->shape==$y->shape), "ylinvals shape"); #8
   42 ok(all($x->shape==$z->shape), "zlinvals shape"); #9
   43 ok(tapprox($x->uniqvec->flat,pdl(50..150)/100),"xlinvals values"); #10
   44 ok(tapprox($y->mv(1,0)->uniqvec->flat,pdl(-100..-50)/50),"ylinvals values"); #11
   45 ok(tapprox($z->mv(2,0)->uniqvec->flat,pdl(0..25)/5-3),"zlinvals values"); #12
   46 $a1->inplace->xvals;
   47 my $got = $a1->slice('(10),(0),(0)');
   48 ok tapprox($got, 10), 'inplace xvals works' or diag "got:$got";
   49 }
   50 
   51 {
   52 my $x = zeroes(11,6,8);
   53 my $xl = $x->xlogvals(1e2,1e12);
   54 my $yl = $x->ylogvals(1e-3,1e2);
   55 my $zl = $x->zlogvals(1e-10,1e-3);
   56 ok(all($x->shape==$xl->shape),"xlogvals shape"); #13
   57 ok(all($x->shape==$yl->shape),"ylogvals shape"); #14
   58 ok(all($x->shape==$zl->shape),"zlogvals shape"); #15
   59 ok(tapprox($xl->uniqvec->flat->log10,pdl(2..12)),"xlogvals values"); #16
   60 ok(tapprox($yl->mv(1,0)->uniqvec->flat->log10,pdl(-3..2)),"ylogvals values"); #17
   61 ok(tapprox($zl->mv(2,0)->uniqvec->flat->log10,pdl(-10..-3)),"zlogvals values");#18
   62 }
   63 #test axisvals
   64 my $z = axisvals(zeroes(3,4,5,6),3);
   65 ok(all($z==pdl(0..5)->dummy(0,5)->dummy(0,4)->dummy(0,3)),"4-dimensional axisvals");#19
   66 
   67 {
   68 my $x = pdl [15.4,15.8,16.01,16.9,16.1,15.2,15.4,16.2,15.4,16.2,16.4];
   69 eval { hist ($x,15,15,0.1) }; # shouldn't segfault!
   70 isnt $@, '', 'error thrown';
   71 my ($hx,$h) = hist ($x,15,17,0.1);
   72 ok( tapprox($hx, pdl(qw/15.05   15.15 15.25   15.35   15.45   15.55   15.65
   73    15.75   15.85   15.95   16.05   16.15 16.25   16.35   16.45   16.55   16.65
   74    16.75   16.85   16.95/)), "bin centers");
   75 ok( tapprox($h, pdl(qw/0 1 0 0 3 0 0 0 1 0 1 3 0 1 0 0 0 0 1 0/)), "hist vals");
   76 }
   77 
   78 {
   79 my $x  = pdl( qw{ 13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9
   80 	       11 11 12 6 12 7} );
   81 my $wt = pdl( qw{ -7.4733817 -3.0945993 -1.7320649 -0.92823577 -0.34618392
   82 	       -1.3326057 -1.3267382 -0.032047153 0.067103333 -0.11446796
   83 	       -0.72841944 0.95928255  1.4888114 0.17143622 0.14107419
   84 	       -1.6368404    0.72917 -2.0766962 -0.66708236 -0.52959271
   85 	       1.1551274   0.079184  1.4068289 0.038689811 0.87947996
   86 	       -0.88373274  } );
   87 my ( $hx, $h ) = whist ($x, $wt, 0, 20, 1 );
   88 ok( tapprox($hx,
   89 	 pdl(qw{ 0.5 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5
   90 		 11.5 12.5 13.5 14.5 15.5 16.5 17.5 18.5 19.5 }) ), "weighted bin centers");
   91 ok( tapprox($h,
   92 	 pdl(qw{ 0 0 0 0 0 0 0.21012603 -1.4716175 0.14107419 -2.2025149
   93 		 -6.5025629  2.0305847  1.5871794 -9.5787698 0 0 0 0 0 0 }) ), "weighted hist vals");
   94 }
   95 
   96 my $a0 = zeroes(3,2);
   97 
   98 $a1 = xvals $a0;
   99 
  100 is($a1->at(0,0), 0, "xvals 0,0 == 0");
  101 is($a1->at(1,0), 1, "xvals 1,0 == 1");
  102 is($a1->at(2,0), 2, "xvals 2,0 == 2");
  103 is($a1->at(1,1), 1, "xvals 1,1 == 1");
  104 
  105 # sequence as instance method
  106 my $seq_src = pdl(indx, [9,8,7]);
  107 my $seq_dst = $seq_src->sequence;
  108 is $seq_dst->type, $seq_src->type, 'sequence as instance-method should maintain type';
  109 is_deeply [$seq_dst->dims], [$seq_src->dims], "sequence as instance-method should maintain dims";
  110 is_deeply [$seq_dst->list], [0..($seq_src->nelem-1)], "sequence as instance-method should enumerate all elements";
  111 
  112 done_testing;