Merge branch 'master' of github.com:manwar/perlweeklychallenge-club

38 files changed, 780 insertions, 65 deletions

diff --git a/challenge-090/aaronreidsmith/blog.txt b/challenge-090/aaronreidsmith/blog.txt
new file mode 100644
index 0000000000..c0bf9276a7
--- /dev/null
+++ b/challenge-090/aaronreidsmith/blog.txt
@@ -0,0 +1 @@
+https://aaronreidsmith.github.io/blog/perl-weekly-challenge-090/
\ No newline at end of file
diff --git a/challenge-090/aaronreidsmith/raku/ch-1.raku b/challenge-090/aaronreidsmith/raku/ch-1.raku
new file mode 100644
index 0000000000..3c12a719c9
--- /dev/null
+++ b/challenge-090/aaronreidsmith/raku/ch-1.raku
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl6
+
+subset ValidDna of Str where { $_ ~~ /^^[A|T|G|C]+$$/ }
+
+# Since DNA is generally read from 5' to 3', I included the option to find the
+# reverse compliment in addition to the complement
+sub MAIN($dna where $dna ~~ ValidDna, Bool :rc(:$reverse-complement) = False) {
+    say "Input stats:\n{$dna.comb.Bag.Hash}\n";
+
+    say "Complement:";
+    my $translated = $dna.trans('ATGC' => 'TACG');
+    if $reverse-complement {
+        say "5'-{$translated.flip}-3'";
+    } else {
+        say "3'-$translated-5'"
+    }
+}
diff --git a/challenge-090/aaronreidsmith/raku/ch-2.raku b/challenge-090/aaronreidsmith/raku/ch-2.raku
new file mode 100644
index 0000000000..fa5fe375c6
--- /dev/null
+++ b/challenge-090/aaronreidsmith/raku/ch-2.raku
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl6
+
+subset PositiveInt of Int where { $_ ~~ Int && $_ > 0 }
+
+sub generate-pairs($a, $b) {
+    sprintf("%02d, %02d", $a, $b).put;
+    if $a == 1 {
+        (($a, $b),);
+    } else {
+        (($a, $b), |generate-pairs($a div 2, $b * 2));
+    }
+}
+
+sub MAIN(PositiveInt $A, PositiveInt $B) {
+    say "Input: A=$A, B=$B";
+    say "Divide A by 2 (ignoring remainders) until it is 1. Multiply B by 2 as we go:";
+    my @pairs = generate-pairs($A, $B);
+    say "Then, wherever A is odd, we add the Bs together:";
+    my @odd-bs = @pairs.grep(-> @pair { !(@pair[0] %% 2) }).map(-> @pair { @pair[1] });
+    say "{@odd-bs.join(' + ')} = {@odd-bs.sum}";
+}
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;
+}
diff --git a/challenge-090/andinus/README b/challenge-090/andinus/README
index b372bec8d3..b662f1cb50 100644
--- a/challenge-090/andinus/README
+++ b/challenge-090/andinus/README
@@ -1,67 +1,95 @@
                             ━━━━━━━━━━━━━━━
-                             CHALLENGE 086
+                             CHALLENGE 090
 
                                 Andinus
                             ━━━━━━━━━━━━━━━
 
 
-                               2020-11-15
+                               2020-12-08
 
 
 Table of Contents
 ─────────────────
 
-1. Task 1 - Pair Difference
-.. 1. Perl
+1. Task 2 - Ethiopian Multiplication
+.. 1. Raku
 
 
 
 
 
-1 Task 1 - Pair Difference
-══════════════════════════
+1 Task 2 - Ethiopian Multiplication
+═══════════════════════════════════
 
-  You are given an array of integers @N and an integer $A.
+  You are given two positive numbers $A and $B.
 
-  Write a script to find find if there exists a pair of elements in the
-  array whose difference is $A.
+  Write a script to demonstrate [Ethiopian Multiplication] using the
+  given numbers.
 
-  Print 1 if exists otherwise 0.
 
+[Ethiopian Multiplication]
+<https://threesixty360.wordpress.com/2009/06/09/ethiopian-multiplication/>
 
-1.1 Perl
+1.1 Raku
 ────────
 
-  • Program: <file:perl/ch-1.pl>
+  • Program: <file:perl/ch-2.raku>
 
-  @N & $A are taken from stdin, $A is the last argument.
+  Start by taking `$A' & `$B' which are defined to be `Int' & positive.
   ┌────
-  │ die "usage: ./ch-1.pl <integers \@N> <integer \$A>\n"
-  │     unless scalar @ARGV >= 3;
-  │
-  │ my $A = pop @ARGV;
-  │ my @N = @ARGV;
+  │ sub MAIN (
+  │     #= positive numbers
+  │     Int $A is copy where * > 0,
+  │     Int $B is copy where * > 0
+  │ ) {
+  │     ...
+  │ }
   └────
 
-  We just loop over @N over a loop over @N & find the difference. If
-  it's equal to `$A' or `-$A' then we print `1' & exit. The first loop
-  is `shift''ing the numbers out of array `@N' because we are matching
-  for both `$A' & `-$A' so we don't need the number again.
+  Here's relevant part from the link that was given above:
+        Start with the two numbers on top. Halve one, ignoring any
+        remainders or fractions, and double the other, stopping
+        when you get to 1.
 
-  For example, if `@N = [1, 2]' & we don't `shift' in first loop then
-  we'll perform 2 subtraction operations: `1 - 2' & `2 - 1' & we won't
-  have to match for `-$A' but if we just match for `-$A' then we can use
-  `shift' & we'll only have to perform 1 subtraction operation `1 - 2'.
+        14 & 12 7 & 24 3 & 48 [See how I ignored the fact that
+        halving 7 leaves 1 left over?] 1 & 96 <— Stop here.
 
-  We assume subtraction costs more than matching with `-$A', that makes
-  this more efficient. But it doesn't matter much.
+        Now look at the numbers on the right. Some are across from
+        an even number: in this case, 12 is across from the
+        original 14. Ignore those, and add the rest. So we’ll add
+        24, 48, and 96, which were across from odd numbers, and
+        get 168. And that’s the product! Isn’t that cool?
+
+  We do the same thing & also print the instructions.
   ┌────
-  │ while (my $int = shift @N) {
-  │     foreach (@N) {
-  │         my $diff = $int - $_;
-  │         print "1\n" and exit 0 if ($diff == $A or $diff == -$A);
+  │ my %sets;
+  │
+  │ say "Ethopian Multiplication.\n";
+  │ say "Start with $A, $B.";
+  │ say "Divide $A by 2 & multiple $B by 2 at each step.";
+  │ say "Continue until $A equals 1. Drop the remainder, both should be Integer.\n";
+  │
+  │ say "$A, $B";
+  │ while True {
+  │     %sets{$A} = $B.Int;
+  │     $A = ($A / 2).Int;
+  │     $B = ($B * 2).Int;
+  │     last if $A < 1;
+  │     say "$A, $B";
+  │ }
+  │
+  │ say "\nNow to find the product, simply add all the numbers on right side of ','.";
+  │ say "But skip those numbers which have an even number on the left side.\n";
+  │
+  │ my Int $product = 0;
+  │ for %sets.sort({.key.Int}).reverse -> $pair {
+  │     if $pair.key % 2 != 0 {
+  │         $product += $pair.value;
+  │         say "- Adding ", $pair.value, " to product.";
+  │     } else {
+  │         say "- Skipping ", $pair.value, " because ", $pair.key, " is even.";
   │     }
   │ }
-  │ print "0\n";
   │
+  │ say "\nProduct: $product";
   └────
diff --git a/challenge-090/andinus/README.org b/challenge-090/andinus/README.org
new file mode 100644
index 0000000000..c4f5da3378
--- /dev/null
+++ b/challenge-090/andinus/README.org
@@ -0,0 +1,75 @@
+#+SETUPFILE: ~/.emacs.d/org-templates/level-2.org
+#+HTML_LINK_UP: ../index.html
+#+OPTIONS: toc:2
+#+EXPORT_FILE_NAME: index
+#+DATE: 2020-12-08
+#+TITLE: Challenge 090
+
+* Task 2 - Ethiopian Multiplication
+You are given two positive numbers $A and $B.
+
+Write a script to demonstrate [[https://threesixty360.wordpress.com/2009/06/09/ethiopian-multiplication/][Ethiopian Multiplication]] using the given
+numbers.
+** Raku
+- Program: [[file:perl/ch-2.raku]]
+
+Start by taking =$A= & =$B= which are defined to be =Int= & positive.
+#+BEGIN_SRC raku
+sub MAIN (
+    #= positive numbers
+    Int $A is copy where * > 0,
+    Int $B is copy where * > 0
+) {
+    ...
+}
+#+END_SRC
+
+Here's relevant part from the link that was given above:
+#+BEGIN_QUOTE
+Start with the two numbers on top. Halve one, ignoring any remainders or
+fractions, and double the other, stopping when you get to 1.
+
+14 & 12
+7 & 24
+3 & 48  [See how I ignored the fact that halving 7 leaves 1 left over?]
+1 & 96  <— Stop here.
+
+Now look at the numbers on the right. Some are across from an even
+number: in this case, 12 is across from the original 14. Ignore those,
+and add the rest. So we’ll add 24, 48, and 96, which were across from
+odd numbers, and get 168. And that’s the product! Isn’t that cool?
+#+END_QUOTE
+
+We do the same thing & also print the instructions.
+#+BEGIN_SRC raku
+my %sets;
+
+say "Ethopian Multiplication.\n";
+say "Start with $A, $B.";
+say "Divide $A by 2 & multiple $B by 2 at each step.";
+say "Continue until $A equals 1. Drop the remainder, both should be Integer.\n";
+
+say "$A, $B";
+while True {
+    %sets{$A} = $B.Int;
+    $A = ($A / 2).Int;
+    $B = ($B * 2).Int;
+    last if $A < 1;
+    say "$A, $B";
+}
+
+say "\nNow to find the product, simply add all the numbers on right side of ','.";
+say "But skip those numbers which have an even number on the left side.\n";
+
+my Int $product = 0;
+for %sets.sort({.key.Int}).reverse -> $pair {
+    if $pair.key % 2 != 0 {
+        $product += $pair.value;
+        say "- Adding ", $pair.value, " to product.";
+    } else {
+        say "- Skipping ", $pair.value, " because ", $pair.key, " is even.";
+    }
+}
+
+say "\nProduct: $product";
+#+END_SRC
diff --git a/challenge-090/andinus/blog-2.txt b/challenge-090/andinus/blog-2.txt
new file mode 100644
index 0000000000..5b667faed0
--- /dev/null
+++ b/challenge-090/andinus/blog-2.txt
@@ -0,0 +1 @@
+https://andinus.tilde.institute/pwc/challenge-090/
diff --git a/challenge-090/andinus/raku/ch-2.raku b/challenge-090/andinus/raku/ch-2.raku
new file mode 100755
index 0000000000..5a30ae90b4
--- /dev/null
+++ b/challenge-090/andinus/raku/ch-2.raku
@@ -0,0 +1,38 @@
+#!/usr/bin/env raku
+
+sub MAIN (
+    #= positive numbers
+    Int $A is copy where * > 0,
+    Int $B is copy where * > 0
+) {
+    my %sets;
+
+    say "Ethopian Multiplication.\n";
+    say "Start with $A, $B.";
+    say "Divide $A by 2 & multiple $B by 2 at each step.";
+    say "Continue until $A equals 1. Drop the remainder, both should be Integer.\n";
+
+    say "$A, $B";
+    while True {
+        %sets{$A} = $B.Int;
+        $A = ($A / 2).Int;
+        $B = ($B * 2).Int;
+        last if $A < 1;
+        say "$A, $B";
+    }
+
+    say "\nNow to find the product, simply add all the numbers on right side of ','.";
+    say "But skip those numbers which have an even number on the left side.\n";
+
+    my Int $product = 0;
+    for %sets.sort({.key.Int}).reverse -> $pair {
+        if $pair.key % 2 != 0 {
+            $product += $pair.value;
+            say "- Adding ", $pair.value, " to product.";
+        } else {
+            say "- Skipping ", $pair.value, " because ", $pair.key, " is even.";
+        }
+    }
+
+    say "\nProduct: $product";
+}
diff --git a/challenge-090/cristian-heredia/perl/ch-2.pl b/challenge-090/cristian-heredia/perl/ch-2.pl
new file mode 100644
index 0000000000..2aeac8b209
--- /dev/null
+++ b/challenge-090/cristian-heredia/perl/ch-2.pl
@@ -0,0 +1,38 @@
+=begin
+
+    TASK #2 › Ethiopian Multiplication
+    Submitted by: Mohammad S Anwar
+    You are given two positive numbers $A and $B.
+    
+    Write a script to demonstrate Ethiopian Multiplication using the given numbers.
+
+=end
+=cut
+
+use strict;
+use warnings;
+
+#variables:
+my $A = 14;
+my $B = 12;
+my $result = 0;
+print "The result for $A * $B is: ";
+calculation();
+
+sub calculation {
+    checkOdd($A);
+    while ($A != 1) {
+        use integer;
+        $A = $A/2;
+        $B = $B*2;
+        checkOdd($A);
+    }
+    print "$result\n";
+}
+
+sub checkOdd {
+    my $number = shift;
+    if ($number%2) {
+        $result = $result + $B;
+    }
+}
\ No newline at end of file
diff --git a/challenge-090/dave-jacoby/blog.txt b/challenge-090/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..b692db20a0
--- /dev/null
+++ b/challenge-090/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2020/12/08/multiplication-and-dna-perl-weekly-challenge-90.html
\ No newline at end of file
diff --git a/challenge-090/dave-jacoby/perl/ch-1.pl b/challenge-090/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..ed5f5e8cc6
--- /dev/null
+++ b/challenge-090/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+my $sequence =  'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG' ;
+my $complement = $sequence;
+$complement =~ tr/TACG/ATGC/;
+
+say <<"END";
+    Sequence:   $sequence
+    Complement: $complement
+END
+
+for my $i ( qw( A T C G ) ) {
+    my $n = scalar grep {/$i/} split // , $sequence;
+    say qq(    $i: $n );
+}
+
+
diff --git a/challenge-090/dave-jacoby/perl/ch-2.pl b/challenge-090/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..2973f52f1d
--- /dev/null
+++ b/challenge-090/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use Scalar::Util qw{looks_like_number};
+
+my ( $m, $n ) = map { abs $_ } grep { looks_like_number $_ } @ARGV;
+
+$m //= 17;
+$n //= 38;
+
+say <<"END";
+
+    m $m
+    n $n
+END
+
+say egyptian( $m, $n );
+say $m * $n;
+
+exit;
+
+sub egyptian ( $m, $n ) {
+    my $o = 0;
+    my $i = 1;
+    do {
+        my $e = $m % 2 != 0 ? 1 : 0;
+        say join "\t", $o, $e, $i, $m, $n;
+        $o += $n if $e;
+        $i *= 2;
+        $m = int $m / 2;
+        $n = $n * 2;
+    } while ( $m > 0 );
+    return $o;
+}
diff --git a/challenge-090/garrett-goebel/README b/challenge-090/garrett-goebel/README
new file mode 100644
index 0000000000..a8aa246dbb
--- /dev/null
+++ b/challenge-090/garrett-goebel/README
@@ -0,0 +1 @@
+Solution by Garrett Goebel
diff --git a/challenge-090/garrett-goebel/raku/ch-1.raku b/challenge-090/garrett-goebel/raku/ch-1.raku
new file mode 100644
index 0000000000..00c9d0df57
--- /dev/null
+++ b/challenge-090/garrett-goebel/raku/ch-1.raku
@@ -0,0 +1,5 @@
+#!/usr/bin/env raku
+'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG'.&{
+    say 'Nucleiobase count: ' ~ .comb.elems;
+    say 'Complementary sequence: ' ~ TR/TAGC/ATCG/;
+}
diff --git a/challenge-090/garrett-goebel/raku/ch-2.raku b/challenge-090/garrett-goebel/raku/ch-2.raku
new file mode 100644
index 0000000000..dede70ec31
--- /dev/null
+++ b/challenge-090/garrett-goebel/raku/ch-2.raku
@@ -0,0 +1,19 @@
+#!/usr/bin/env raku
+
+unit sub MAIN (
+    Int $A is copy where $A > 0 = 14,
+    Int $B is copy where $B > 0 = 12
+);
+
+my Int $r = 0;
+my $format = "%10d & %10d | product: %10d\n";
+$format.printf($A,$B, $r);
+
+if ($A > 1) {
+    repeat {
+        $r += $B  if $A mod 2;
+        $format.printf($A div= 2, $B *= 2, $r);
+    } while $A > 1;
+}
+$r += $B;
+~(' ' x 24 ~ "| product: %10d\n").printf($r);
diff --git a/challenge-090/laurent-rosenfeld/blog.txt b/challenge-090/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..fbb7836743
--- /dev/null
+++ b/challenge-090/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2020/12/perl-weekly-challenge-90-dna-sequence-and-ethiopian-multiplication.html
diff --git a/challenge-090/laurent-rosenfeld/perl/ch-1.pl b/challenge-090/laurent-rosenfeld/perl/ch-1.pl
new file mode 100644
index 0000000000..bb0ca420cb
--- /dev/null
+++ b/challenge-090/laurent-rosenfeld/perl/ch-1.pl
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use feature "say";
+
+my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
+# count
+my %histogram;
+$histogram{$_}++ for split '', $dna;
+say "$_: $histogram{$_}" for keys %histogram;
+
+# Complementary sequence
+say for "Complement:", $dna =~ tr/TAGC/ATCG/r;
diff --git a/challenge-090/laurent-rosenfeld/perl/ch-2.pl b/challenge-090/laurent-rosenfeld/perl/ch-2.pl
new file mode 100644
index 0000000000..0b8ef08383
--- /dev/null
+++ b/challenge-090/laurent-rosenfeld/perl/ch-2.pl
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use feature "say";
+
+my ($c, $d) = @ARGV;
+my $result = $c % 2 ? $d : 0;
+while ($c > 1) {
+    $c = $c >> 1; # right shift 1 bit = div by 2
+    $d *= 2;
+    $result += $d if $c % 2;
+}
+say $result;
diff --git a/challenge-090/laurent-rosenfeld/raku/ch-1.raku b/challenge-090/laurent-rosenfeld/raku/ch-1.raku
new file mode 100644
index 0000000000..16c141c593
--- /dev/null
+++ b/challenge-090/laurent-rosenfeld/raku/ch-1.raku
@@ -0,0 +1,13 @@
+use v6;
+
+my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
+
+# count
+my %histo;
+%histo{$_}++ for $dna.comb;
+say "Histogram:";
+.say for %histo.pairs;
+
+# Complementary sequence
+my %complement = T => 'A', A => 'T', G => 'C', C => 'G';
+.say for "Complement:", $dna.comb.map({%complement{$_}}).join: '';
diff --git a/challenge-090/laurent-rosenfeld/raku/ch-2.raku b/challenge-090/laurent-rosenfeld/raku/ch-2.raku
new file mode 100644
index 0000000000..8c1d413537
--- /dev/null
+++ b/challenge-090/laurent-rosenfeld/raku/ch-2.raku
@@ -0,0 +1,10 @@
+use v6;
+
+my ($a, $b) = map {$_.Int}, @*ARGS;
+my $result = $a % 2 ?? $b !! 0;
+while $a > 1 {
+    $a div= 2;
+    $b *= 2;
+    $result += $b if $a % 2;
+}
+say $result;
diff --git a/challenge-090/pete-houston/perl/ch-1.pl b/challenge-090/pete-houston/perl/ch-1.pl
new file mode 100644
index 0000000000..e35a0078df
--- /dev/null
+++ b/challenge-090/pete-houston/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 9001.pl
+#
+#        USAGE: ./9001.pl STRING
+#
+#  DESCRIPTION: DNA nucleobase counts and complementary sequence
+#
+#        NOTES: STRING must contain uppercase A, C, G and T characters
+#         BUGS: uses string eval *shudder*
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 07/12/20
+#===============================================================================
+
+use strict;
+use warnings;
+
+my $dna = shift;
+for my $base (qw/A C G T/) {
+	printf "Count of $base is %i\n", eval "\$dna =~ tr/$base/$base/;";
+}
+print "Original sequence is $dna\n";
+$dna =~ tr/ACGT/TGCA/;
+print "Complementary sequence is $dna\n";
diff --git a/challenge-090/pete-houston/perl/ch-2.pl b/challenge-090/pete-houston/perl/ch-2.pl
new file mode 100644
index 0000000000..ba80f52e08
--- /dev/null
+++ b/challenge-090/pete-houston/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 9002.pl
+#
+#        USAGE: ./9002.pl [-q] N M
+#
+#  DESCRIPTION: Ethiopian multiplication showing working out.
+#
+#      OPTIONS: -q to hide working out
+# REQUIREMENTS: Getopt::Std
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 07/12/20
+#===============================================================================
+
+use strict;
+use warnings;
+
+use Getopt::Std;
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+*HELP_MESSAGE = \&usage;
+our $VERSION = '1.00';
+
+# Get option
+my %opts;
+getopts ('q', \%opts) or usage ();
+
+# Validate arguments
+my ($n, $m) = @ARGV;
+for ($n, $m) {
+	usage () unless defined && /^[0-9]+$/ && $_ >= 1;
+}
+
+# Process the multiplication
+verbose ("Starting with $n and $m we iterate by halving and doubling\n");
+
+my $tot     = 0;
+my $target  = $n * $m;
+my $prodstr = "$n * $m";
+
+while (1) {
+	verbose (sprintf "%5i, %5i\n", $n, $m);
+	if ($n % 2) {
+		$tot += $m;
+		verbose ("  $n is odd so add this value of $m " .
+			"to give a running total of $tot\n");
+	} else {
+		verbose ("  $n is even so ignore this value of $m\n");
+
+	}
+	if ($n == 1) {
+		verbose ("  n is $n, so we are finished and th