Merge pull request #2963 from choroba/ech090

Solve 090: DNA Sequence & Ethiopian Multiplication by E. Choroba

2 files changed, 46 insertions, 0 deletions

diff --git a/challenge-090/e-choroba/perl/ch-1.pl b/challenge-090/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..8c7e1b1482
--- /dev/null
+++ b/challenge-090/e-choroba/perl/ch-1.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+sub count {
+    my ($dna) = @_;
+    my %c;
+    ++$c{$_} for split //, $dna;
+    return join ', ', map { join ' ', $_, $c{$_} } sort keys %c
+}
+
+sub complement {
+    local($_) = @_;
+    tr/ATCG/TAGC/r
+}
+
+my $dna = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
+say count($dna);
+say complement($dna);
diff --git a/challenge-090/e-choroba/perl/ch-2.pl b/challenge-090/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..345f18bd10
--- /dev/null
+++ b/challenge-090/e-choroba/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+sub multiply {
+    my ($x, $y) = @_;
+    my $m = 0;
+    my $sig = $x > 0 ? 1 : -1;
+    while () {
+        $m += $sig * $y if $x % 2;
+        say "$x $y\t",
+            $x % 2
+                ? {1 => 'add ', -1 => ' subtract '}->{$sig} . $y
+                : 'skip';
+        last if 1 == abs $x || 0 == $x;
+
+        $x = int($x / 2);
+        $y *= 2;
+    }
+    say "The result is $m";
+    return $m
+}
+
+my ($x, $y) = @ARGV;
+$x * $y == multiply($x, $y) or die "Wrong!";