Merge pull request #2948 from ccntrq/challenge-090

add solutions for challenge-090 in perl

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;
+}