#!/usr/bin/perl use strict; use Data::Dumper; use Test::More qw/no_plan/; my $unsorted = [ [ qw/1 3 5 6 2/ ], [ qw/3 4 5 6 7/ ], [ qw/1 2 3 4 5/ ], [ qw/5 6 7 9 9/ ], [ qw/5 6 7 9 8/ ], [ qw/1 2 3 4 5/ ], [ qw/2 2 2 2 2/ ], [ qw/1 1 2 4 5/ ], [ qw/2 3 4 5 6/ ], ]; my $expected = [ [ qw/1 1 2 4 5/ ], [ qw/1 2 3 4 5/ ], [ qw/1 2 3 4 5/ ], [ qw/1 3 5 6 2/ ], [ qw/2 2 2 2 2/ ], [ qw/2 3 4 5 6/ ], [ qw/3 4 5 6 7/ ], [ qw/5 6 7 9 8/ ], [ qw/5 6 7 9 9/ ], ]; my $sorted = FunkyMonkSort($unsorted, 0, 1, 3); is_deeply $sorted, $expected, "FunkyMonk Sort"; # Print ($sorted,"After FunkyMonk Sort"); sub FunkyMonkSort { my @array = @{ +shift }; my @sorted = sort { for my $ix (@_ ) { # Updated from " 0 .. @_" - per updates from FonkyMonk my $cmp = $a->[$ix] <=> $b->[$ix]; return $cmp if $cmp; } return 0; } @array; return \@sorted; } #------------------------------- my @jettero = sort {$a->[0]<=>$b->[0] || $a->[1]<=>$b->[1]} @$unsorted; is_deeply \@jettero, $expected, "jettero Sort"; #Print ($sorted,"After jettero Sort"); #--------------------- NetWallah ---- my @b =sort NetWallahSort @$unsorted; is_deeply \@b, $expected, "NetWallah Sort"; sub NetWallahSort{ # Auto import $a, $b, which are array refs for my $i(0..$#$a){ next if $a->[$i] == $b->[$i]; return $a->[$i] <=> $b->[$i]; } return 0; #Pathological (Updated from "return 1" per ikegami's node below) } sub Print{ my $aref=shift or die "No array supplied"; my $title=shift || ''; print "----- $title --\n"; for (@$aref){ print "\t" . join(", ",@$_) . "\n"; } print "-------------------\n\n"; } #### not ok 1 - FunkyMonk Sort # Failed test 'FunkyMonk Sort' # at test-arr.pl line 33. # Structures begin differing at: # $got->[7][4] = '9' # $expected->[7][4] = '8' not ok 2 - jettero Sort # Failed test 'jettero Sort' # at test-arr.pl line 49. # Structures begin differing at: # $got->[7][4] = '9' # $expected->[7][4] = '8' ok 3 - NetWallah Sort 1..3 # Looks like you failed 2 tests of 3.