natural sort on array of arrays

[shamat]

Wise monks, how do I do a natural sort on a array of arrays? Here is my data, and what I tried so far without success:

use strict;

my @matrix;

$matrix[0][0] = 'A1a1'; #sort by this column 
$matrix[0][1] = 'img1';
$matrix[0][2] = 'x123';
$matrix[0][3] = 'y123';

$matrix[1][0] = 'A1a2';
$matrix[1][1] = 'img2';
$matrix[1][2] = 'x123';
$matrix[1][3] = 'y456';

$matrix[1][0] = 'A1a12';
$matrix[1][1] = 'img3';
$matrix[1][2] = 'x456';
$matrix[1][3] = 'y789';

$matrix[2][0] = 'A10a1';
$matrix[2][1] = 'img4';
$matrix[2][2] = 'x456';
$matrix[2][3] = 'y123';

$matrix[3][0] = 'A12a1';
$matrix[3][1] = 'img5';
$matrix[3][2] = 'x456';
$matrix[3][3] = 'y456';

my @sorted_matrix = sort {$a->[0] <=> $b->[0] || $a->[0] cmp $b->[0] }
+ @matrix;

for my $i ( 0 .. $#sorted_matrix ) {
    for my $j ( 0 .. $#{ $sorted_matrix[$i] } ) {
        print "$i $j -> $sorted_matrix[$i][$j]\n";
    }
    print "\n";
}

prints:

0 0 -> A10a1
0 1 -> img4
0 2 -> x456
0 3 -> y123

1 0 -> A12a1
1 1 -> img5
1 2 -> x456
1 3 -> y456

2 0 -> A1a1
2 1 -> img1
2 2 -> x123
2 3 -> y123

3 0 -> A1a12
3 1 -> img3
3 2 -> x456
3 3 -> y789

Instead I would like to have:

A1a1
A1a12
A10a1
A12a1

I also tried to adapt something I found on this forum, but I don't fully understand it.

my @sorted_matrix = grep {s/(^|\D)0+(\d)/$1$2/g,1} sort {$a->[0] cmp $
+b->[0]} grep {s/(\d+)/sprintf"%06.6d",$1/ge,1} @matrix;

Thanks for sharing your wisdom!

[duelafn]

Using code stolen from Re: Alpha number sort (one, true, natural sort). Like the grep/sort/grep code you have, it replaces each number with a fixed-length number-like thing that regular cmp will sort properly (the magic is in s[(\d+)][ pack "N", $1 ]ge).

my @sorted_matrix = sort { natural_cmp($a->[0], $b->[0]) } @matrix;

for my $i ( 0 .. $#sorted_matrix ) {
    for my $j ( 0 .. $#{ $sorted_matrix[$i] } ) {
        print "$i $j -> $sorted_matrix[$i][$j]\n";
    }
    print "\n";
}


=head3 natural_cmp

A fast, flexible, stable comparator that sorts strings naturally (that
+ is,
numerical substrings are compared as numbers).

Code lifted from tye on perlmonks: http://www.perlmonks.org/?node_id=4
+42285

Limitations: http://www.perlmonks.org/?node_id=483466

  It doesn't "properly" sort negative numbers, non-fixed decimal value
+s,
  nor integers larger than 2^32-1.

=cut

sub natural_cmp {
  my ($x,$y) = map { my $key = $_; $key =~ s[(\d+)][ pack "N", $1 ]ge;
+ $key } @_;
  $x cmp $y;
}

Which gives (showing just the sorting column):

0 0 -> A1a1
1 0 -> A1a12
2 0 -> A10a1
3 0 -> A12a1

[shamat]

Thank you duelafn, your code works like a charm.

[haukex]

Hi shamat,

Wow, this question brings me back to what was - as far as I can remember - probably the first time I visited PerlMonks :-) Specifically, it was Re: How do I do a natural sort on an array?, that snippet was very helpful to me over the years. So I revived it and applied it to your code:

use warnings;
use strict;

my @matrix = (
    ["A12a1", "img5", "x456", "y456"],
    ["A1a2",  "img2", "x123", "y456"],
    ["A1a1",  "img1", "x123", "y123"],
    ["A10a1", "img4", "x456", "y123"],
    ["A1a12", "img3", "x456", "y789"],
);

my @sorted = sort natsort @matrix;
use Data::Dump 'pp';
print pp \@sorted;

sub natsort {
    # sort by first column (note the dereferencing)
    my @a = split /(\d+)/, $a->[0];
    my @b = split /(\d+)/, $b->[0];
    my ($A,$B);
    while (defined($A = shift @a) and defined($B = shift @b)) {
        my $res = ($A =~ /\d/) ? $A <=> $B : $A cmp $B;
        return $res if $res;
    }
    return defined $A ? -1 : 1;
}

__END__

[
  ["A1a1", "img1", "x123", "y123"],
  ["A1a2", "img2", "x123", "y456"],
  ["A1a12", "img3", "x456", "y789"],
  ["A10a1", "img4", "x456", "y123"],
  ["A12a1", "img5", "x456", "y456"],
]

The way this works is by breaking each string up into its digits and non-digits, for example "A12a1" becomes ("A", 12, "a", 1), and then each element is compared individually. This does assume that the two strings being compared follow the same digit/non-digit pattern. Also, it's not a particularly efficient sort method, as it does a lot of work for each comparison. But it was just a walk down memory lane anyway :-)

Of course, there are also modules to do the hard work, just one example is Sort::Key::Natural.

By the way, I think you've got a mistake in your test data, you overwrite $matrix[1], that's why I've initialized the data as I showed.

Hope this helps,
-- Hauke D

[AnomalousMonk]

FWIW, here's a "roll your own" approach to the "natural" sort problem (note some extra data groups):

c:\@Work\Perl\monks>perl -wMstrict -le
"use Data::Dump qw(dd);
 ;;
 my @matrix = (
   [ qw(A1a1  img1 x123 y123) ],
   [ qw(A21a1 img8 x888 y888) ],
   [ qw(A1a2  img2 x123 y456) ],
   [ qw(A2a1  img9 x999 y999) ],
   [ qw(A1a12 img3 x456 y789) ],
   [ qw(A10a1 img4 x456 y123) ],
   [ qw(A12a1 img5 x456 y456) ],
   );
 dd \@matrix;
 ;;
 sub natural_field {
   my ($field) = @_;
   ;;
   my @fields = $field =~ m{
     \A ([[:upper:]]) (\d+) ([[:lower:]]) (\d+) \z
     }xms
     or die qq{bad sort field: '$field'}
     ;
   return pack 'a N a N', @fields;
   }
 ;;
 my @sorted =
   map  $_->[0],
   sort { $a->[1] cmp $b->[1] }
   map  [ $_, natural_field($_->[0]) ],
   @matrix
   ;
 dd \@sorted;
"
[
  ["A1a1", "img1", "x123", "y123"],
  ["A21a1", "img8", "x888", "y888"],
  ["A1a2", "img2", "x123", "y456"],
  ["A2a1", "img9", "x999", "y999"],
  ["A1a12", "img3", "x456", "y789"],
  ["A10a1", "img4", "x456", "y123"],
  ["A12a1", "img5", "x456", "y456"],
]

[
  ["A1a1", "img1", "x123", "y123"],
  ["A1a2", "img2", "x123", "y456"],
  ["A1a12", "img3", "x456", "y789"],
  ["A2a1", "img9", "x999", "y999"],
  ["A10a1", "img4", "x456", "y123"],
  ["A12a1", "img5", "x456", "y456"],
  ["A21a1", "img8", "x888", "y888"],
]

Update: As an afterthought, a GRT version that might be advantageous for really large arrays, and a testing framework:

Read more... (2 kB)
More test cases, especially corner cases, wouldn't hurt.

[hippo]

I also tried to adapt something I found on this forum, but I don't fully understand it.

my @sorted_matrix = grep {s/(^|\D)0+(\d)/$1$2/g,1} sort {$a->[0] cmp $b->[0]} grep {s/(\d+)/sprintf"%06.6d",$1/ge,1} @matrix;

It zero-pads the numbers for the purposes of sorting and then removes the padding once the sort is complete. Sounds like a sensible approach.

[AnomalousMonk]

my @sorted_matrix = grep {s/(^|\D)0+(\d)/$1$2/g,1} sort {$a->[0] cmp $b->[0]} grep {s/
(\d+)/sprintf"%06.6d",$1/ge,1} @matrix;

As it stands, the first  s///ge (with the sprintf) operates on (and destroys) the top-level array reference. It can fairly easily be made to work, but I wouldn't: it makes my skin crawl.

[salva]

useSort::Key::Natural qw(natkeysort);

my @sorted = natkeysort { $_->[0] } @matrix;

[duelafn]

Excellent! I love Sort::Key, but never noticed it has a natural sort included. Took me a moment to figure out what it was doing in its key maker though — it has a packing algorithm which allows it to sort numbers of arbitrary size (unlike most of the techniques in this thread).

[stevieb]

Perhaps I'm missing something, but does the output below using the code changes do what you need?

my @sorted_matrix;

{
    no warnings 'numeric';
    @sorted_matrix = sort {$a->[0] <=> $b->[0]} @matrix;
}

__END__
0 0 -> A1a1
0 1 -> img1
0 2 -> x123
0 3 -> y123

1 0 -> A1a12
1 1 -> img3
1 2 -> x456
1 3 -> y789

2 0 -> A10a1
2 1 -> img4
2 2 -> x456
2 3 -> y123

3 0 -> A12a1
3 1 -> img5
3 2 -> x456
3 3 -> y456

[duelafn]

The test data the OP has doesn't reveal the difficulty well. A better test (I've gotten rid of the extra array parts to focus on the sorting) is:

use 5.010;
my @items = qw/ A1a1 A1a12 A1a2 A10a1 A12a1 /;
say join " ", sort { $a <=> $b } @items;

# prints: A1a1 A1a12 A1a2 A10a1 A12a1
#                ^- :( -^