Merge pull request #2940 from drbaggy/master

The day job! This is v2 with some "output" in ch-2.pl

2 files changed, 73 insertions, 0 deletions

diff --git a/challenge-090/james-smith/perl/ch-1.pl b/challenge-090/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..0970dfd554
--- /dev/null
+++ b/challenge-090/james-smith/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+## Ah! The day job....
+## Both these we've always used `tr` for as the fastest way to compute the
+## DNA count and to get reverse complement of sequence
+
+my $seq = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG';
+
+is( revcomp($seq), 'CGGCGACCAGCAACACATCTCTGAGAATGGATAAGGAGTCGATCTGTCTAAATGAAAAGGGGTTTAC' );
+is_deeply( counts($seq), { 'T' => 22, 'A' => 14, 'C' => 18, 'G' => 13 } );
+
+done_testing();
+
+sub counts {
+  return { 'T' => $_[0] =~ tr/T/T/, 'A' => $_[0] =~ tr/A/A/,
+           'C' => $_[0] =~ tr/C/C/, 'G' => $_[0] =~ tr/G/G/, };
+}
+
+sub revcomp {
+  return reverse $_[0] =~ tr/ATCG/TAGC/r;
+}
+
diff --git a/challenge-090/james-smith/perl/ch-2.pl b/challenge-090/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..a8227b59f2
--- /dev/null
+++ b/challenge-090/james-smith/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+## This is ripe for bit operators - as it is about multiplying/diving by 2...
+## and checking for the value of the "1s" bit....
+#
+# To execute as a quiet test - use `perl ch-2.pl`
+#
+# To show workings run `perl ch-2.pl 1`
+
+my $flag = @ARGV && $ARGV[0] eq '1' ? 1 : 0;
+foreach(1..10) {
+  my $x = 100 + int rand(400);
+  my $y = 100 + int rand(400);
+  is( eth_mult( $x , $y, $flag ), $x*$y );
+}
+
+done_testing();
+
+sub eth_mult {
+  my( $n, $m, $verbose ) = @_;
+  $verbose ||= 0;
+  my $calc = $n*$m;
+  my $res = 0;
+  say q() if $verbose;
+  while($n) {
+    printf "%7d x %7d | %7s\n", $n, $m, $n&1 ? $m : q(.) if $verbose;
+    # The meat - use binary and
+    $res += $m if $n&1;
+    $m<<=1;
+    $n>>=1;
+  }
+  if( $verbose ) {
+    say    q(------------------+--------);
+    printf "                  | %7d (%7d)\n", $res, $calc;
+    say q();
+  }
+  return $res;
+}
+