Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
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


Comment on Re^2: Puzzle: Longest Increasing Sequence
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://549862]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (5)
As of 2015-07-05 13:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (67 votes), past polls