Merge pull request #2222 from arnesom/new-branch

076

8 files changed, 456 insertions, 0 deletions

diff --git a/challenge-076/arne-sommer/blog.txt b/challenge-076/arne-sommer/blog.txt
new file mode 100644
index 0000000000..6e01a0a2e2
--- /dev/null
+++ b/challenge-076/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/primal-words.html
diff --git a/challenge-076/arne-sommer/raku/ch-1.p6 b/challenge-076/arne-sommer/raku/ch-1.p6
new file mode 100755
index 0000000000..9e5dc105f4
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/ch-1.p6
@@ -0,0 +1,77 @@
+#! /usr/bin/env raku
+
+subset IntTwo of Int where * >= 2;
+
+unit sub MAIN (IntTwo $N, :a(:$all), :l(:$loquacious), :v(:$verbose) = $loquacious || $all, :u(:$upto), :f(:$first));
+
+$upto
+  ?? (2..$N).map({ primal-decomposition($_) })
+  !! primal-decomposition($N);
+
+my $input;
+my $shortest;
+my @result;
+
+sub primal-decomposition ($N)
+{
+  $input = $N;
+  
+  my @primes = (2 .. $input).grep( *.is-prime ).reverse;
+
+  say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
+
+  @result   = ();
+  $shortest = Inf;
+
+  recurse(0, (), @primes, $input);
+
+  if $verbose
+  {
+    for @result -> @array
+    {
+      say ": Result: [{ @array.join(", ") }]";
+    }
+  }
+  say $upto
+    ?? "$N -> { @result[0].elems }"
+    !! @result[0].elems;
+}
+
+sub recurse ($value is copy, @values is copy, @primes is copy, $input)
+{
+  return if @values.elems > $shortest && ! $all;
+
+  return if @values.elems == $shortest && $first;
+
+  if $value < $input
+  {  
+    while @primes
+    {
+      my $add = @primes[0];
+      
+      if $value + $add <= $input
+      {  
+        my $value2  = $value + $add;
+	my @values2 = @values.clone.push: $add;
+        recurse($value2, @values2, @primes, $input);
+      }
+      @primes.shift;
+    }
+  }
+
+  elsif $value == $input
+  {
+    if @values.elems < $shortest
+    {
+      $shortest = @values.elems;
+      @result   = ();
+      say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+    else
+    {
+      say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+
+    @result.push: @values;
+  }
+}
diff --git a/challenge-076/arne-sommer/raku/ch-2.p6 b/challenge-076/arne-sommer/raku/ch-2.p6
new file mode 100755
index 0000000000..82fd57202b
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/ch-2.p6
@@ -0,0 +1,73 @@
+#! /usr/bin/env raku
+
+unit sub MAIN ($dict where $dict.IO.f && $dict.IO.r = '/usr/share/dict/british-english',
+               $grid where $grid.IO.f && $grid.IO.r = 'grid.txt',
+	       :m(:$min-length) = 1,
+	       :v(:$verbose));
+
+my @grid = $grid.IO.lines.map( *.lc.words.list );
+
+die "Uneven grid row length" unless [==] @(@grid)>>.elems;
+
+die "Single characters only in the grid" if @(@grid)>>.chars>>.max.max > 1;
+
+my %dict = get-dictionary($dict);
+my @candidates;
+
+my $rows = @grid.elems;
+my $cols = @grid[0].elems;
+
+for ^$rows -> $row
+{
+  for ^$cols -> $col
+  {
+    say ": [$row,$col]: @grid[$row][$col]" if $verbose;
+    @candidates.append: get-candidates($row, $col);
+  }
+}
+
+my @words = @candidates.unique.sort.grep({ %dict{$_} }).grep( *.chars >= $min-length);
+
+say "Found {@words.elems} words of length $min-length or more: { @words.join(', ') }";
+
+sub get-candidates ($row, $col)
+{
+  my @candidates = @grid[$row][$col],;
+
+  for (-1, 0, 1) -> $r
+  {
+    for (-1, 0, 1) -> $c
+    {
+      say ": Pos $r, $c" if $verbose;
+
+      @candidates.append: do-get-candidates($row, $col, $r, $c) unless $r == $c == 0;
+    }
+  }
+  return @candidates;
+}
+
+sub do-get-candidates ($row is copy, $col is copy, $r, $c)
+{
+  my $current = @grid[$row][$col];
+
+  my @candidates;
+
+  loop
+  { 
+    $row += $r;
+    $col += $c;
+
+    last unless @grid[$row][$col].defined;
+    
+    $current ~= @grid[$row][$col];
+    @candidates.push: $current;
+  }
+
+  return @candidates;
+}
+
+sub get-dictionary ($file where $file.IO.r)
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set;
+}
+
diff --git a/challenge-076/arne-sommer/raku/grid.txt b/challenge-076/arne-sommer/raku/grid.txt
new file mode 100644
index 0000000000..31cf2e0fd8
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/grid.txt
@@ -0,0 +1,19 @@
+B I D E M I A T S U C C O R S T
+L D E G G I W Q H O D E E H D P
+U S E I R U B U T E A S L A G U
+N G N I Z I L A I C O S C N U D
+T G M I D S T S A R A R E I F G
+S R E N M D C H A S I V E E L I
+S C S H A E U E B R O A D M T E
+H W O V L P E D D L A I U L S S
+R Y O N L A S F C S T A O G O T
+I G U S S R R U G O V A R Y O C
+N R G P A T N A N G I L A M O O
+E I H A C E I V I R U S E S E D
+S E T S U D T T G A R L I C N H
+H V R M X L W I U M S N S O T B
+A E A O F I L C H T O D C A E U
+Z S C D F E C A A I I R L N R F
+A R I I A N Y U T O O O U T P F
+R S E C I S N A B O S C N E R A
+D R S M P C U U N E L T E S I L
diff --git a/challenge-076/arne-sommer/raku/prime-sum b/challenge-076/arne-sommer/raku/prime-sum
new file mode 100755
index 0000000000..c32144447e
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/prime-sum
@@ -0,0 +1,61 @@
+#! /usr/bin/env raku
+
+subset IntTwo of Int where * >= 2;
+
+unit sub MAIN (IntTwo $N, :a(:$all), :l(:$loquacious), :v(:$verbose) = $loquacious || $all);
+
+my @primes = (2 .. $N).grep( *.is-prime ).reverse;
+
+say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
+
+my @result;
+my $shortest = Inf;
+
+recurse(0, (), @primes);
+
+sub recurse ($value is copy, @values is copy, @primes is copy)
+{
+  return if @values.elems > $shortest && ! $all;
+
+  if $value < $N
+  {  
+    while @primes
+    {
+      my $add = @primes[0];
+      
+      if $value + $add <= $N
+      {  
+        my $value2  = $value + $add;
+	my @values2 = @values.clone.push: $add;
+        recurse($value2, @values2, @primes);
+      }
+      @primes.shift;
+    }
+  }
+
+  elsif $value == $N
+  {
+    if @values.elems < $shortest
+    {
+      $shortest = @values.elems;
+      @result   = ();
+      say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+    else
+    {
+      say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+
+    @result.push: @values;
+  }
+}
+
+if $verbose
+{
+  for @result -> @array
+  {
+    say ": Result: [{ @array.join(", ") }]";
+  }
+}
+
+say @result[0].elems // "";
diff --git a/challenge-076/arne-sommer/raku/prime-sum-faster b/challenge-076/arne-sommer/raku/prime-sum-faster
new file mode 100755
index 0000000000..9e5dc105f4
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/prime-sum-faster
@@ -0,0 +1,77 @@
+#! /usr/bin/env raku
+
+subset IntTwo of Int where * >= 2;
+
+unit sub MAIN (IntTwo $N, :a(:$all), :l(:$loquacious), :v(:$verbose) = $loquacious || $all, :u(:$upto), :f(:$first));
+
+$upto
+  ?? (2..$N).map({ primal-decomposition($_) })
+  !! primal-decomposition($N);
+
+my $input;
+my $shortest;
+my @result;
+
+sub primal-decomposition ($N)
+{
+  $input = $N;
+  
+  my @primes = (2 .. $input).grep( *.is-prime ).reverse;
+
+  say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
+
+  @result   = ();
+  $shortest = Inf;
+
+  recurse(0, (), @primes, $input);
+
+  if $verbose
+  {
+    for @result -> @array
+    {
+      say ": Result: [{ @array.join(", ") }]";
+    }
+  }
+  say $upto
+    ?? "$N -> { @result[0].elems }"
+    !! @result[0].elems;
+}
+
+sub recurse ($value is copy, @values is copy, @primes is copy, $input)
+{
+  return if @values.elems > $shortest && ! $all;
+
+  return if @values.elems == $shortest && $first;
+
+  if $value < $input
+  {  
+    while @primes
+    {
+      my $add = @primes[0];
+      
+      if $value + $add <= $input
+      {  
+        my $value2  = $value + $add;
+	my @values2 = @values.clone.push: $add;
+        recurse($value2, @values2, @primes, $input);
+      }
+      @primes.shift;
+    }
+  }
+
+  elsif $value == $input
+  {
+    if @values.elems < $shortest
+    {
+      $shortest = @values.elems;
+      @result   = ();
+      say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+    else
+    {
+      say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+
+    @result.push: @values;
+  }
+}
diff --git a/challenge-076/arne-sommer/raku/prime-sum-upto b/challenge-076/arne-sommer/raku/prime-sum-upto
new file mode 100755
index 0000000000..058fd05e1d
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/prime-sum-upto
@@ -0,0 +1,75 @@
+#! /usr/bin/env raku
+
+subset IntTwo of Int where * >= 2;
+
+unit sub MAIN (IntTwo $N, :a(:$all), :l(:$loquacious), :v(:$verbose) = $loquacious || $all, :u(:$upto));
+
+$upto
+  ?? (2..$N).map({ primal-decomposition($_) })
+  !! primal-decomposition($N);
+
+my $input;
+my $shortest;
+my @result;
+
+sub primal-decomposition ($N)
+{
+  $input = $N;
+  
+  my @primes = (2 .. $input).grep( *.is-prime ).reverse;
+
+  say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
+
+  @result   = ();
+  $shortest = Inf;
+
+  recurse(0, (), @primes, $input);
+
+  if $verbose
+  {
+    for @result -> @array
+    {
+      say ": Result: [{ @array.join(", ") }]";
+    }
+  }
+  say $upto
+    ?? "$N -> { @result[0].elems }"
+    !! @result[0].elems;
+}
+
+sub recurse ($value is copy, @values is copy, @primes is copy, $input)
+{
+  return if @values.elems > $shortest && ! $all;
+
+  if $value < $input
+  {  
+    while @primes
+    {
+      my $add = @primes[0];
+      
+      if $value + $add <= $input
+      {  
+        my $value2  = $value + $add;
+	my @values2 = @values.clone.push: $add;
+        recurse($value2, @values2, @primes, $input);
+      }
+      @primes.shift;
+    }
+  }
+
+  elsif $value == $input
+  {
+    if @values.elems < $shortest
+    {
+      $shortest = @values.elems;
+      @result   = ();
+      say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+    else
+    {
+      say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
+    }
+
+    @result.push: @values;
+  }
+}
diff --git a/challenge-076/arne-sommer/raku/word-search b/challenge-076/arne-sommer/raku/word-search
new file mode 100755
index 0000000000..82fd57202b
--- /dev/null
+++ b/challenge-076/arne-sommer/raku/word-search
@@ -0,0 +1,73 @@
+#! /usr/bin/env raku
+
+unit sub MAIN ($dict where $dict.IO.f && $dict.IO.r = '/usr/share/dict/british-english',
+               $grid where $grid.IO.f && $grid.IO.r = 'grid.txt',
+	       :m(:$min-length) = 1,
+	       :v(:$verbose));
+
+my @grid = $grid.IO.lines.map( *.lc.words.list );
+
+die "Uneven grid row length" unless [==] @(@grid)>>.elems;
+
+die "Single characters only in the grid" if @(@grid)>>.chars>>.max.max > 1;
+
+my %dict = get-dictionary($dict);
+my @candidates;
+
+my $rows = @grid.elems;
+my $cols = @grid[0].elems;
+
+for ^$rows -> $row
+{
+  for ^$cols -> $col
+  {
+    say ": [$row,$col]: @grid[$row][$col]" if $verbose;
+    @candidates.append: get-candidates($row, $col);
+  }
+}
+
+my @words = @candidates.unique.sort.grep({ %dict{$_} }).grep( *.chars >= $min-length);
+
+say "Found {@words.elems} words of length $min-length or more: { @words.join(', ') }";
+
+sub get-candidates ($row, $col)
+{
+  my @candidates = @grid[$row][$col],;
+
+  for (-1, 0, 1) -> $r
+  {
+    for (-1, 0, 1) -> $c
+    {
+      say ": Pos $r, $c" if $verbose;
+
+      @candidates.append: do-get-candidates($row, $col, $r, $c) unless $r == $c == 0;
+    }
+  }
+  return @candidates;
+}
+
+sub do-get-candidates ($row is copy, $col is copy, $r, $c)
+{
+  my $current = @grid[$row][$col];
+
+  my @candidates;
+
+  loop
+  { 
+    $row += $r;
+    $col += $c;
+
+    last unless @grid[$row][$col].defined;
+    
+    $current ~= @grid[$row][$col];
+    @candidates.push: $current;
+  }
+
+  return @candidates;
+}
+
+sub get-dictionary ($file where $file.IO.r)
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set;
+}
+