view release on metacpan or  search on metacpan

lib/Sort/Naturally.pm  view on Meta::CPAN

require 5;
package Sort::Naturally;  # Time-stamp: "2004-12-29 18:30:03 AST"
$VERSION = '1.03';
@EXPORT = ('nsort', 'ncmp');
require Exporter;
@ISA = ('Exporter');

use strict;
use locale;
use integer;

#-----------------------------------------------------------------------------
# constants:
BEGIN { *DEBUG = sub () {0} unless defined &DEBUG }

use Config ();
BEGIN {
  # Make a constant such that if a whole-number string is that long
  #  or shorter, we KNOW it's treatable as an integer
  no integer;
  my $x = length(256 ** $Config::Config{'intsize'} / 2) - 1;
  die "Crazy intsize: <$Config::Config{'intsize'}>" if $x < 4;
  eval 'sub MAX_INT_SIZE () {' . $x . '}';
  die $@ if $@;
  print "intsize $Config::Config{'intsize'} => MAX_INT_SIZE $x\n" if DEBUG;
}

sub X_FIRST () {-1}
sub Y_FIRST () { 1}

my @ORD = ('same', 'swap', 'asis');

#-----------------------------------------------------------------------------
# For lack of a preprocessor:

my($code, $guts);
$guts = <<'EOGUTS';  # This is the guts of both ncmp and nsort:

    if($x eq $y) {
      # trap this expensive case first, and then fall thru to tiebreaker
      $rv = 0;

    # Convoluted hack to get numerics to sort first, at string start:
    } elsif($x =~ m/^\d/s) {
      if($y =~ m/^\d/s) {
        $rv = 0;    # fall thru to normal comparison for the two numbers
      } else {
        $rv = X_FIRST;
        DEBUG > 1 and print "Numeric-initial $x trumps letter-initial $y\n";
      }
    } elsif($y =~ m/^\d/s) {
      $rv = Y_FIRST;
      DEBUG > 1 and print "Numeric-initial $y trumps letter-initial $x\n";
    } else {
      $rv = 0;
    }

    unless($rv) {
      # Normal case:
      $rv = 0;
      DEBUG and print "<$x> and <$y> compared...\n";

lib/Sort/Naturally.pm  view on Meta::CPAN

}
EONSORT

#-----------------------------------------------------------------------------
maker(<<'EONCMP');
sub ncmp {
  # The guts are basically the same as above...

  # get options:
  my($cmp, $lc);
  ($cmp,$lc) = @{shift @_} if @_ and ref($_[0]) eq 'ARRAY';

  if(@_ == 0) {
    @_ = ($a, $b); # bit of a hack!
    DEBUG > 1 and print "Hacking in <$a><$b>\n";
  } elsif(@_ != 2) {
    require Carp;
    Carp::croak("Not enough options to ncmp!");
  }
  my($a,$b) = @_;
  my($x, $x2, $y, $y2, $rv);  # scratch vars

  DEBUG > 1 and print "ncmp args <$a><$b>\n";
  if($a eq $b) { # trap this expensive case
    0;
  } else {
    $x = ($lc ? $lc->($a) : lc($a));
    $x =~ s/\W+//s;
    $y = ($lc ? $lc->($b) : lc($b));
    $y =~ s/\W+//s;

~COMPARATOR~


    # Tiebreakers...
    DEBUG > 1 and print " -<$a> cmp <$b> is $rv ($ORD[$rv])\n";
    $rv ||= (length($x) <=> length($y))  # shorter is always first
        ||  ($cmp and $cmp->($x,$y) || $cmp->($a,$b))
        ||  ($x cmp $y)
        ||  ($a cmp $b)
    ;

    DEBUG > 1 and print "  <$a> cmp <$b> is $rv\n";
    $rv;
  }
}
EONCMP

# clean up:
undef $guts;
undef &maker;

#-----------------------------------------------------------------------------
1;

############### END OF MAIN SOURCE ###########################################
__END__

=head1 NAME

Sort::Naturally -- sort lexically, but sort numeral parts numerically

=head1 SYNOPSIS

  @them = nsort(qw(
   foo12a foo12z foo13a foo 14 9x foo12 fooa foolio Foolio Foo12a
  ));
  print join(' ', @them), "\n";

Prints:

  9x 14 foo fooa foolio Foolio foo12 foo12a Foo12a foo12z foo13a

(Or "foo12a" + "Foo12a" and "foolio" + "Foolio" and might be
switched, depending on your locale.)

=head1 DESCRIPTION

This module exports two functions, C<nsort> and C<ncmp>; they are used
in implementing my idea of a "natural sorting" algorithm.  Under natural
sorting, numeric substrings are compared numerically, and other
word-characters are compared lexically.

This is the way I define natural sorting:

=over

=item *

Non-numeric word-character substrings are sorted lexically,
case-insensitively: "Foo" comes between "fish" and "fowl".

=item *

Numeric substrings are sorted numerically:
"100" comes after "20", not before.

=item *

\W substrings (neither words-characters nor digits) are I<ignored>.

=item *

Our use of \w, \d, \D, and \W is locale-sensitive:  Sort::Naturally
uses a C<use locale> statement.

=item *

When comparing two strings, where a numeric substring in one
place is I<not> up against a numeric substring in another,
the non-numeric always comes first.  This is fudged by
reading pretending that the lack of a number substring has
the value -1, like so:

  foo       =>  "foo",  -1
  foobar    =>  "foo",  -1,  "bar"
  foo13     =>  "foo",  13,
  foo13xyz  =>  "foo",  13,  "xyz"

That's so that "foo" will come before "foo13", which will come
before "foobar".

=item *

The start of a string is exceptional: leading non-\W (non-word,
non-digit)
components are are ignored, and numbers come I<before> letters.

=item *

I define "numeric substring" just as sequences matching m/\d+/ --
scientific notation, commas, decimals, etc., are not seen.  If
your data has thousands separators in numbers
("20,000 Leagues Under The Sea" or "20.000 lieues sous les mers"),
consider stripping them before feeding them to C<nsort> or
C<ncmp>.

=back

=head2 The nsort function

This function takes a list of strings, and returns a copy of the list,
sorted.

This is what most people will want to use:

  @stuff = nsort(...list...);

When nsort needs to compare non-numeric substrings, it
uses Perl's C<lc> function in scope of a <use locale>.
And when nsort needs to lowercase things, it uses Perl's
C<lc> function in scope of a <use locale>.  If you want nsort
to use other functions instead, you can specify them in
an arrayref as the first argument to nsort:

  @stuff = nsort( [
                    \&string_comparator,   # optional
                    \&lowercaser_function  # optional
                  ],
                  ...list...
                );

If you want to specify a string comparator but no lowercaser,
then the options list is C<[\&comparator, '']> or
C<[\&comparator]>.  If you want to specify no string comparator
but a lowercaser, then the options list is
C<['', \&lowercaser]>.

Any comparator you specify is called as
C<$comparator-E<gt>($left, $right)>,
and, like a normal Perl C<cmp> replacement, must return
-1, 0, or 1 depending on whether the left argument is stringwise
less than, equal to, or greater than the right argument.

Any lowercaser function you specify is called as
C<$lowercased = $lowercaser-E<gt>($original)>.  The routine
must not modify its C<$_[0]>.

=head2 The ncmp function

Often, when sorting non-string values like this:

   @objects_sorted = sort { $a->tag cmp $b->tag } @objects;

...or even in a Schwartzian transform, like this:

   @strings =
     map $_->[0]
     sort { $a->[1] cmp $b->[1] }
     map { [$_, make_a_sort_key_from($_) ]
     @_
   ;

...you wight want something that replaces not C<sort>, but C<cmp>.
That's what Sort::Naturally's C<ncmp> function is for.  Call it with
the syntax C<ncmp($left,$right)> instead of C<$left cmp $right>,
but otherwise it's a fine replacement:

   @objects_sorted = sort { ncmp($a->tag,$b->tag) } @objects;

   @strings =
     map $_->[0]
     sort { ncmp($a->[1], $b->[1]) }
     map { [$_, make_a_sort_key_from($_) ]
     @_
   ;

Just as with C<nsort> can take different a string-comparator
and/or lowercaser, you can do the same with C<ncmp>, by passing
an arrayref as the first argument:

  ncmp( [
          \&string_comparator,   # optional
          \&lowercaser_function  # optional
        ],
        $left, $right
      )

You might get string comparators from L<Sort::ArbBiLex|Sort::ArbBiLex>.

=head1 NOTES

=over

=item *

This module is not a substitute for
L<Sort::Versions|Sort::Versions>!  If
you just need proper version sorting, use I<that!>

=item *

If you need something that works I<sort of> like this module's
functions, but not quite the same, consider scouting thru this
module's source code, and adapting what you see.  Besides
the functions that actually compile in this module, after the POD,
there's several alternate attempts of mine at natural sorting
routines, which are not compiled as part of the module, but which you
might find useful.  They should all be I<working> implementations of
slightly different algorithms
(all of them based on Martin Pool's C<nsort>) which I eventually
discarded in favor of my algorithm.  If you are having to
naturally-sort I<very large> data sets, and sorting is getting
ridiculously slow, you might consider trying one of those
discarded functions -- I have a feeling they might be faster on
large data sets.  Benchmark them on your data and see.  (Unless
you I<need> the speed, don't bother.  Hint: substitute C<sort>
for C<nsort> in your code, and unless your program speeds up
drastically, it's not the sorting that's slowing things down.
But if it I<is> C<nsort> that's slowing things down, consider
just:

      if(@set >= SOME_VERY_BIG_NUMBER) {
        no locale; # vroom vroom
        @sorted = sort(@set);  # feh, good enough