use warnings;
use strict;

use List::Util qw(max);
use Data::Dump;

use Test::More
  # tests => ?? + 1  # Test::NoWarnings adds 1 test
    'no_plan'
    ;
use Test::NoWarnings;


# test data
my %entry = (
  'BLA' => {
    'Score'    => [     5,     10,  ],
    'Location' => [ '1-10', '2-10', ],
    },
  'TRA' => {
    'Score'    => [    15,     23,        2,  ],
    'Location' => [ '7-15', '4-19', '78-120', ],
    },
  'AHA' => {
    'Score'    => [    14,      9,        1,       11,  ],
    'Location' => [ '8-88', '4-44', '78-780', '78-111', ],
    },
  );
dd \%entry;

# {  # begin closure for code from post
#
# my %p_entry;
#
# push @{$p_entry{'BLA'}{Score}}, 5;
# push @{$p_entry{'BLA'}{Location}}, '1-10';
#
# push @{$p_entry{'TRA'}{Score}}, 15;
# push @{$p_entry{'TRA'}{Location}}, '7-15';
#
# push @{$p_entry{'TRA'}{Score}}, 23;
# push @{$p_entry{'TRA'}{Location}}, '4-19';
#
# push @{$p_entry{'TRA'}{Score}}, 2;
# push @{$p_entry{'TRA'}{Location}}, '78-120';
#
# push @{$p_entry{'BLA'}{Score}}, 10;
# push @{$p_entry{'BLA'}{Location}}, '2-10';
#
# # comment out AHA key above to compare
# is_deeply \%p_entry, \%entry, qq{pushed struct is same};
#
# }  # end closure for code from post


{  # begin closure for gold standard

my @ordered_keys_score_indices =
  map [ sort { $entry{$_}{Score}[$b] <=> $entry{$_}{Score}[$a] } 0 .. 
+$#{ $entry{$_}{Score} } ],
  my @ordered_keys =
  sort { max(@{ $entry{$b}{Score} }) <=> max(@{ $entry{$a}{Score} }) }
  keys %entry
  ;
# dd \@ordered_keys_score_indices;
# dd \@ordered_keys;
# basic sanity check.
@ordered_keys == @ordered_keys_score_indices or die qq{bad sort};

my @gold;  # gold standard for comparing other (faster?) sorts

for my $i (0 .. $#ordered_keys) {
  my ($k, $ar_oksi) = ($ordered_keys[$i], $ordered_keys_score_indices[
+$i]);
  push @gold, map [ $k, $_ ], @$ar_oksi;
  }

sub gold_standard {
    @gold or die qq{gold standard not yet initialized};
    return @gold;
    }

}  # end gold standard closure

print qq{'golden' sort \n};
for my $ar_au (gold_standard()) {
    my ($k, $i) = @$ar_au;
    print qq{$k $entry{$k}{Score}[$i] $entry{$k}{Location}[$i] \n};
    }


# try a decorated sort

use constant W => 20;  # must be >= number of digits of widest score

my @silver =
  map  undecorate($_),
  sort
  map  decorate($_, @{ $entry{$_}{Score} }),
  keys %entry
  ;

is_deeply \@silver, [ gold_standard() ],
    qq{decorated sort same as golden sort}
    ;

print qq{silver (decorated) sort \n};
for my $ar_ag (@silver) {
    my ($k, $i) = @$ar_ag;
    print qq{$k $entry{$k}{Score}[$i] $entry{$k}{Location}[$i] \n};
    }

sub decorate {

    my ($k,       # key to decorated
        @scores,  # scores of this key
        ) = @_;

    # all sorts descending, so all stringizations are bit-inverted.

    my $max_score = ~ sprintf '%*d', W, max @scores;

    # returns decorated string for every score of a key.
    return
        map {
            my $score = ~ sprintf '%*d', W, $scores[$_];
            pack qq{a${\W} a${\W} N a*}, $max_score, $score, $_, $k;
            }
        0 .. $#scores
        ;

    }

sub undecorate {

    my ($d,  # decorated sort string
        ) = @_;

    my ($i, $k) = unpack qq{x${\W} x${\W}  N a*}, $d;

    return [ $k, $i ];

    }
[download]