Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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


In reply to Re^2: Puzzle: Longest Increasing Sequence by demerphq
in thread Puzzle: Longest Increasing Sequence by TedPride

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (14)
    As of 2015-07-02 12:56 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 (37 votes), past polls