#!/usr/bin/env perl

use strict;
use warnings;
use namespace::autoclean;

use Benchmark 'cmpthese';
use List::Util 'shuffle';

my @unordered = qw{a-10 a-01 a-22 a-2 a-0 a-3 a-000 a-1 a-12345 a-1};
my %expanded_abbrev_for = (
    sr => 'sort_regex',
    STr => 'st_regex',
    STrn => 'st_regex_no_index',
    STren => 'st_regex_expr_ni',
    sra => 'sort_regex_anchored',
    STra => 'st_regex_anchored',
    STran => 'st_regex_anch_ni',
    STraen => 'st_regex_anch_expr_ni',
    ss => 'sort_substr',
    mcs => 'map_cat_substr',
    mcsl => 'map_cat_substr_len',
    sp => 'sort_pack',
    GRTpe => 'grt_pack_expr',
    GRTpeq => 'grt_pack_expr_q',
);
my %coderef_for = (
    sr => \&sort_regex,
    STr => \&st_regex,
    STrn => \&st_regex_no_index,
    STren => \&st_regex_expr_ni,
    sra => \&sort_regex_anchored,
    STra => \&st_regex_anchored,
    STran => \&st_regex_anch_ni,
    STraen => \&st_regex_anch_expr_ni,
    ss => \&sort_substr,
    mcs => \&map_cat_substr,
    mcsl => \&map_cat_substr_len,
    sp => \&sort_pack,
    GRTpe => \&grt_pack_expr,
    GRTpeq => \&grt_pack_expr_q,
);

print "Perl & OS:\n    $^V on $^O\n";
print "Unordered data (for preamble tests):\n    @unordered\n";
print "Preamble tests:\n";
my $tests_fmt = "    %-22s %s\n";

for my $name (sort keys %coderef_for) {
    printf $tests_fmt, "$expanded_abbrev_for{$name}:",
            "@{[$coderef_for{$name}->()]}";
}

exit if @ARGV && $ARGV[0] eq '--dry_run';

print "Legend:\n";
my $legend_fmt = "    %-7s %s\n";

for my $abbrev (sort keys %expanded_abbrev_for) {
    printf $legend_fmt, "$abbrev:",
            $expanded_abbrev_for{$abbrev};
}

# Extend @unordered for improved benchmarking
push @unordered, map "a-$_", shuffle 0..10000;

print "Benchmarks:\n";
print "    Note: Unordered data extended with 'map \"a-\$_\", shuffle 0..10000'\n";
my $count = 0;
cmpthese $count => \%coderef_for;

sub sort_regex {
    sort {
        ($a =~ /(\d+)/)[0] <=> ($b =~ /(\d+)/)[0]
    } @unordered;
}

sub st_regex {
    map {
        $_->[0]
    }
    sort {
        $a->[1] <=> $b->[1]
    }
    map {
        [$_, (/(\d+)/)[0]]
    } @unordered;
}

sub st_regex_no_index {
    map {
        $_->[0]
    }
    sort {
        $a->[1] <=> $b->[1]
    }
    map {
        [$_, /(\d+)/]
    } @unordered;
}

sub st_regex_expr_ni {
    map $_->[0],
    sort {
        $a->[1] <=> $b->[1]
    }
    map [$_, /(\d+)/], @unordered;
}

sub sort_regex_anchored {
    sort {
        ($a =~ /(\d+)$/)[0] <=> ($b =~ /(\d+)$/)[0]
    } @unordered;
}

sub st_regex_anchored {
    map {
        $_->[0]
    }
    sort {
        $a->[1] <=> $b->[1]
    }
    map {
        [$_, (/(\d+)$/)[0]]
    } @unordered;
}

sub st_regex_anch_ni {
    map {
        $_->[0]
    }
    sort {
        $a->[1] <=> $b->[1]
    }
    map {
        [$_, /(\d+)$/]
    } @unordered;
}

sub st_regex_anch_expr_ni {
    map $_->[0],
    sort {
        $a->[1] <=> $b->[1]
    }
    map [$_, /(\d+)$/], @unordered;
}

sub sort_substr {
    sort {
        substr($a, 2) <=> substr($b, 2)
    } @unordered;
}

sub map_cat_substr {
    map {
        'a-' . $_
    }
    sort {
        $a <=> $b
    }
    map {
        substr $_, 2
    } @unordered;
}

sub map_cat_substr_len {
    map {
        'a-' . $_
    }
    sort {
        $a <=> $b
    }
    map {
        substr $_, 2, length($_) - 2
    } @unordered;
}

sub sort_pack {
    sort {
        pack(L => substr($a, 2)) cmp pack(L => substr($b, 2))
    } @unordered;
}

sub grt_pack_expr {
    map substr($_, 4),
    sort
    map pack(L => substr($_, 2)) . $_, @unordered;
}

sub grt_pack_expr_q {
    map substr($_, 8),
    sort
    map pack(Q => substr($_, 2)) . $_, @unordered;
}