Merge pull request #3210 from mimosinnet/branch-for-challenge-094

Mimosinnet raku solution

2 files changed, 183 insertions, 0 deletions

diff --git a/challenge-094/mimosinnet/raku/ch-1.raku b/challenge-094/mimosinnet/raku/ch-1.raku
new file mode 100644
index 0000000000..613efaf71a
--- /dev/null
+++ b/challenge-094/mimosinnet/raku/ch-1.raku
@@ -0,0 +1,87 @@
+=begin comment
+Perl Weekly Challenge-094-1 
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-094/
+
+You are given an array of strings @S.
+
+Write a script to group Anagrams together in any random order.
+
+An Anagram is a word or phrase formed by rearranging the letters of a different word or phrase, typically using all the original letters exactly once.
+
+    Input:  ("opt", "bat", "saw", "tab", "pot", "top", "was")
+    Output: [ ("bat", "tab"),
+              ("saw", "was"),
+              ("top", "pot", "opt") ]
+
+    Input:  ("x")
+    Output: [ ("x" ]
+
+
+Write a script to count maximum points on a straight line when given co-ordinates plotted on 2-d plane.
+
+=end comment
+
+#| Class to store groups of anagrams
+class Group {
+  has SetHash $.anagram = ().SetHash;
+
+  method equal( $new_anagram ) {
+    return True if $.anagram.pick.split('').sort ~~ $new_anagram.split('').sort;
+  }
+
+  method add( $new_anagram ) {
+    $.anagram.set($new_anagram);
+  }
+
+}
+
+sub challenge( @anagrams ) {
+
+  my @result;
+
+  # Recursive function thtat finds similar anagrams
+  sub anagram( @anagrams ) {
+    return @anagrams if @anagrams.elems lt 1;
+    my $group = Group.new;
+    $group.add( @anagrams.shift );
+    my @index;
+    for @anagrams -> $anagram {
+      # Identify anagrams that are in $group
+      @index.push: @anagrams.first($anagram, :k) if $group.equal($anagram);
+      # add anagram to $group and remove it from @anagrams
+      @index.map: { $group.add: @anagrams.splice($_,1) };
+    }
+    # add group of anagrams to @result
+    @result.push: $group.anagram.keys.Set; 
+    anagram( @anagrams );
+  }
+  anagram( @anagrams ); 
+  return @result;
+}
+
+multi sub MAIN( @example ) {
+  say "Input:  " ~ @example.raku;
+  say 'Output: ' ~ challenge(@example).raku;
+}
+
+multi sub MAIN( 'challenge' ) {
+  my @examples = ("opt", "bat", "saw", "tab", "pot", "top", "was").Array, ("x").Array;
+  @examples.map: { MAIN($_) };
+}
+
+multi sub MAIN( 'test' ) {
+  use Test;
+  
+  my @example1 = 
+    ("opt", "bat", "saw", "tab", "pot", "top", "was").Array, 
+    [ ("bat", "tab").Set, ("saw", "was").Set, ("top", "pot", "opt").Set ].Set
+  ;
+  my @example2 = 
+    ("x").Array,
+    [ ("x").Set ].Set;
+  ;
+
+  my @tests = @example1, @example2;
+  @tests.map: { cmp-ok challenge($_[0]), '~~', $_[1] }
+
+}
diff --git a/challenge-094/mimosinnet/raku/ch-2.raku b/challenge-094/mimosinnet/raku/ch-2.raku
new file mode 100644
index 0000000000..c09e71c439
--- /dev/null
+++ b/challenge-094/mimosinnet/raku/ch-2.raku
@@ -0,0 +1,96 @@
+=begin comment
+Perl Weekly Challenge 094-2 
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-094/
+
+You are given a binary tree.
+
+Write a script to represent the given binary tree as an object and flatten it to a linked list object. Finally print the linked list object.
+
+    Input:
+
+        1
+       / \
+      2   3
+     / \
+    4   5
+       / \
+      6   7
+
+    Output:
+
+        1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3
+
+There are different forms of coding the tree. One way is to scan the elmeents using level order, with 0 when the node is not defined, and last zeros not recorded. That will give this representation: 
+
+a) Tree representation: 1 2 3 4 5 0 0 0 0 0 6 7 0 0 0 0
+
+Another approach is to start coding the left of the tree, and continue to the rifht when there are no more left-nodes, with a zero when the node is not define. This will give:
+
+b) Tree representation: 1 2 4 0 0 5 6 7 3
+
+I have unsuccessfull tried to solve the exercise with representation (a). With (b) the solution seems easier, but I nevetheless had to use Luca Ferrary Class definition of Node. 
+
+=end comment
+
+#! Using Luca Ferrary's definition of Class Node
+class Node {
+
+  has Int   $.value;  
+  has Node  $.left  is rw;
+  has Node  $.right is rw;
+
+
+  method add-left( $value ) {
+    $.left = Node.new( value => $value );
+  }
+
+  method add-right( $value ) {
+    $.right = Node.new( value => $value );
+  }
+
+  method tree-flat() {
+    my @tree = self.node-value;
+    @tree.push: $!left.tree-flat  if $!left;
+    @tree.push: $!right.tree-flat if $!right;
+    @tree;
+  }
+
+  method node-value() { self.value; }
+}
+
+#| recursive definition of the tree
+sub challenge( @tree ) {
+  my $node = Node.new( value => @tree.shift);
+  my $pos  = 1; 
+
+  sub add_node( $new_node ) {
+    $pos++;
+    return $new_node unless @tree.elems;
+    my $value = @tree.shift;
+    $pos %% 2
+      ?? add_node( $new_node.add-left($value)  )
+      !! add_node( $new_node.add-right($value) );
+  }
+ 
+  add_node( $node );
+  # Remove empty nodes and add ' -> '
+  return $node.tree-flat().Str.subst( /0 \s+/, '', :g).subst( /\s/, ' -> ', :g);
+}
+
+multi sub MAIN( @tree ) {
+  say 'Input:  ' ~ @tree;
+  say 'Output: ' ~ challenge( @tree );
+}
+
+multi sub MAIN( 'challenge' ) {
+ MAIN( <  1 2 4 0 0 5 6 7 3 >.Array);
+}
+
+multi sub MAIN( 'test' ) {
+  use Test;
+ 
+  is(
+    challenge(< 1 2 4 0 0 5 6 7 3 >.Array),
+    '1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3',
+  )
+}