From e3146b46c4c52faff040f039d2fa7fe7e5373e92 Mon Sep 17 00:00:00 2001
From: Flavio Poletti <flavio@polettix.it>
Date: Mon, 7 Dec 2020 12:07:06 +0100
Subject: Add polettix's solution to PWC090

---
 challenge-090/polettix/blog.txt     |  1 +
 challenge-090/polettix/blog1.txt    |  1 +
 challenge-090/polettix/perl/ch-1.pl | 21 +++++++++++++++
 challenge-090/polettix/perl/ch-2.pl | 53 +++++++++++++++++++++++++++++++++++++
 4 files changed, 76 insertions(+)
 create mode 100644 challenge-090/polettix/blog.txt
 create mode 100644 challenge-090/polettix/blog1.txt
 create mode 100644 challenge-090/polettix/perl/ch-1.pl
 create mode 100644 challenge-090/polettix/perl/ch-2.pl

diff --git a/challenge-090/polettix/blog.txt b/challenge-090/polettix/blog.txt
new file mode 100644
index 0000000000..9a045abf89
--- /dev/null
+++ b/challenge-090/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/11/pwc090-dna-sequence/
diff --git a/challenge-090/polettix/blog1.txt b/challenge-090/polettix/blog1.txt
new file mode 100644
index 0000000000..862e8fd3ab
--- /dev/null
+++ b/challenge-090/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/12/pwc090-ethiopian-multiplication/
diff --git a/challenge-090/polettix/perl/ch-1.pl b/challenge-090/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..d1d9d41769
--- /dev/null
+++ b/challenge-090/polettix/perl/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub dna_sequence ($s) {
+   my $complementary = $s =~ tr{ACGT}{TGCA}r;
+   my %cf = map { $_ => eval "scalar \$s =~ tr{$_}{}d" } qw< A C G T >;
+   return (\%cf, $complementary);
+}
+
+my $default =
+  'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
+my $sequence = shift || $default;
+my ($cf, $complementary) = dna_sequence($sequence);
+
+$|++;
+say {*STDERR} $sequence;
+say {*STDOUT} $complementary;
+say {*STDOUT} "A<$cf->{A}> C<$cf->{C}> G<$cf->{G}> T<$cf->{T}>";
diff --git a/challenge-090/polettix/perl/ch-2.pl b/challenge-090/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..2ef03d7cd5
--- /dev/null
+++ b/challenge-090/polettix/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub ethiopian_multiplication ($A, $B) {
+   say {*STDOUT} "# Let's multiply A = $A and B = $B, the Ethiopian way!";
+
+   my $p = sub { printf {*STDOUT} "A = %3d, B = %3d%s\n", $A, $B, ($A % 2 ? '   (*)' : '') };
+   $p->();
+   say {*STDOUT} '';
+
+   my $result_string = "A * B = $A * $B";
+
+   if ($A == 1 || $B == 1) {
+      say {*STDOUT} "$result_string = ", $A * $B, ' no need for Ethiopians!';
+      return;
+   }
+
+   my $A_starts_even = $A % 2 == 0;
+   if ($A_starts_even) {
+      say {*STDOUT} '# Let\'s transfer all the even-ness from A to B';
+      while ($A % 2 == 0) {
+         $A /= 2;
+         $B *= 2;
+         $p->();
+      }
+      say {*STDOUT} '';
+   }
+
+   my $sum = $B;
+   if ($A > 1) {
+      print {*STDOUT} $A_starts_even ? '# Now ' : '# ';
+      say {*STDOUT} 'A is odd, but we will ignore remainders for now...';
+      while ($A > 1) {
+         $A = int($A / 2);
+         $B *= 2;
+         $sum += $B;
+         $p->();
+      }
+      say {*STDOUT} '';
+   }
+
+   say {*STDOUT} '# Now, we take all "B" values marked with an asterisk';
+   say {*STDOUT} "$result_string = $sum";
+
+   return;
+}
+
+my $A = shift || 14;
+my $B = shift || 12;
+ethiopian_multiplication($A, $B);
-- 
cgit