#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11161855 use warnings; use List::AllUtils qw( min_by nsort_by ); $SIG{__WARN__} = sub { die @_ }; 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= fancy_algorithm(\@list1, \@list2, \@list3); use Data::Dump 'dd'; dd 'combined', $combined; 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 )], ); $combined= fancy_algorithm(@lists); use Data::Dump 'dd'; dd 'combined', $combined; sub fancy_algorithm { my (%names, @order); @names{ @$_ } = () for my @args = @_; use Data::Dump 'dd'; dd 'input', \@args; while( @args ) { my %names; my $see = 1; $names{$_} += $see++ for map @$_, @args; my @names = nsort_by { $names{$_} } sort +keys %names; my %score; for ( @args ) { my ($head, @rest) = @$_; $score{$head} -= 1e9; $score{$_} //= 0 for @rest; } my $pick = min_by { $score{$_} } @names; push @order, $pick; $_ = [ grep $pick ne $_, @$_ ] for @args; @args = grep @$_, @args; } return \@order; }