[Perldl] make qsort[vec] inplace aware

[Tim Haines]

Greetings, all.

I recently had cause to sort a piddle inplace, but it looks like
PDL::Ufunc::qsort is not inplace aware.

use strict;
use warnings;
use PDL;
my $pdl = sequence(10)->rotate(1);
print $pdl, "\n";
$pdl->inplace->qsort;
print $pdl,"\n";

I added Inplace=>1 to the pp_def for qsort and qsortvec, and tests for each.

Diff against latest repository is attached.

Many thanks.

- Tim


PDL 2.4.11, Perl 5.14.2, Ubuntu 12.04 kernel 3.2.0-26 x86_64

diff --git a/Basic/Ufunc/ufunc.pd b/Basic/Ufunc/ufunc.pd
index 7e5fafa..1a34887 100644
--- a/Basic/Ufunc/ufunc.pd
+++ b/Basic/Ufunc/ufunc.pd
@@ -1036,6 +1036,7 @@ pp_add_exported('', 'minmax');
 pp_def(
     'qsort',
     HandleBad => 1,
+    Inplace => 1,
     Pars => 'a(n); [o]b(n);',
     Code => 
     'int nn;
@@ -1131,6 +1132,7 @@ Quicksort a vector and return index of elements in 
ascending order.
 pp_def(
     'qsortvec',
     HandleBad => 1,
+    Inplace => 1,
     Pars => 'a(n,m); [o]b(n,m);',
     Code => 
     'int nn;
diff --git a/t/ufunc.t b/t/ufunc.t
index d2afded..95ffe04 100644
--- a/t/ufunc.t
+++ b/t/ufunc.t
@@ -3,7 +3,7 @@
 # Test some Basic/Ufunc routines
 
 use strict;
-use Test::More tests => 15;
+use Test::More tests => 19;
 
 BEGIN {
     # if we've got this far in the tests then 
@@ -28,6 +28,10 @@ my $b = pdl(55);
 my $b_sort = $b->qsort;
 my $c = cat($a,$a);
 my $c_sort = $c->qsort;
+my $d = sequence(10)->rotate(1);
+my $d_sort = $d->qsort;
+my $e = pdl([[1,2],[0,500],[2,3],[4,2],[3,4],[3,5]]);
+my $e_sort = $e->qsortvec;
 
 # Test a range of values
 ok( tapprox($a->pctover(-0.5), $a_sort->at(0)), "pct below 0 for 25-elem pdl" 
);
@@ -46,6 +50,26 @@ ok( tapprox($x->pctover(0.23), 2.07), "23rd percential of 
10-elem piddle [SF bug
 #
 ok( ( eval { pdl([])->qsorti }, $@ eq '' ), "qsorti coredump,[SF bug 
2110074]");
 
+# Test inplace sorting
+$d->inplace->qsort;
+ok(all($d == $d_sort));
+
+# Test inplace sorting with bad values
+$d->setbadat(3);
+$d_sort = $d->qsort;
+$d->inplace->qsort;
+ok(all($d == $d_sort));
+
+# Test inplace lexicographical sorting
+$e->inplace->qsortvec;
+ok(all($e == $e_sort));
+
+# Test inplace lexicographical sorting with bad values
+$e->setbadat(1,3);
+$e_sort = $e->qsortvec;
+$e->inplace->qsortvec;
+ok(all($e == $e_sort));
+
 # test bad value handling with pctover
 #
 SKIP: {

_______________________________________________
Perldl mailing list
Perldl@jach.hawaii.edu
http://mailman.jach.hawaii.edu/mailman/listinfo/perldl