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";
}
[download]