diff options
| -rwxr-xr-x | challenge-090/alexander-pankoff/perl/ch-1.pl | 17 | ||||
| -rwxr-xr-x | challenge-090/alexander-pankoff/perl/ch-2.pl | 45 |
2 files changed, 62 insertions, 0 deletions
diff --git a/challenge-090/alexander-pankoff/perl/ch-1.pl b/challenge-090/alexander-pankoff/perl/ch-1.pl new file mode 100755 index 0000000000..15f2c016bc --- /dev/null +++ b/challenge-090/alexander-pankoff/perl/ch-1.pl @@ -0,0 +1,17 @@ +#!/usr/bin/env perl +use v5.20; +use utf8; +use strict; +use warnings; +use feature qw(say signatures); +no warnings 'experimental::signatures'; + +{ + my ( $sequence ) = @ARGV; + die 'need dna sequence' unless $sequence; + my %complements = ( T => 'A', G => 'C' ); + %complements = ( %complements, reverse %complements ); + + say 'Nucleiobase count: ' . length( $sequence ); + say 'Complementary sequence: ' . join( '', map { $complements{$_} } split( '', $sequence ) ); +} diff --git a/challenge-090/alexander-pankoff/perl/ch-2.pl b/challenge-090/alexander-pankoff/perl/ch-2.pl new file mode 100755 index 0000000000..a66c4feea7 --- /dev/null +++ b/challenge-090/alexander-pankoff/perl/ch-2.pl @@ -0,0 +1,45 @@ +#!/usr/bin/env perl +use v5.20; +use utf8; +use strict; +use warnings; +use feature qw(say signatures); +no warnings 'experimental::signatures'; + +use List::Util qw(sum0); + +use Test::Simple tests => 20; + +use constant VERBOSE => $ENV{VERBOSE} // 0; + +{ + for ( 0 .. 19 ) { + my ( $a, $b ) = map { int( rand( 1000 ) ) + 1 } 0 .. 1; + my $expected = $a * $b; + ok( ethopian_mul( $a, $b ) == $expected, "ethopian_mul($a, $b) = $a * $b = $expected" ); + } +} + +sub ethopian_mul ( $a, $b ) { + my @chain = ethopian_mul_chain( $a, $b ); + verbose( "halving $a, doubling $b, till $a becomes 1" ); + verbose( $_->[0] . ' & ' . $_->[1] ) for @chain; + + my @filtered = map { $_->[1] } grep { odd( $_->[0] ) } @chain; + verbose( "taking right values where left value is odd" ); + verbose( $_ ) for @filtered; + my $product = sum0( @filtered ); + verbose( "product is $product" ); + return $product; +} + +sub ethopian_mul_chain ( $a, $b ) { + return [ $a, $b ] if $a <= 1; + + # using bit shifts to avoid use of multiplication + return ( [ $a, $b ], ethopian_mul_chain( $a >> 1, $b << 1 ) ); +} + +sub odd($x) { + $x & 1; +} |
