Solutions to challenge #25

4 files changed, 201 insertions, 0 deletions

diff --git a/challenge-025/roger-bell-west/perl5/ch-1.pl b/challenge-025/roger-bell-west/perl5/ch-1.pl
new file mode 100755
index 0000000000..d27d49a059
--- /dev/null
+++ b/challenge-025/roger-bell-west/perl5/ch-1.pl
@@ -0,0 +1,49 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+# "Generate a longest sequence of the following English Pokeman names where each name starts with the last letter of previous name."
+# I assume without reuse of a name, otherwise it's trivially (exeggcute) × ∞
+# and for simplicity I keep only the first longest sequence, not all of them
+
+use Storable qw(dclone);
+
+my $table;
+open I,'<','names.txt';
+while (<I>) {
+  chomp;
+  $_ =~ /^(.).*?(.)$/;
+  $table->{$1}{$2}{$_}=1;
+}
+close I;
+
+print join(' ',search($table,'')),"\n";
+
+sub search {
+  my $tab=shift;
+  my $init=shift;
+  my $m=0;
+  my @out;
+  my @initial;
+  if (defined $init && $init) {
+    @initial=($init);
+  } else {
+    @initial=sort keys %{$tab};
+  }
+  foreach my $initial (@initial) {
+    foreach my $final (sort keys %{$tab->{$initial}}) {
+      foreach my $candidate (sort keys %{$tab->{$initial}{$final}}) {
+        my $tt=dclone($tab);
+        delete $tt->{$initial}{$final}{$candidate};
+        my @r=($candidate,search($tt,$final));
+        my $l=scalar @r;
+        if ($l > $m) {
+          $m=$l;
+          @out=@r;
+        }
+      }
+    }
+  }
+  return @out;
+}
diff --git a/challenge-025/roger-bell-west/perl5/ch-2.pl b/challenge-025/roger-bell-west/perl5/ch-2.pl
new file mode 100755
index 0000000000..fe8a51760e
--- /dev/null
+++ b/challenge-025/roger-bell-west/perl5/ch-2.pl
@@ -0,0 +1,80 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+# Create script to implement Chaocipher.
+
+my @alpha;
+foreach my $ix (0,1) {
+  my $t=shift @ARGV;
+  unless ($t =~ /^[A-Z]{26}$/) {
+    die "Bad wheel $t\n";
+  }
+  $alpha[$ix]=[split '',$t];
+}
+
+my $dir=(shift @ARGV)?1:0;
+
+my $message=uc(join('',@ARGV));
+
+#print cipher([[split '','HXUCZVAMDSLKPEFJRIGTWOBNYQ'],
+#        [split '','PTLNBQDEOYSFAVZKGJRIHWXUMC']],
+#       'WELLDONEISBETTERTHANWELLSAID',
+#       0),"\n";;
+
+#print cipher([[split '','HXUCZVAMDSLKPEFJRIGTWOBNYQ'],
+#        [split '','PTLNBQDEOYSFAVZKGJRIHWXUMC']],
+#       'OAHQHCNYNXTSZJRRHJBYHQKSOUJY',
+#       1),"\n";;
+
+print cipher(\@alpha,
+       $message,
+       $dir),"\n";
+
+sub cipher {
+  my $alpha=shift;
+  my $in=shift;
+  my $direction=shift; # 0 encipher, 1 decipher
+  my $out;
+  foreach my $inc (split '',$in) {
+    # ddump($alpha);
+    my $m={map {$alpha->[1-$direction][$_] => $_} (0..$#{$alpha->[1-$direction]})};
+    my $outc=$alpha->[$direction][$m->{$inc}];
+    $out.=$outc;
+    my @ctpt=($outc,$inc);
+    if ($direction==1) {
+      @ctpt=($inc,$outc);
+    }
+    # 1. Shift the entire left alphabet cyclically so the ciphertext letter just enciphered is positioned at the zenith (i.e., position 1).
+    $m={map {$alpha->[0][$_] => $_} 0..$#{$alpha->[0]}};
+    push @{$alpha->[0]},@{$alpha->[0]};
+    @{$alpha->[0]}=splice @{$alpha->[0]},$m->{$ctpt[0]},26;
+    # 2. Extract the letter found at position zenith+1 (i.e., the letter to the right of the zenith), taking it out of the alphabet, temporarily leaving an unfilled ‘hole’.
+    # 3. Shift all letters in positions zenith+2 up to, and including, the nadir (zenith+13), moving them one position to the left.
+    my $temp=splice @{$alpha->[0]},1,1;
+    # 4. Insert the just-extracted letter into the nadir position (i.e., zenith+13).
+    splice @{$alpha->[0]},13,0,$temp;
+    # 1. Shift the entire right alphabet cyclically so the plaintext letter just enciphered is positioned at the zenith.
+    $m={map {$alpha->[1][$_] => $_} 0..$#{$alpha->[1]}};
+    push @{$alpha->[1]},@{$alpha->[1]};
+    @{$alpha->[1]}=splice @{$alpha->[1]},$m->{$ctpt[1]},26;
+# 2. Now shift the entire alphabet one more position to the left (i.e., the leftmost letter moves cyclically to the far right), moving a new letter into the zenith position.
+    push @{$alpha->[1]},$alpha->[1][0];
+    shift @{$alpha->[1]};
+    # 3. Extract the letter at position zenith+2, taking it out of the alphabet, temporarily leaving an unfilled ‘hole’.
+    $temp=splice @{$alpha->[1]},2,1;
+    # 4. Shift all letters beginning with zenith+3 up to, and including, the nadir (zenith+13), moving them one position to the left.
+    # 5. Insert the just-extracted letter into the nadir position (zenith+13).
+    splice @{$alpha->[1]},13,0,$temp;
+  }
+  return $out;
+}
+
+sub ddump {
+  my $alpha=shift;
+  foreach my $e (@{$alpha}) {
+    print join('',@{$e})," ";
+  }
+  print "\n";
+}
diff --git a/challenge-025/roger-bell-west/perl5/ch-2.test b/challenge-025/roger-bell-west/perl5/ch-2.test
new file mode 100644
index 0000000000..ab582c159c
--- /dev/null
+++ b/challenge-025/roger-bell-west/perl5/ch-2.test
@@ -0,0 +1,2 @@
+./ch-2.pl HXUCZVAMDSLKPEFJRIGTWOBNYQ PTLNBQDEOYSFAVZKGJRIHWXUMC 0 WELLDONEISBETTERTHANWELLSAID
+./ch-2.pl HXUCZVAMDSLKPEFJRIGTWOBNYQ PTLNBQDEOYSFAVZKGJRIHWXUMC 1 OAHQHCNYNXTSZJRRHJBYHQKSOUJY
diff --git a/challenge-025/roger-bell-west/perl5/names.txt b/challenge-025/roger-bell-west/perl5/names.txt
new file mode 100644
index 0000000000..1f1f384ce7
--- /dev/null
+++ b/challenge-025/roger-bell-west/perl5/names.txt
@@ -0,0 +1,70 @@
+audino
+bagon
+baltoy
+banette
+bidoof
+braviary
+bronzor
+carracosta
+charmeleon
+cresselia
+croagunk
+darmanitan
+deino
+emboar
+emolga
+exeggcute
+gabite
+girafarig
+gulpin
+haxorus
+heatmor
+heatran
+ivysaur
+jellicent
+jumpluff
+kangaskhan
+kricketune
+landorus
+ledyba
+loudred
+lumineon
+lunatone
+machamp
+magnezone
+mamoswine
+nosepass
+petilil
+pidgeotto
+pikachu
+pinsir
+poliwrath
+poochyena
+porygon2
+porygonz
+registeel
+relicanth
+remoraid
+rufflet
+sableye
+scolipede
+scrafty
+seaking
+sealeo
+silcoon
+simisear
+snivy
+snorlax
+spoink
+starly
+tirtouga
+trapinch
+treecko
+tyrogue
+vigoroth
+vulpix
+wailord
+wartortle
+whismur
+wingull
+yamask