1. How do I permute N elements of a list?
2. Permuting with duplicates and no memory

Jeff 'this feels like deja vu' A

UPDATE:
Note to self: all possibilities equals combinations, not permutations.
Now quit ++'ing this node and ++ larryk's and tye's! :)

Just for a reference, don't forget about this gem as well: Permutations and combinations.

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:

Read more... (789 Bytes)

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]

"Argument is futile - you will be ignorralated!"

Jeff and larryk,
Thanks for your suggestions.
Jeff, I had already checked out your suggestions but they didn't cut the mustard. I probably wasn't specific enough in my original question but I need all the possibilities not the permutations (I'm not sure if that is the correct usage of possibilities/permutations . . .). Specifically I also need to generate sequences containing all the same base e.g. AAA, TTT etc.

The Ordered Combinations solution as suggested by larryk does what I need, an awesome little piece of code. Thanks to MeowChow, sachmet and tilly.

Here is the final piece of code for the record:

use strict;
#generate all posibilites of a DNA sequence
my @Bases = qw(A C G T);
my $SequenceMinLenght = 1;
my $SequenceMaxLength = 3;
my @SequenceLenghts = ($SequenceMinLenght...$SequenceMaxLength);
#print "@SequenceLenghts\n";
my $SequenceListLength = $#SequenceLenghts;
$SequenceListLength ++;
print "Number of Sequence lenghts to permute is $SequenceListLength\n"
+;
my @allSequence = ();
my $sequence;
my $currLenght;
my @Ordered_Combinations_input = ();
foreach $currLenght (@SequenceLenghts){
    @Ordered_Combinations_input = ();
    @Ordered_Combinations_input = ($currLenght, @Bases);
    @allSequence = (@allSequence, (&Ordered_Combinations (@Ordered_Com
+binations_input)));    
}
#Prints sequences to screen
# - Too many entries after lenght of sequence is grater than 4.  
my $i=0;
foreach my $finalsequence (@allSequence){
    $i ++;
    if ($i == 4){
        print "$finalsequence\n";
        $i= 0;
    }
    else{
        print "$finalsequence\t";
    }
}
#Completely blow the GOLF chalange by using a sub name almost as long 
+as the sub
#See http://www.perlmonks.com/index.pl?node_id=75261 for details 
sub Ordered_Combinations {my$n=shift;--$n?map{my$d=$_;map$d.$_,Ordered
+_Combinations($n,@_)}@_:@_};
[download]

Unless you need some of those variables later, we could eliminate some clutter.

use strict;
use warnings;

#generate all posibilites of a DNA sequence
my @Bases = qw(A C G T);
my $SequenceMinLength = 1;
my $SequenceMaxLength = 3;
print 'Number of Sequence lengths to permute is ',
      $SequenceMaxLength - $SequenceMinLength + 1, "\n";

my @allSequence;
foreach my $currLength ($SequenceMinLength .. $SequenceMaxLength){
    push @allSequence, Ordered_Combinations($currLength, @Bases);
}

#Prints sequences to screen
# - Too many entries after length of sequence is greater than 4.
my $i;
foreach my $finalsequence (@allSequence){
    ++$i % @Bases ? print "$finalsequence\t" : print "$finalsequence\n
+";
}
[download]

By using @Bases instead of 4, we get @Base columns, aiding readability.

sub Ordered_Combinations {
    my $n = shift;
    --$n ? map {
             my $d = $_;
             map "$d$_", Ordered_Combinations($n,@_)
               } @_
         : @_
}
[download]

HTH,
Charles K. Clarkson

              (__)
              (\/)
       /-------\/
      / | 666 ||
     *  ||----||
[download]