#!/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