There are two answers to your input.

#!/usr/bin/perl -l

# http://perlmonks.org/?node_id=1174320

use strict;
use warnings;

my @answers;
my @queue = [[], [qw(2 6 5 7 4 3 9)]];

while( my $state = shift @queue )
  {
  my @have = $state->[0]->@*;
  my @more = $state->[1]->@*;
  if( @more )
    {
    @have == 0 || $have[-1] < $more[0] and
      push @queue, [[@have, $more[0]], [@more[1..$#more]]];
    push @queue, [[@have], [@more[1..$#more]]];
    }
  elsif( @have >= $#answers )
    {
    push @{$answers[@have]}, "@have";
    }
  }
print for $answers[-1]->@*;
[download]

output is:

2 6 7 9
2 5 7 9
[download]

This is great, but I want it to stop as soon as it gets one answer. I'm trying to do this for a super long set of numbers but the calculation time is *forever* so I'm trying to shorten it in every way possible.

Please give us the real problem, then, and not a "fake" small example.

I'm suspicious that this problem is of the order O(2**N). If so, it's going to be "really" slow on "super long" sets.

gilthoniel, you should be able to figure out how to use tybalt89's code as a starting point, but stopping as soon as you have a match. If you test the length of @answers at the end of the while loop, you can stop right away.

Or you could add a similar check to GrandFather's answer — though, not having run his, I'm not positive his will run in longest-first order.

Or, if the one to four lines of code (depending on how Perl-ly you think) that would be required to exit out of the loop when there's at least one element in @answers — if that's too difficult, you could look at my answer, which already tells you the one character you need to edit in order to get it to stop at the first match rather than listing them all. Given that my answer starts with the longest possible combination, and works its way down (inspired by your own structure, btw, to try to make it as easy for you to understand as possible), the first match will be the longest (or the first of the group that are all the same longest length, if there are multiple answers of the same length). If that won't work for you, please describe what feature of the answer does not meet your requirements.

You may find the following code helpful:

use strict;
use warnings;

my @list = qw(20 60 65 50 55 70 10 30 40 90 51 52);
my @runs;

for my $item (@list) {
    my @newRuns = [$item];
    
    for my $run (@runs) {
        next if $item <= $run->[-1];
        
        push @newRuns, [@$run];
        push @$run, $item;
    }
    
    push @runs, @newRuns;
}

@runs = sort {@$a <=> @$b} @runs;
@runs = grep {@{$runs[-1]} == @$_} @runs;

print "@$_\n" for @runs;
[download]

Prints:

20 60 65 70 90
20 50 55 70 90
20 30 40 51 52
10 30 40 51 52
[download]

TIMTOWTDI

use Algorithm::Combinatorics qw/combinations/;
use strict;
use warnings;

use constant DEBUG => 0;
use constant ALL => 1;

local $\ = "\n"; # UPDATE#1 = I was using perl -l to run; if you don't
+, you'll want this...


my @array = qw(2 6 5 7 4 3 9);
my $Fcount = @array;
my @answer = ();
while( $Fcount ) {
    my $iter = combinations( \@array, $Fcount );
    while( my $p = $iter->next() ) {
        my $monotonic = 1;
        my @a = @$p;
        foreach my $i ( 0.. $#a-1 ) {
            my $j = $i + 1;
            $monotonic &&= $a[$j] > $a[$i];
            last unless $monotonic;
        }
        push @answer, [@a] if $monotonic;
        $monotonic ||= 0; # not necessary, except it cleans up my debu
+g print
        print "$Fcount: (@a): $monotonic || (@answer)"  if DEBUG;
        last if $monotonic && !ALL; # this could also be 'last if @ans
+wer && !ALL;'
    }
    --$Fcount;
    last if @answer && !ALL;
}
foreach my $p (@answer) {
    local $, = "\t";
    local $" = ",";
    print scalar(@$p), "(@$p)";
}

__END__
4       (2,6,7,9)
4       (2,5,7,9)
3       (2,6,7)
3       (2,6,9)
3       (2,5,7)
3       (2,5,9)
3       (2,7,9)
3       (2,4,9)
3       (2,3,9)
3       (6,7,9)
3       (5,7,9)
2       (2,6)
2       (2,5)
2       (2,7)
2       (2,4)
2       (2,3)
2       (2,9)
2       (6,7)
2       (6,9)
2       (5,7)
2       (5,9)
2       (7,9)
2       (4,9)
2       (3,9)
1       (2)
1       (6)
1       (5)
1       (7)
1       (4)
1       (3)
1       (9)
[download]

change to ALL => 0 to get just the first combination that's increasing.

update: added $\ = "\n";

update 2 (2016-Oct-24): please don't use this code in production; it is highly inefficient. see Re^7: Longest Increasing Subset

I'm not sure of the rule you are using but this gives the answer you say you want.

johngg@shiraz:~ > perl -Mstrict -Mwarnings -E '
my @arr = ( 2, 6, 5, 7, 4, 3, 9 );
my @sub = shift @arr;
push @sub,
   $arr[ 0 ] > $sub[ -1 ]
   ? shift @arr
   : do { shift @arr; () }
   while @arr;
say for @sub;'
2
6
7
9
[download]

Just a guess really, perhaps you could explain the rule you are using more clearly. For instance, do you always start with the first item in the list or the smallest? Both the same in this case so I'm not sure.

You don't need to enumerate all possible combinations to solve this.

What you're looking for is longest common subsequence algorithm, aka diff. You need to compare your data with its own sorted copy.

Now any ordered subsequence of initial input is also a subsequence of the sorted input (well, this requires proof, but I'm too sleepy to come up with one). Therefore, it is guaranteed that the longest such subset will be selected by LCS.

Not sure which of these modules would fit your need, probably LCS::Tiny or LCS::XS.

Here's a working code sample:

#!/usr/bin/env perl

use strict;
use warnings;
use LCS::XS;

my @data = map { /(\d+)/g } <>;
my @odata = sort { $a <=> $b } @data;

my $alg = LCS::XS->new;
my @diff = $alg->LCS( \@data, \@odata ); # returns pairs or indices

# select elements with matching indices from data
my @subseq = map { $data[ $_->[0] ] } @diff;
print "@subseq\n";

# select same elements but from ordered data - result is identical
@subseq    = map { $odata[ $_->[1] ] } @diff;
print "@subseq\n";
[download]

UPDATE As BrowserUK points out, there's an even more efficient Longest increasing subsequence algorithm which is O(n ln n), while my proposed solution is only O(n*n).

but for some reason it's not stopping where I expect it to and giving the answer (2 6 7 4 3)

Ignore this: I misread the text. Can you explain how (2 6 7 4 3) is an "increasing subset"? (Let alone the longest.)