Merge pull request #615 from Doomtrain14/master

Added Perl6 solutions

4 files changed, 134 insertions, 19 deletions

diff --git a/challenge-025/yet-ebreo/perl5/ch-1.pl b/challenge-025/yet-ebreo/perl5/ch-1.pl
index 070363d90c..9944338393 100644
--- a/challenge-025/yet-ebreo/perl5/ch-1.pl
+++ b/challenge-025/yet-ebreo/perl5/ch-1.pl
@@ -14,13 +14,11 @@ use 5.010;
 my $start_run = time();
 
 my @names = qw(bagon audino 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);
-
 my %hash;
 my $max_length = 0;
-my $length = 0;
 my @chain;
 
-#First I need to group each name (in @names) by the starting letter
+#First, I need to group each name (in @names) by the starting letter
 #so that I dont have to filter out @names in each iteration
 #For this, I used Hashes of Arrays which will be structured like so:
 #%hash = (
@@ -28,7 +26,7 @@ my @chain;
 #    ...
 #    e => ["emboar", "emolga", "exeggcute"],
 #    ..
-#    z => ["yamask"],
+#    y => ["yamask"],
 #)
 for my $n (@names) {
     my $first = substr $n,0,1;
@@ -79,7 +77,7 @@ for my $seq (@{$chain[-1]}) {
     say "$seq\n";
 }
 say "Highest chain count: $#chain";
-say "Number of Sequence found: $#{$chain[-1]}";
+say "Number of Sequence found: ".@{$chain[-1]};
 
 my $run_time = time() - $start_run;
 say "Run Time: $run_time sec";
@@ -93,11 +91,11 @@ Sequence:
 
 > machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > relicanth > haxorus > simisear > registeel > landorus > seaking > girafarig > gabite > emolga > audino
 Highest chain count: 23
-Number of Sequence found: 1247
+Number of Sequence found: 1248
 Run Time: 5 sec
 
 #Note(s):
-- There are actually 1247 sequences with 23 chain counts. I decided to print them all. 
+- There are actually 1248 sequences with 23 chain counts. I decided to print them all. 
 - I am surprised with the speed compared to other algorithms.
 - I appreciate the challenges for this week, they are actually challenging. Thanks!
 =cut
diff --git a/challenge-025/yet-ebreo/perl5/ch-2.pl b/challenge-025/yet-ebreo/perl5/ch-2.pl
index 6d9003b689..8d5a8c63cf 100644
--- a/challenge-025/yet-ebreo/perl5/ch-2.pl
+++ b/challenge-025/yet-ebreo/perl5/ch-2.pl
@@ -6,6 +6,10 @@ use strict;
 use warnings;
 use 5.010;
 
+die "Usage:\n\tch-2.pl <-d|e> \"<string to encrypt>\"\n\n" if @ARGV<2;
+my $encrypt     = $ARGV[0] eq '-e';
+my $text_string = $ARGV[1];
+
 #It should be okay to modify the zenith/nadir (0 to $wheelsize)
 use constant ZENITH  => 0;
 use constant NADIR   => 13;
@@ -16,11 +20,7 @@ my @ct = "vEDclCHZYeWo9drb6Jnkf5MRXOt UgN4Fi231GzQIx7sPaLK8TBuVpA0yjShqwm"=~/./g
 
 my $wheel_size = $#pt;
 
-die "Usage:\n\tch-2.pl <-d|e> \"<string to encrypt>\"\n\n" if @ARGV<2;
-my $encrypt     = $ARGV[0] eq '-e';
-my $text_string = $ARGV[1];
-
-# This function rotate the given array or a portion of the given array 
+# This function rotates the given array or a portion of the given array 
 # Rotation count is defined by $r
 # The whole array will be rotated by default
 # but the range can be specified in $from and $to variable
@@ -40,14 +40,14 @@ sub cipher {
     my ($text,$enc,$ret) = @_;
     
     for my $c ($text=~/./g) {
-        #find where $c is in the plain text @pt
+        #find where $c is in the plain text @pt (or @ct when decrypting)
         #grep wont stop when first occurence was found
         my $pt_pos = (grep {($enc?$pt[$_]:$ct[$_]) eq $c} 0..$wheel_size)[0];
 
-        #Get the character from the cipher text in that position
+        #Get the character from the cipher text in that position($pt_pos)
         $ret .= $enc?$ct[$pt_pos]:$pt[$pt_pos];
         
-        #rotate @pt and @ct from $pt to ZENITH
+        #rotate @pt and @ct from $pt_pos to ZENITH
         &rot($pt_pos-ZENITH, \@pt);
         &rot($pt_pos-ZENITH, \@ct);
 
@@ -62,9 +62,9 @@ sub cipher {
 }
 say &cipher($text_string,$encrypt);
 =begin
-perl .\ch-2.pl -e "a quick brown fox jumps over lazy dog"
-gFv4ujqOyIPdTk5I9bKrYUXY4DwkCtV27vpk9
+perl .\ch-2.pl -e "a quick brown fox jumps over the lazy dog"
+gFv4ujqOyIPdTk5I9bKrYUXY4DwkCygHDKmQmyqUh
 
-perl .\ch-2.pl -d "gFv4ujqOyIPdTk5I9bKrYUXY4DwkCtV27vpk9"
-a quick brown fox jumps over lazy dog
+perl .\ch-2.pl -d "gFv4ujqOyIPdTk5I9bKrYUXY4DwkCygHDKmQmyqUh"
+a quick brown fox jumps over the lazy dog
 =cut
diff --git a/challenge-025/yet-ebreo/perl6/ch-1.p6 b/challenge-025/yet-ebreo/perl6/ch-1.p6
new file mode 100644
index 0000000000..1832bc8cf8
--- /dev/null
+++ b/challenge-025/yet-ebreo/perl6/ch-1.p6
@@ -0,0 +1,64 @@
+# Generate a longest sequence of the following English Pokeman names where 
+# each name starts with the last letter of previous name.
+#     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
+my Str @names = <bagon audino 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>;
+my Array @chain;
+my %hash = ();
+my int $max_length = 0;
+sub MAIN {    
+    for '0'..'z' -> $n {
+        %hash{$n} = @names.grep(/^$n/);
+    }
+    
+    for @names -> $name {
+        my Str $m_name_chain = "";
+        iter($name, $m_name_chain, %hash{$name.substr(*-1)}.Seq );
+    }
+  
+    say "Sequence:";
+    for @chain[*-1] -> @r {
+        for @r -> $e {
+            say "$e\n";
+        }
+    }
+    say "Highest chain count: "~@chain.end;
+    say "Number of Sequence found: "~(1+@chain[*-1].end);
+    say "Run Time: "~(now - INIT now)~" sec";
+}
+
+sub iter {
+    my (Str $m_name, Str $m_name_chain, Str @m_name_list) = @_;
+    $m_name_chain ~= "> $m_name ";
+    for @m_name_list -> $name {
+        if (!$m_name_chain.contains($name)) {
+            iter($name, $m_name_chain, %hash{$name.substr(*-1)}.Seq);
+        }
+    }
+    if (!@m_name_list.end) {
+        my int $length = +$m_name_chain.comb: ">";
+        if ($length >= $max_length) {
+            @chain[$length].push($m_name_chain);
+            $max_length = $length;
+        }
+    }
+}
+
+# #Sample output
+# Sequence:
+# > machamp > petilil > landorus > scrafty > yamask > kricketune > emboar > registeel > loudred > darmanitan > nosepass > simisear > relicanth > heatmor > rufflet > trapinch > haxorus > seaking > girafarig > gabite > exeggcute > emolga > audino
+# ..
+# > machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > registeel > landorus > simisear > relicanth > haxorus > seaking > girafarig > gabite > emolga > audino
+
+# > machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > relicanth > haxorus > simisear > registeel > landorus > seaking > girafarig > gabite > emolga > audino
+# Highest chain count: 23
+# Number of Sequence found: 1248
+# Run Time: 319.97691637 sec
+
+# #Note(s):
+# - It took 320 seconds to complete!
+# - I am a perl6 newbie, I hope somebody can tell me why perl6 is taking a lot longer vs my perl5 version (< 10 sec)
diff --git a/challenge-025/yet-ebreo/perl6/ch-2.p6 b/challenge-025/yet-ebreo/perl6/ch-2.p6
new file mode 100644
index 0000000000..7328b41800
--- /dev/null
+++ b/challenge-025/yet-ebreo/perl6/ch-2.p6
@@ -0,0 +1,53 @@
+#It should be okay to modify the zenith/nadir (0 to $wheelsize)
+constant $ZENITH = 0;
+constant $NADIR  = 13;
+
+#Initialize  wheels (chaocipher with bigger wheels!)
+my @pt = "7bqkj9l2hOWyzA8SLPEtRvBwUQVmxa45g ufspeTF1KHd0DrGMCZoJXi3YIN6nc".split('',:skip-empty);
+my @ct = "vEDclCHZYeWo9drb6Jnkf5MRXOt UgN4Fi231GzQIx7sPaLK8TBuVpA0yjShqwm".split('',:skip-empty);
+
+sub MAIN (
+    $encrypt,   #= Use e to encrypt $string, d to decrypt
+    $string     #= String enclosed with ""
+)
+{
+    my $enc = $encrypt eq 'e';
+    my $ret = "";
+    for $string.split('',:skip-empty) -> $c {
+        #find where $c is in the plain text @pt (or @ct when decrypting)
+        my $pos = $enc ?? @pt.first($c, :k) !!  @ct.first($c, :k);
+
+        #Get the character from the cipher text in that position($pos)
+        $ret ~= $enc ?? @ct[$pos] !! @pt[$pos];
+
+        #rotate @pt and @ct from $pos to ZENITH
+        rot($pos-$ZENITH, @pt);
+        rot($pos-$ZENITH, @ct);
+
+        #permute @ct: move the char in ZENITH + 1 to NADIR
+        rot(1,@ct,$ZENITH+1,$NADIR);
+
+        #permute @pt: rotate1 then move the char in ZENITH + 2 to NADIR
+        rot(1,@pt);
+        rot(1,@pt,$ZENITH+2,$NADIR);
+    }
+    say $ret;
+}
+# This function rotates the given array or a portion of the given array 
+# Rotation count is defined by $r
+# The whole array will be rotated by default
+# but the range can be specified in $from and $to variable
+# Perl6 has .rotate method that's awesome!
+sub rot ($rcount, @arr, $from?, $to?) {
+    if (!(defined $to && defined $from)) {
+        @arr = @arr.rotate($rcount);
+    } else {
+        my $r = ($rcount + $from) % (@arr.end()+1);
+        @arr  = (@arr[0..$from-1],@arr[$from..$to].rotate($rcount),@arr[$to+1..@arr.end]).flat;
+    }
+}
+# perl6 .\ch-2.p6 e "a quick brown fox jumps over the lazy dog"
+# gFv4ujqOyIPdTk5I9bKrYUXY4DwkCygHDKmQmyqUh
+
+# perl6 .\ch-2.p6 d "gFv4ujqOyIPdTk5I9bKrYUXY4DwkCygHDKmQmyqUh"
+# a quick brown fox jumps over the lazy dog