in reply to (jeffa) Re: Generate all possibilities
in thread Generate all possibilities

None of those do what was asked for. larryk's fine suggestion of (Golf) Ordered Combinations does what was asked for but requires that all 1,048,576 ten-character strings be stored in memory for you to get the answer. With Perl arrays, this takes several hundred MB (in my quick test) and so could be a real problem. If you just write the combinations to a file, then you end up with about a 10MB file, which isn't a big deal.

So here is a quick hack to do that: 

sub count {
    my( $length, $alphabet )= @_;
    my @alphabet= split //, $alphabet;
    my @digit= (0) x $length;
    my $seq= $alphabet[0] x $length;
    while(  1  ) {
        print $seq,$/;
        my $pos= 0;
        while(  @alphabet <= ++$digit[$pos]  ) {
            substr( $seq, $pos, 1 )= $alphabet[ $digit[$pos]= 0 ];
            return if $length <= ++$pos;
        }
        substr( $seq, $pos, 1 )= $alphabet[ $digit[$pos] ];
    }
}

count( @ARGV );
# count( $_, "ACGT" )   for  8..10;

[download]

        - tye (but my friends call me "Tye")

Update: And here is a context-free iterator solution:

sub count {
    my( $alphabet, $seq )= @_;
    my $base= length($alphabet);
    my $pos= 0;
    my $val;
    while(  $base <= ( $val= 1 + index( $alphabet, substr($seq,$pos,1)
+ ) )  ) {
        substr( $seq, $pos, 1 )= substr( $alphabet, 0, 1 );
        return   if  length($seq) <= ++$pos;
    }
    substr( $seq, $pos, 1 )= substr( $alphabet, $val, 1 );
    return $seq;
}

my( $len, $alphabet )= @ARGV;
my $seq= substr($alphabet,0,1) x $len;
do {
    print $seq, $/;
} while(  $seq= count( $alphabet, $seq )  );

[download]

Replies are listed 'Best First'.
Re: (tye)Re: Generate all possibilities
by lostcause (Monk) on Jun 26, 2001 at 02:12 UTC

    Tye,

    Thanks for the alternative piece of code, I ran into the very problem you described and was quite amazed to discover that a 10MB hash took up so much RAM.
    The new solution, of course, brings up a new problem This is a little bit unusual. My program generates all the combinations of the bases via the subroutine and saves them to disk. It later calls the file and reads through it one line at a time with a while loop. With larger sets of combination's, 5 or more bases long, this works fine but with a smaller sets, 3 or 4 bases I encounter a strange error. After running the sub routine the program reopens the file but the file is empty so the program continues not doing my stuff with each sequence then quits. Opening the resulting output of the combination sub routine shows that all the combinations are indeed there. The file size is just 320 bytes.
    I have followed this in a debugger and its reproducible. My guess is that the contents of the file are not been flushed to disk until the program ends. This happens on both Linux and Win2k. I am also having problems deleting the file after use. I've never run into this problem before. Ideas anyone?

    Here is a script that illustrates the problem.
    Try varying the commentating on the two unlink lines to see different effects and the changing the length of the sequence that is generated

    #!/usr/local/bin/perl -w 
$| = 1;
#generate promoters
my $Bases = "ACGT";
#my @PromoterLenghts = ($PromoterMinLenght...$PromoterMaxLength);
my @PromoterLenghts = (4);
my $PromotroListLength = $#PromoterLenghts;
$PromotroListLength ++;
#unlink 'permute.txt';
my ($currLenght, $permutelist_filename);
foreach $currLenght (@PromoterLenghts){
    $permutelist_filename = &permute_bases ($currLenght, $Bases);    
}
#print "Sequences file $permutelist_filename\n";

open (PIN, "permute.txt")||die "Can't open  file: $!\n";
open (OUTPUT, ">output.txt")||die "Can't open  file: $!\n";
while (<PIN>){
    $promoter = $_;
    chomp $promoter;
    #do intrestering stuff with promoter sequence
    print OUTPUT "$promoter\n";
}
close PIN ||die "Could not close sequences file: $!";
close OUTPUT ||die "Could not close output file: $!";
unlink 'permute.txt';    

#####################################################################
sub permute_bases {
    my( $length, $bases )= @_;
    my @bases= split //, $bases;
    my @digit= (0) x $length;
    my $seq= $bases[0] x $length;
    my $permutelist_filename = "permute.txt";
    open  (PERMUTEOUT, ">>$permutelist_filename");   
    while(  1  ) {
        print PERMUTEOUT $seq,$/;
        print $seq,$/;
        my $pos= 0;
        while(  @bases <= ++$digit[$pos]  ) {
            substr( $seq, $pos, 1 )= $bases[ $digit[$pos]= 0 ];
        return if $length <= ++$pos;
        }
        substr( $seq, $pos, 1 )= $bases[ $digit[$pos] ];
    }
    close PERMUTEOUT||die"Could not close $permutelist_filename: $!";
    return ($permutelist_filename);
}

    [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom