Perl: the Markov chain saw PerlMonks

### Re^2: Puzzle: Longest Increasing Sequence

by demerphq (Chancellor)
 on May 16, 2006 at 19:11 UTC ( #549862=note: print w/replies, xml ) Need Help??

in reply to Re: Puzzle: Longest Increasing Sequence
in thread Puzzle: Longest Increasing Sequence

It finds a Longuest Ascending Sequence in O(N log N). The sequence it happens to find is the first sequence when sorted numerically.

I implemented a variant of this that will find all longest increasing sequences in the list.

```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";
}

It returns an iterator over all of the LAS'es in the list. The code contains an explanation of how it works.

---
\$world=~s/war/peace/g

Create A New User
Node Status?
node history
Node Type: note [id://549862]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (7)
As of 2017-12-17 13:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
What programming language do you hate the most?

Results (464 votes). Check out past polls.

Notices?