Permalink
Browse files

- dropsortx to allow comparator sub, eg. for numerical comparisons

  • Loading branch information...
1 parent 174a912 commit fbc5da7d8489a39d32acf10172239f07d3e4d859 @renormalist committed Nov 19, 2008
Showing with 61 additions and 117 deletions.
  1. +6 −0 ChangeLog
  2. +46 −98 lib/Acme/Rautavistic/Sort.pm
  3. +9 −19 t/dropsort.t
View
@@ -1,3 +1,9 @@
+2008-11-19 Steffen Schwigon <ss5@renormalist.net>
+
+ * 0.02
+
+ * "dropsortx" allows comparator sub, eg. for numerical comparisons
+
2008-04-24 Steffen Schwigon <ss5@renormalist.net>
* 0.01
@@ -3,87 +3,42 @@ package Acme::Rautavistic::Sort;
use warnings;
use strict;
+our $VERSION = '0.02';
+
use Scalar::Util 'reftype';
require Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(dropsort dropsort1 dropsort2 dropsort3 dropsort4 dropsort5 dropsort6);
-%EXPORT_TAGS = (all => [qw(dropsort dropsort1 dropsort2 dropsort3 dropsort4 dropsort5 dropsort6)]);
-
-#use Data::Dumper; print STDERR Dumper(\@res);
-
-# choose the best one
-# *{dropsort} = *{dropsort5};
-
-# sub dropsort1 {
-# return unless @_;
-# my @res = ($_[0]);
-# $_[$_] ge $res[-1] && push @res, $_[$_] for 1 .. $#_;
-# @res;
-# }
-
-# sub dropsort2 {
-# my @res = @_;
-# for ($_ = 1; $_ < @res; $_++) {
-# $res[$_] lt $res[$_-1] && splice(@res, $_--, 1);
-# }
-# @res;
-# }
-
-# sub dropsort3 {
-# my $last;
-# grep
-# {
-# (not defined $last)
-# ||
-# (defined $_ && $_ ge $last)
-# and
-# ($last = $_ or 1)
-# } @_;
-# }
-
-# sub dropsort4 {
-# my $last;
-# map
-# {
-# (not defined $last) || (defined $_ && $_ ge $last)
-# ? $last = $_
-# : ()
-# } @_;
-# }
-
-# sub dropsort5 {
+@EXPORT_OK = qw(dropsort dropsortx);
+%EXPORT_TAGS = (all => [ qw(dropsort dropsortx) ]);
+
sub dropsort {
- no warnings;
- my $last;
- map { $_ ge $last ? $last = $_ : () } @_;
+ no warnings 'uninitialized';
+ my $last;
+ map { $_ ge $last ? $last = $_ : () } @_;
}
-# #sub dropsort6(&@) {
-# sub dropsort6 {
-# no warnings;
-# my $comparator =
-# reftype($_[0]) eq 'CODE'
-# ? shift
-# : sub {
-# $a cmp $b
-# };
-# my $last;
-# map {
-# local $::a = $_;
-# local $::b = $last;
-# $comparator->() >= 0 ? $last = $_ : ()
-# } @_;
-# }
-
-# sub foosort
-# {
-# my @res = dropsort6 sub { $a <=> $b }, 1, 11, 2;
-# print STDERR (join "#", @res);
-# }
+sub dropsortx(&@)
+{
+ # magic variables $a and $b
+ use vars qw($a $b);
+ no strict 'refs';
+ no warnings 'uninitialized';
+ my $caller = caller;
+ local(*{$caller."::a"}) = \my $a;
+ local(*{$caller."::b"}) = \my $b;
+
+ my $comparator = shift;
+ my $last;
+ map {
+ $a = $_;
+ $b = $last;
+ $comparator->() >= 0 ? $last = $_ : ()
+ } @_;
+}
# TODOs / Ideas:
# Attribute : Rautavistic(dropsort)
@@ -94,24 +49,16 @@ sub dropsort {
Acme::Rautavistic::Sort - Rautavistic sort functions
-=head1 VERSION
-
-Version 0.01
-
-=cut
-
-our $VERSION = '0.01';
-
=head1 SYNOPSIS
use Acme::Rautavistic::Sort ':all';
# default alphanumeric comparison
- @res = dropsort(qw(3 2 3 1 5)); # qw(3 3 5)
- @res = dropsort(qw(cc bb dd aa ee)); # qw(cc dd ee)
+ @res = dropsort( qw(3 2 3 1 5) ); # qw(3 3 5)
+ @res = dropsort( qw(cc bb dd aa ee) ); # qw(cc dd ee)
- # numeric comparison
- @res = dropsort6 sub { $_[0] <=> $_[1] }, 1, 11, 2;
+ # force numeric comparison (or other comparators)
+ @res = dropsortx { $a <=> $b } 1, 11, 2;
=head1 DESCRIPTION
@@ -150,22 +97,28 @@ fashion, dropsort promises to revolutionise the sorting of data in
fields as diverse as commercial finance, government record-keeping,
and space exploration.
-=head1 EXPORT
-
- dropsort
-
=head1 FUNCTIONS
=head2 dropsort
- @SORTED = dropsort @VALUES
- @SORTED = dropsort sub { $_[0] <=> $_[1]}, @VALUES
+Drop sort an array:
+
+ @SORTED = dropsort @VALUES
+
+Values are compared using string comparison (i.e., C<cmp>). Use
+dropsortx to specify alternate comparators.
+
+=head2 dropsortx
-Does drop sort.
+Like dropsort but additionally takes a comparator:
-If the first argument is a sub reference, use it to do the comparison
-of two values. Please note, that due to the nature of the algorithm,
-just reversing $_[0] and $_[1] does not reverse sort the result.
+ @SORTED = dropsortx { $a <=> $b } @VALUES
+
+Use the magic variables B<$a> and B<$b> for the comparison of two
+values.
+
+Please note, that due to the nature of the algorithm, just reversing
+$a and $b does not just reverse the result list.
=head1 AUTHOR
@@ -177,11 +130,6 @@ coordinator)
=head1 BUGS
-dropsort currently only sorts by string comparison. This will
-hopefully be fixed by being able to argument it with a comparison
-function, similar to Perl's sort.
-
-
Please report any bugs or feature requests to
C<bug-acme-rautavistic-sort at rt.cpan.org>, or through the web
interface at
View
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More 'no_plan';
+use Test::More tests => 28;
use Acme::Rautavistic::Sort ':all';
# plan tests => 11;
@@ -38,24 +38,14 @@ is_deeply([dropsort (1, 2, 5, 3, 4, undef)], [ 1, 2, 5 ], 'undef does not follow
is_deeply([dropsort (1, 2, undef, 5, 3, 4, undef)], [ 1, 2, 5 ], 'undef in the middle attack');
is_deeply([undef], [ undef ], 'single undef');
-no warnings;
-TODO: {
+#no warnings;
-# local $TODO = "numeric sort via comparison function";
-# my @res = dropsort6 sub { $_[0] <=> $_[1] }, 1, 11, 2;
-# is_deeply(\@res, [ 1, 11 ], 'numeric' );
-# @res = dropsort6 1, 11, 2;
-# is_deeply(\@res, [ 1, 11, 2 ], 'default alpha numeric' );
-
-
- local $TODO = "numeric sort via comparison function";
-
- my @res = dropsort sub { Test::More::diag "$a -- $b"; $a <=> $b }, 1, 11, 2;
- is_deeply(\@res, [ 1, 11 ], 'numeric' );
- @res = dropsort 1, 11, 2;
- is_deeply(\@res, [ 1, 11, 2 ], 'default alpha numeric' );
-
-};
+my @res = dropsortx { $a <=> $b } 1, 11, 2;
+is_deeply(\@res, [ 1, 11 ], 'numeric' ); # sic!, we are *drop* sort ...
+@res = dropsortx { $a cmp $b } 1, 11, 2;
+is_deeply(\@res, [ 1, 11, 2 ], 'explicitely alpha numeric' );
+@res = dropsort 1, 11, 2;
+is_deeply(\@res, [ 1, 11, 2 ], 'default alpha numeric' );
# -------------- Benchmarks -----------------------
@@ -71,5 +61,5 @@ __END__
# 'dropsort3' => sub { dropsort3 @bigarray },
# 'dropsort4' => sub { dropsort4 @bigarray },
# 'dropsort5' => sub { dropsort5 @bigarray },
-# 'dropsort6' => sub { dropsort6 @bigarray },
+# 'dropsortx' => sub { dropsortx @bigarray },
# });

0 comments on commit fbc5da7

Please sign in to comment.