#!/usr/bin/perl
use warnings;
use strict;
####
package Sequences;
sub new {
my ($proto, $seq) = @_;
bless $seq, $proto;
}
sub seqsub(&) {
Sequences->new(@_);
}
##
##
sub seq {
my ($i, $elems) = (0, \@_);
seqsub {
$i < @$elems
? ( $elems->[ $i++ ] )
: do { $i = 0; () };
}
}
##
##
my $abcees = seq("a", "b", "c");
$abcees->(); # ("a")
$abcees->(); # ("b")
$abcees->(); # ("c")
$abcees->(); # ( )
# ... the cycle repeats ...
##
##
use Data::Dumper;
sub enumerate {
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
my ($i, $seq) = (0, $_[0]);
while (my @val = $seq->()) {
@val = map { ref ($_) ? Dumper($_) : $_ } @val;
printf "%2d => %s\n", $i++, "@val";
}
$seq;
}
##
##
enumerate( $abcees );
# 0 => a
# 1 => b
# 2 => c
##
##
$abcees->enumerate;
# 0 => a
# 1 => b
# 2 => c
##
##
sub seq_prod2 {
my ($s, $t) = @_;
my @sval;
seqsub {
my @tval;
while ( !@sval || !(@tval = $t->()) ) {
return () unless @sval = $s->();
}
( @sval, @tval );
}
};
##
##
my $one_two_threes = seq( 1 .. 3 );
enumerate( seq_prod2( $abcees, $one_two_threes ) );
# 0 => a 1
# 1 => a 2
# 2 => a 3
# 3 => b 1
# 4 => b 2
# 5 => b 3
# 6 => c 1
# 7 => c 2
# 8 => c 3
##
##
use List::Util qw( reduce );
sub seq_prod {
reduce { seq_prod2($a,$b) } @_ ;
}
##
##
my $you_and_mees = seq( "you", "me" );
seq_prod( $abcees, $one_two_threes, $you_and_mees )
->enumerate;
# 0 => a 1 you
# 1 => a 1 me
# 2 => a 2 you
# 3 => a 2 me
# 4 => a 3 you
# 5 => a 3 me
# 6 => b 1 you
# 7 => b 1 me
# 8 => b 2 you
# 9 => b 2 me
# 10 => b 3 you
# 11 => b 3 me
# 12 => c 1 you
# 13 => c 1 me
# 14 => c 2 you
# 15 => c 2 me
# 16 => c 3 you
# 17 => c 3 me
##
##
my (@alist, @blist, @clist);
# ... initialize arrays with values ...
foreach my $a (@alist) {
foreach my $b (@blist) {
foreach my $c (@clist) {
# do something with ($a, $b, $c) ...
}
}
}
##
##
my $combined_sequence =
seq_prod( seq(@alist), seq(@blist), seq(@clist) );
while ( my ($a, $b, $c) = $combined_sequence->() ) {
# do something with ($a, $b, $c)
}
##
##
sub seqs {
map seq(@$_), @_;
}
sub seq_from_spec {
seq_prod( seqs(@_) );
}
##
##
sub nary_digits {
my ($base, $digits) = @_;
seq_from_spec( ([0..$base-1]) x $digits );
}
enumerate( nary_digits(2, 3) ); # 3-digit binary numbers
# 0 => 0 0 0
# 1 => 0 0 1
# 2 => 0 1 0
# 3 => 0 1 1
# 4 => 1 0 0
# 5 => 1 0 1
# 6 => 1 1 0
# 7 => 1 1 1
##
##
# seq_from_spec([1..3]) === seq(1..3)
# seq_from_spec([1..3],[4,5]) === seq(1..3) x seq(4,5)
# seq_from_spec(\(@a,@b,...)) === seq(@a) x seq(@b) x ...
##
##
sub seq_foreach {
my ($seq, $fn) = @_;
while (my @val = $seq->()) {
$fn->(@val);
}
$seq;
}
##
##
$abcees->seq_foreach( sub { print "@_\n"; } );
# a
# b
# c
##
##
sub seq_foreach_from_spec {
my ($spec, $fn) = @_;
seq_foreach( seq_from_spec( @$spec ), $fn );
}
##
##
seq_foreach_from_spec( [\(@alist, @blist, @clist)], sub {
my ($a, $b, $c) = @_;
# do something with $a, $b, $c, ...
});
##
##
sub seq_filter {
my ($seq, $filter_fn) = @_;
seqsub {
my @val;
1 while @val = $seq->() and !$filter_fn->(@val);
return @val;
}
}
##
##
sub odds_up_to {
my $maximum = shift;
seq( 1 .. $maximum )
->seq_filter( sub { $_[0] % 2 } )
}
enumerate( odds_up_to(10) );
# 0 => 1
# 1 => 3
# 2 => 5
# 3 => 7
# 4 => 9
##
##
sub seq_map {
my ($seq, $fn) = @_;
seqsub {
my @val = $seq->();
@val ? $fn->(@val) : ();
}
}
##
##
sub evens_up_to {
odds_up_to( $_[0] + 1 )
->seq_map( sub { $_[0] - 1 } );
}
enumerate( evens_up_to(10) );
# 0 => 0
# 1 => 2
# 2 => 4
# 3 => 6
# 4 => 8
# 5 => 10
##
##
sub min_length_combinations {
my ($min_length, @inputs) = @_;
my @input_spec = map [ [], (map [$_], @$_) ], @inputs;
seq_from_spec( @input_spec )
->seq_map( sub { [ map @$_, @_ ] } )
->seq_filter( sub { @{$_[0]} >= $min_length } )
}
##
##
min_length_combinations(
4, map [split//], qw( abc de fgh i jk l m )
)->enumerate;
# 0 => ['i','j','l','m']
# 1 => ['i','k','l','m']
# 2 => ['f','j','l','m']
# 3 => ['f','k','l','m']
#
# ...
#
# 862 => ['c','e','h','i','k']
# 863 => ['c','e','h','i','k','m']
# 864 => ['c','e','h','i','k','l']
# 865 => ['c','e','h','i','k','l','m']
##
##
sub seq_series {
my $seqs = seq( @_ ); # seq of seqs (!)
my $seq;
seqsub {
my @val;
do {
($seq) = $seqs->() unless $seq;
@val = $seq->() if $seq;
} while !@val && ($seq = $seqs->());
@val;
}
}
seq_series( $abcees, $one_two_threes )->enumerate;
# 0 => a
# 1 => b
# 2 => c
# 3 => 1
# 4 => 2
# 5 => 3
##
##
sub seq_reset {
my $seq = shift;
if ($seq) {
1 while $seq->();
}
$seq;
}
sub seq_zip {
my $seqs = seq( @_ ); # seq of seqs (!)
my $seq_count = @_;
seqsub {
my @outvals;
while (my $seq = $seqs->()) {
if (my @val = $seq->()) {
push @outvals, @val;
}
else {
seq_reset( $seqs->() ) for 1 .. $seq_count;
seq_reset( $seqs );
return ();
}
}
return @outvals;
}
}
##
##
seq_zip( $abcees, $one_two_threes )->enumerate;
# 0 => a 1
# 1 => b 2
# 2 => c 3
seq_zip( $abcees, $one_two_threes, $you_and_mees )
->enumerate;
# 0 => a 1 you
# 1 => b 2 me
##
##
sub seq_zip_with {
my $zipper_fn = shift;
seq_map( seq_zip(@_), $zipper_fn );
}
##
##
# some math helpers
sub sum { reduce { $a + $b } @_ }
sub product { reduce { $a * $b } @_ }
seq_zip_with( \&sum, seq(1..3), seq(0..10) )->enumerate;
# 0 => 1
# 1 => 3
# 2 => 5
seq_zip_with( \&product, seq(1..5), seq(0..10), seq(2..8) )
->enumerate;
# 0 => 0
# 1 => 6
# 2 => 24
# 3 => 60
# 4 => 120
##
##
my @site1 = qw( AATKKM aatkkm );
my @site2 = qw( GGGGGG gggggg );
my %counts;
seq_foreach_from_spec( [ \(@site1, @site2) ],
sub {
seq_foreach(
seq_zip( ( map seq(split//), @_ ) ),
sub { $counts{"@_"}++ }
)
}
);
print Dumper(\%counts), "\n";
# { 'K G' => 2, 'A G' => 2, 'm g' => 1, 'a g' => 2,
# 'A g' => 2, 'M G' => 1, 'k g' => 2, 'k G' => 2,
# 'T G' => 1, 'a G' => 2, 'm G' => 1, 't G' => 1,
# 'K g' => 2, 'M g' => 1, 't g' => 1, 'T g' => 1 }
##
##
sub seq_values {
my $seq = shift;
seq_values_scalar( seq_map( $seq, sub { [@_] } ) );
}
sub seq_values_scalar {
my $seq = shift;
my @values;
seq_foreach( $seq, sub { push @values, @_ } );
return @values;
}
##
##
print Dumper( [ seq(1..3)->seq_values ] ), "\n";
# [[1],[2],[3]]
print Dumper( [ seq(1..3)->seq_values_scalar ] ), "\n";
# [1,2,3]
##
##
sub matrix_transpose {
my $rows = shift;
[ seq_values( seq_zip( seqs(@$rows) ) ) ];
}
my $matrix = [ [ 0, 1 ]
, [ 2, 3 ]
, [ 4, 5 ] ];
print Dumper( matrix_transpose( $matrix ) ), "\n";
# [ [0,2,4]
# , [1,3,5] ]
##
##
sub seq_fold {
my ($seq, $fn) = @_;
my @accum = $seq->();
while (@accum && (my @val = $seq->())) {
@accum = $fn->(@accum, @val);
}
wantarray ? @accum : $accum[0];
}
##
##
sub dot_product {
seq_zip_with( \&product, seqs(@_) )
->seq_fold( \&sum );
}
print dot_product( [1,1,1], [1,2,3] ), "\n";
# 6