use v5.12;
use warnings;
use Data::Dump;

use Test::More;

my @list1= qw( K B I S Y A Q );
my @list2= qw( B S N A );
my @list3= qw( Y N Q );

my $combined = combined_order(\@list1, \@list2, \@list3);
is_deeply( $combined, [qw( K B I S Y N A Q )] );


my @lists= (
  [qw( X P Y )],
  [qw( X B Y N )],
  [qw( P B N )],
  [qw( X B P N )],
  [qw( X B P Y )],
  [qw( A Z )],
  [qw( A K L )],
);

my $combined2 = combined_order(@lists);
is_deeply( $combined2, [qw( X B P Y N A Z K L )] ) or diag dd $combined2;

sub combined_order {
    my @orders = @_;
    my @total = map {@$_} @orders;

    my %uniq;
    @uniq{@total} =();
    @total = keys %uniq;

    my $osort = gen_sort_by_orders (@orders);

    # ddx @total;
    return [ sort {&$osort} @total ]; 
}

sub signum {
    my ($val) = @_;
    return 0 unless $val;            # 0 or undef
    return $val / abs($val);
}

sub gen_sort_by_orders {
    my @orders = @_;

    my %cmp;
    for my $order (@orders) {
        while (my $less = shift @$order) {
            for my $greater (@$order) {
                $less lt $greater
                  ? $cmp{$less}{$greater}--
                  : $cmp{$greater}{$less}++;
            }
        }
    }
    ddx \%cmp;

    my $osort = sub {
        return ($a lt $b ? $cmp{$a}{$b} : - ($cmp{$b}{$a} // 0))
          #|| cmp_more_frequently($a,$b) # please define what you mean
          || $a cmp $b;                  # default ordering against ambiguity
    };
    
    return $osort;
}

done_testing;

##</code><code>##

perl /home/lanx/perl/multisort.pl
# multisort.pl:61: {
#   A => { B => 2, I => 1, K => 1, N => 1, Q => -1, S => 2, Y => 1 },
#   B => { I => -1, K => 1, N => -1, Q => -1, S => -2, Y => -1 },
#   I => { K => 1, Q => -1, S => -1, Y => -1 },
#   K => { Q => -1, S => -1, Y => -1 },
#   N => { Q => -1, S => 1, Y => 1 },
#   Q => { S => 1, Y => 2 },
#   S => { Y => -1 },
# }
ok 1
# multisort.pl:61: {
#   A => { K => -1, L => -1, Z => -1 },
#   B => { N => -3, P => -1, X => 3, Y => -2 },
#   K => { L => -1 },
#   N => { P => 2, X => 2, Y => 1 },
#   P => { X => 3, Y => -2 },
#   X => { Y => -3 },
# }
not ok 2
#   Failed test at /home/lanx/perl/multisort.pl line 26.
#     Structures begin differing at:
#          $got->[0] = 'A'
#     $expected->[0] = 'X'
["A", "B", "K", "L", "X", "P", "Y", "N", "Z"]
# 1
1..2
# Looks like you failed 1 test of 2.