- Added solutions by Arne Sommer.

8 files changed, 240 insertions, 0 deletions

diff --git a/challenge-007/arne-sommer/blog.txt b/challenge-007/arne-sommer/blog.txt
new file mode 100644
index 0000000000..ebdfe7e194
--- /dev/null
+++ b/challenge-007/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://perl6.eu/niven-ladder.html
diff --git a/challenge-007/arne-sommer/perl6/ch-1.p6 b/challenge-007/arne-sommer/perl6/ch-1.p6
new file mode 100755
index 0000000000..0f6f338791
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/ch-1.p6
@@ -0,0 +1,3 @@
+#! /usr/bin/env perl6
+
+.say if $_ %% $_.comb.sum for 0 .. 50;
diff --git a/challenge-007/arne-sommer/perl6/ch-2.p6 b/challenge-007/arne-sommer/perl6/ch-2.p6
new file mode 100755
index 0000000000..f48525a626
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/ch-2.p6
@@ -0,0 +1,99 @@
+#! /usr/bin/env perl6
+
+multi sub MAIN ($first, $second, *@wordlist, :$all)
+{
+  say-output(find_shortest_ladder($first, $second, @wordlist, $all));
+}
+
+multi sub MAIN ($first, $second, $dictionary where $dictionary.IO && $dictionary.IO.r, :$all)
+{
+  return unless $first.chars == $second.chars;
+  
+  my @wordlist = load-dictionary($dictionary, $first.chars);
+    # Only load the words with the correct length.
+  
+  sub load-dictionary ($file where $file.IO && $file.IO.r, $word-length)
+  {
+    return $file.IO.lines.grep({ .chars == $word-length }).lc.words;
+  }
+  
+  say-output(find_shortest_ladder($first, $second, @wordlist, $all));
+}
+
+sub say-output(@list)
+{
+  for (@list) -> $curr
+  {
+    say '("', $curr.split(";").join('","'), '")';
+  }
+}
+
+sub find_shortest_ladder ($word1, $word2, @wordlist, $show-all)
+{
+  my Set $dict := @wordlist.Set;
+  my @letters = @wordlist.comb.unique.grep({ /<:L>/ });
+
+  return unless $dict{$word1};
+  return unless $dict{$word2};
+  return unless $word1.chars == $word2.chars;
+  return unless all(@wordlist>>.chars) == $word1.chars;
+
+  my @solutions;
+  my $solution-found = False;
+  my $solution-found-size = 0;
+  
+  my @deferred = ($word1);
+
+  loop
+  {
+    my $current = @deferred.shift // last;
+    
+    check-path($current, $word2);
+
+    last if $solution-found && !$show-all;
+  }
+  
+  sub check-path($path, $stop)
+  {
+    my @path = $path.split(";");
+    my $seen = @path.Set;
+    
+    if $solution-found
+    {
+      return if $solution-found-size == @path.elems;
+    }
+
+    my $current = @path[*-1];
+
+    my $next-word := gather
+    {
+      for ^$current.chars -> $index
+      {
+        my $next = $current;
+        for @letters -> $letter
+        {
+          $next.substr-rw($index, 1) = $letter;
+          next if $current eq $next;
+          take $next if $dict{$next};
+        }
+      }
+    }
+
+    for $next-word -> $candidate
+    {    
+      next if $seen{$candidate};
+
+      if $candidate eq $stop
+      {
+        @solutions.push("$path;$candidate");
+	$solution-found = True;
+        $solution-found-size = @path.elems + 1;
+      }
+      else
+      {
+        @deferred.push("$path;$candidate");
+      }
+    }
+  }
+  return @solutions;
+}
diff --git a/challenge-007/arne-sommer/perl6/niven-gather b/challenge-007/arne-sommer/perl6/niven-gather
new file mode 100755
index 0000000000..b966c16dbe
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/niven-gather
@@ -0,0 +1,13 @@
+#! /usr/bin/env perl6
+
+unit sub MAIN (Int $limit where $limit > 0 = 50);
+
+my $niven := gather
+{
+  for 0..Inf
+  {
+    take $_ if $_ %% $_.comb.sum;
+  }
+}
+
+.say for $niven[^$limit];
diff --git a/challenge-007/arne-sommer/perl6/niven-long b/challenge-007/arne-sommer/perl6/niven-long
new file mode 100755
index 0000000000..f60dc185ca
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/niven-long
@@ -0,0 +1,9 @@
+#! /usr/bin/env perl6
+
+for 0 .. 50
+{
+  if $_ %% $_.comb.sum
+  {
+    .say;
+  }
+}
diff --git a/challenge-007/arne-sommer/perl6/niven-main b/challenge-007/arne-sommer/perl6/niven-main
new file mode 100755
index 0000000000..b1f67a71b0
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/niven-main
@@ -0,0 +1,5 @@
+#! /usr/bin/env perl6
+
+unit sub MAIN (Int $limit where $limit > 0 = 50);
+
+.say if $_ %% $_.comb.sum for 0 .. $limit;
diff --git a/challenge-007/arne-sommer/perl6/word-ladder-dummy b/challenge-007/arne-sommer/perl6/word-ladder-dummy
new file mode 100755
index 0000000000..e0523ec969
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/word-ladder-dummy
@@ -0,0 +1,34 @@
+#! /usr/bin/env perl6
+
+multi sub MAIN ($first, $second, *@wordlist)
+{
+  say-output(find_shortest_ladder($first, $second, @wordlist));
+}
+
+multi sub MAIN ($first, $second, $dictionary where $dictionary.IO && $dictionary.IO.r)
+{
+  return unless $first.chars == $second.chars;
+  
+  my @wordlist = load-dictionary($dictionary, $first.chars);
+    # Only load the words with the correct length.
+
+  say-output(find_shortest_ladder($first, $second, @wordlist));
+  
+  sub load-dictionary ($file where $file.IO && $file.IO.r, $word-length)
+  {
+    return $file.IO.lines.grep({ .chars == $word-length });
+  }
+}
+
+sub say-output(@list)
+{
+  for (@list) -> $curr
+  {
+    say $curr;
+  }
+}
+
+sub find_shortest_ladder ($word1, $word2, @wordlist)
+{
+  return ("W1: $word1", "W2: $word2", "D: @wordlist[]");
+}
diff --git a/challenge-007/arne-sommer/perl6/word-ladder-recursive b/challenge-007/arne-sommer/perl6/word-ladder-recursive
new file mode 100755
index 0000000000..0bd1eedfec
--- /dev/null
+++ b/challenge-007/arne-sommer/perl6/word-ladder-recursive
@@ -0,0 +1,76 @@
+#! /usr/bin/env perl6
+
+multi sub MAIN ($first, $second, *@wordlist)
+{
+  find_shortest_ladder($first, $second, @wordlist);
+}
+
+multi sub MAIN ($first, $second, $dictionary where $dictionary.IO && $dictionary.IO.r)
+{
+  return unless $first.chars == $second.chars;
+  
+  my @wordlist = load-dictionary($dictionary, $first.chars);
+    # Only load the words with the correct length.
+
+  find_shortest_ladder($first, $second, @wordlist);
+  
+  sub load-dictionary ($file where $file.IO && $file.IO.r, $word-length)
+  {
+    return $file.IO.lines.grep({ .chars == $word-length });
+  }
+}
+
+sub find_shortest_ladder ($word1, $word2, @wordlist)
+{
+  constant @letters := "a" .. "z";
+  my %next;
+  my Set $dict = @wordlist.Set;
+
+  return unless $dict{$word1};
+  return unless $dict{$word2};
+  return unless $word1.chars == $word2.chars;
+  return unless all(@wordlist>>.chars) == $word1.chars;
+
+  check-word($_) for @wordlist;
+
+  sub check-word ($word)
+  { 
+    for ^$word.chars -> $index
+    {
+      my $next = $word;
+      for @letters -> $letter
+      {
+        $next.substr-rw($index,1) = $letter;
+        next if $word eq $next;
+        %next{$word}.push($next) if $dict{$next};
+      }
+    }
+  }
+ 
+  check-path($word1, $word2, List.new, Hash.new);
+
+  sub check-path($start, $stop, @path is copy, %seen is copy )
+  {
+    %seen{$start} = True;
+    @path.push: $start;
+    for @(%next{$start}) -> $candidate
+    {
+      next if %seen{$candidate};
+      
+      if $candidate eq $stop
+      {
+        say-output(@path.push: $candidate);
+	last;
+      }
+      else
+      {
+        check-path($candidate, $stop, @path, %seen) unless %seen{$candidate};
+      }
+    }
+  }
+}
+
+sub say-output (@path)
+{
+  say '("', @path.join('","'), '")';
+}