Merge pull request #414 from threadless-screw/threadless-screw-wk18ch2p6

Threadless screw wk18ch2p6

2 files changed, 45 insertions, 0 deletions

diff --git a/challenge-018/ozzy/perl6/ch-2b.p6 b/challenge-018/ozzy/perl6/ch-2b.p6
new file mode 100644
index 0000000000..45fa31e654
--- /dev/null
+++ b/challenge-018/ozzy/perl6/ch-2b.p6
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl6
+# Find longest common substring(s) for 2+ cmdline specified strings.
+# Set+sort solution inspired by Rosetta code solution.
+
+sub MAIN (*@strings) {
+
+    if @strings.elems < 2 { say "Usage: cmd <string1> <string2> [stringx]..."; exit 1 }
+
+    my @substrings;
+    for 0..@strings.elems-1 -> $i {                                         #  $i = string index into @strings
+        my $l = @strings[$i].chars;                                         #  $l = string length
+        for 0..$l-1 -> $j {                                                 #  $j = start index into string
+            for $j..$l-1 -> $k {                                            #  $k = end index of string
+                @substrings[$i].push: @strings[$i].substr($j, ($k-$j+1));   #  Generate all substrings from string
+            }                                                               #+ in form of 2D-array; 1st dim. is string
+        }                                                                   #+ index, 2nd dim. is substring index.
+    }
+    my @cs = ([∩] @substrings).keys.sort({$^b.chars <=> $^a.chars});        #  Length-sorted intersection of substrings
+    if @cs.elems != 0 {
+        say "List of longest common substrings: ";                          #  Output lcs if we found any.
+        my $i=0; while @cs[$i].chars == @cs[0].chars { say @cs[$i++] };
+    } else {
+        say "No common substring found";
+    }
+}
diff --git a/perl6/ch-2a.p6 b/perl6/ch-2a.p6
new file mode 100644
index 0000000000..92f61119e1
--- /dev/null
+++ b/perl6/ch-2a.p6
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl6
+# Find single longest common substring for just 2 cmdline specified strings.
+# This was a first attempt; the low-level approach seems somewhat difficult to generalize to multiple lcs in 2+ strings.
+
+sub MAIN (Str $string1 , Str $string2) {
+
+    my @string1     = $string1.comb;
+    my @string2     = $string2.comb;
+    my ($l1, $l2)   = (@string1.elems, @string2.elems);
+    my ($x,$z)      = (0,0);                                # $x is lcs-index into @string1, $z is length of lcs
+
+    for 0..$l1-1 -> $i {
+        for 0..$l2-1 -> $j {
+            my $k=0; 
+            $k++ while ($i+$k < $l1) && ($j+$k < $l2) && (@string1[$i+$k] eq @string2[$j+$k]);
+            if $k > $z { ($x, $z) = ($i, $k) };
+        }
+    }
+    say "LCS  = { $string1.substr($x, $z) }";
+}