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

3 files changed, 72 insertions, 0 deletions

diff --git a/challenge-090/wlmb/blog.txt b/challenge-090/wlmb/blog.txt
new file mode 100644
index 0000000000..c05dda5cfa
--- /dev/null
+++ b/challenge-090/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2020/12/07/PWC90/
diff --git a/challenge-090/wlmb/perl/ch-1.pl b/challenge-090/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..9e5f5c07c4
--- /dev/null
+++ b/challenge-090/wlmb/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+# For sequences of DNA get nucleotide counts and its complement
+# See https:/wlmb.github.io/2020/12/07/PWC90/#task-1-dna-sequence
+use strict;
+use warnings;
+use v5.10;
+
+use List::Util qw(sum0);
+
+say('Usage: ch-1.pl sequence1 sequence2 ...'), exit 1 unless @ARGV;
+
+my %complement_of; # Map dna nucleotide to its complement
+@complement_of{my @nucleotides=qw(T A G C)}=qw(A T C G); #initialize
+
+foreach my $sequence(map {uc} @ARGV){
+    say("Wrong sequence $sequence"), next unless $sequence=~/^[@nucleotides]*$/;
+    say "  Sequence: $sequence";
+    say "Complement: ", complement($sequence);
+    my %count_for=get_count_for($sequence);
+    say "Nucleotide counts:";
+    say "\t$_-$complement_of{$_} $count_for{$_}" for @nucleotides;
+    say "\tTotal\t", sum0 values %count_for;
+}
+
+sub complement { # converts string with a DNA sequence to its complement
+    my $sequence=shift;
+    return join "", map {$complement_of{$_}} split //, $sequence;
+}
+
+sub get_count_for { # count nucleotides of a dna sequence
+    my $sequence=shift;
+    my @nucleotides=split //,$sequence;
+    my %count_for; # counts of nucleotides
+    @count_for{qw(T A G C)}=((0) x 4); #initialize with 0's
+    map {$count_for{$_}++} split //, $sequence;
+    return %count_for;
+}
diff --git a/challenge-090/wlmb/perl/ch-2.pl b/challenge-090/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..44f9f1ab56
--- /dev/null
+++ b/challenge-090/wlmb/perl/ch-2.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+# Multiply two numbers using the Ethiopian Multiplication
+# See https:/wlmb.github.io/2020/12/07/PWC90/#task-2-ethiopian-multiplication
+use strict;
+use warnings;
+use v5.10;
+use integer;
+use List::Util qw(all);
+
+# receive the two numbers in @ARGV
+die 'Usage: ./ch2.pl number1 number2' unless @ARGV==2;
+my ($x, $y)= @ARGV; #
+die 'Expected two non-negative integers'   # check they are postitive integers
+    unless all {int($_) eq $_ && $_>=0} ($x, $y); #Use eq to avoid implicit int conversion
+
+my $expected_result=$x*$y;
+my $result=0;
+my $result_string="$x x $y = ";
+my $operator="";
+
+while($x){
+    if($x&1){  # $x is odd, add $y to result
+	print "->"; # flag line
+	$result += $y;
+	$result_string .= "$operator 1 x $y";
+    } else {   # $x is even, don't add y
+	$result_string.="$operator 0 x $y";
+    }
+    say "\tx=$x\ty=$y";
+    $operator=" + ";
+    $x>>=1;  # Divde $x by 2
+    $y<<=1;  # Multiply $y by 2
+}
+say " $result_string = $result (Expected: $expected_result)";