use List::Util qw(shuffle);
# $iter=LAS_iter($deck,$as_index,$verbose);
#
# Take a list of numbers (duplicates allowed) and returns an
# iterator over all of Longest Ascending Sequences it contains.
# @$deck is the list of numbers, $as_index controls whether
# the iterator returns indexes into the deck, or copies of the
# relevent values. If $verbose is true then outputs some trace
# information as it runs.
#
# The behaviour is undefined if you change the contents of @$deck
# before the iterator is exhausted.
#
# The iter returns a list of the next LAS, or an empty list to
# indicate all the LAS have been returned.
#
sub LAS_iter {
my ( $deck, $as_idx )= @_;
#
# Patience sort a list held in @$deck in worst case N log N time.
#
my (
@top, # len-1: val
@topidx, # len-1: id
@leng, # id : len
@pred, # idx : idy
@equal # idx : idy
);
#
# @top and @topidx represent the topmost card in patience sorting.
#
# Patience sorting is the process where for each card you find the
# leftmost pile whose top card is higher than one chosen. If no
# such pile exists form a new pile to the right.
# This algorithm simulates such a process with the
# slight exception that a card can be played on top
# if it equals the one already there.
#
# Only one of @top and @topidx are necessary, we maintain both
# so that we can know the indexes into the deck and avoid lots of
# lookups into the deck while we are searching.
#
# From the information in the @topidx array we can build three
# other arrays @leng, @pred and @equal, which eventually will
# contain an entry for every value in the @$deck.
#
# $leng[$idx] is the length of the longest asc seq ending in
# $deck->[$idx]. This means $leng[$idx] is the pile number
# (1 indexed).
#
# $pred[$x] is the greatest index $y smaller than $x such that
# $leng[$y]==$leng[$x]-1. If no such index exists then it is
# undef. This means $pred[$x] is the top card to the left of
# where we play our current card and that all cards in the first
# pile have no @pred entry.
#
# $equal[$x] is the greatest index $y smaller than $x such that
# $leng[$y]==$leng[$x]. If no such index exists then it is undef.
# This means $equal[$idx] is the card we cover when we play,
# when starting a new pile the card has no @equal entry.
#
# With this information we can efficiently build not only the
# minimum longest ascending sequence, we can build every
# ascending sequence in the @$deck (should we choose to do so)
#
# Also interestingly enough @leng alone would suffice for this
# purpose as we can easily recreate @pred and @equal (as well as
# @top and @topidx) from it, and in O(N) time.
#
# presize the arrays.
foreach ( \@leng, \@pred, \@equal ) {
$#$_= $#$deck; # alloc
$#$_= -1; # hide
}
# initialize with the first card
$leng[0]= 1;
$topidx[0]= 0;
$top[0]= $deck->[0];
# loop over the rest of the deck
foreach my $idx ( 1 .. $#$deck ) {
my $card= $deck->[$idx];
# binsearch for where in the piles our card should go
my ( $low, $mid, $high )= ( 0, 0, $#top );
my $midtop;
while ( $low <= $high ) {
$mid= int( ( $low + $high ) / 2 );
$midtop=$top[$mid];
if ( $midtop < $card ) {
$low= $mid + 1;
} elsif ( $card < $midtop ) {
$high= $mid - 1;
} else {
last;
}
}
# $mid will be where our card should go (in the case of dupes)
# or the card preceding where we should go (ie, it would==high
# if the $card was higher than everything else).
$mid++ if $card > $midtop;
$leng[$idx]= $mid + 1; # @leng is one based
$equal[$idx]= $topidx[$mid]; # the old top is our equal.
$pred[$idx]= $topidx[ $mid - 1 ] # the top to our left is our
if $mid; # predecessor, if it exists.
$topidx[$mid]= $idx; # And now we put our card on the
$top[$mid]= $deck->[$idx]; # top of the appropriate pile.
}
#
# Return a closure as an iterator that does a depth first walk
# through all of the LAS'es in @$deck. We return the MLAS first.
#
# The process is to fill the @out array from the right, starting
# at the end of the rightmost longest ascending sequence in the
# deck (which will be the MLAS). When we run out of predecessors
# the @out array contains a completed LAS and can return it.
#
# We maintain our own stack. As we go left using @pred we push
# possible alternate continuations as specified by @equal into
# the stack.
#
# We can rely on the fact that if $equal[$x]==$y then $y < $x and
# also $deck->[$y] >= $deck->[$x], and therefore we can prune the
# traverse of the equal list by not pushing when using the equal
# would not result in an ascending sequence.
#
my $bestlen= @topidx-1;
my @stack= ( $topidx[-1] );
my @out; # vals
my @outidx; # idxs
return sub {
STACK:
while ( @stack ) {
my $cur= pop @stack;
while ( defined $cur ) {
my $card= $deck->[$cur];
# $len is 1 based but out is 0 based,
# meaning $outv takes the val to right
# of the current one.
my $len= $leng[$cur];
# the -- below is to convert $len to a 0 based number
# its postdec because we want the next value from
# the one that $len points at.
my $nextcard= $out[$len--];
if ( $len == $bestlen || $card < $nextcard ) {
$out[ $len ]= $card;
$outidx[ $len ]= $cur;
} else {
next STACK;
}
my $eql= $equal[$cur];
push @stack, $eql
if defined $eql
&& ( $len == $bestlen
|| $deck->[$eql] < $nextcard );
$cur= $pred[$cur];
}
return $as_idx ? @outidx : @out;
}
return () # empty list, no return
};
}
my @list=shuffle shuffle(1..52);
my $iter= LAS_iter( \@list,'as_idx' );
while ( my @lis= $iter->() ) {
print "@list[@lis]\n";
}