#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11161855
use warnings;
use List::AllUtils qw( max_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;

@lists= (
[qw( S T )],
[qw( S U )],
[qw( Y Z )],
[qw( X Y )],
[qw( W X )],
[qw( V W )],
[qw( U V )],
);
$combined= fancy_algorithm(@lists);
use Data::Dump 'dd'; dd 'combined', $combined;

sub fancy_algorithm
  {
  my $rule = join "\n", map "@$_", @_;
  my @order;
  print "$rule\n"; # FIXME only for testing
  while( $rule =~ /\S/ )
    {
    my ($head) = max_by { my $n = () = $rule =~ /\b$_\b/g }
      grep { $rule !~ /\w +$_\b/ } my @front = sort $rule =~ /^ *(\w+)\b/gm;
    $head //= shift @front; # for breaking cycles
    push @order, $head;
    $rule =~ s/\b$head\b//g;
    }
  return \@order;
  }

##</code><code>##

K B I S Y A Q
B S N A
Y N Q
("combined", ["K", "B", "I", "S", "Y", "N", "A", "Q"])
X P Y
X B Y N
P B N
X B P N
X B P Y
A Z
A K L
("combined", ["X", "A", "K", "L", "Z", "B", "P", "Y", "N"])
S T
S U
Y Z
X Y
W X
V W
U V
("combined", ["S", "U" .. "Y", "T", "Z"])