[Bioperl-l] K-mer generating script

Heikki Lehvaslaiho heikki.lehvaslaiho at gmail.com
Sun Dec 21 07:33:49 UTC 2008


Thank you for everyone for these entertaining entries.

In my books, Michel Eisen's version wins with sheer clarity. Recursion
is always recommendable, too.

Below are cleaned versions of these two.

Feel free to improve them further.

   -Heikki

--------------------------------------------------------------------
#!/usr/bin/env perl

use warnings;
use strict;

sub kmers ($;$) {
    my $k = shift;
    my $alphabet = shift || [ qw( A T G C ) ];

    my @bases = @$alphabet;
    my @words = @bases;

    for ( 1 .. --$k ) {
	my @newwords;
	foreach my $w (@words) {
	    foreach my $b (@bases) {
		push (@newwords, $w.$b);
	    }
	}
	@words = @newwords;
    }
    return @words;
}


my $k = shift;
die "positive integer needed as the argument!"
    unless $k > 0 and $k =~ /^\d$/;
map {print "$_\n"} kmers($k);
--------------------------------------------------------------------

--------------------------------------------------------------------
#!/usr/bin/env perl

use warnings;
use strict;

sub kmers ($;$) {
    my $n = shift;
    my $sym = shift || [ qw( A T G C ) ];

    sub kmers_guts {
	my ($n, $sym, $store, $str)  = @_;
	if ($n) {
	    foreach my $s (@$sym) {
		push @$store, kmers_guts($n-1, $sym, $store, $str.$s);
	    }
	} else {
	    return $str;
	}
    }

    my $a = [];
    kmers_guts($n, $sym, $a, '');
    return map {$_ || ()} @$a;
}

my $k = shift;
die "positive integer needed as the argument!"
    unless $k =~ /^\d$/;
map {print "$_\n"} kmers($k);

--------------------------------------------------------------------



More information about the Bioperl-l mailing list