Add solution 307

Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>

4 files changed, 154 insertions, 0 deletions

diff --git a/challenge-307/jeanluc2020/blog-1.txt b/challenge-307/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..9132caa1d0
--- /dev/null
+++ b/challenge-307/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-307-1.html
diff --git a/challenge-307/jeanluc2020/blog-2.txt b/challenge-307/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..bc0d1dce3d
--- /dev/null
+++ b/challenge-307/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-307-2.html
diff --git a/challenge-307/jeanluc2020/perl/ch-1.pl b/challenge-307/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..73bb81a019
--- /dev/null
+++ b/challenge-307/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-307/#TASK1
+#
+# Task 1: Check Order
+# ===================
+#
+# You are given an array of integers, @ints.
+#
+# Write a script to re-arrange the given array in an increasing order and
+# return the indices where it differs from the original array.
+#
+## Example 1
+##
+## Input: @ints = (5, 2, 4, 3, 1)
+## Output: (0, 2, 3, 4)
+##
+## Before: (5, 2, 4, 3, 1)
+## After : (1, 2, 3, 4, 5)
+##
+## Difference at indices: (0, 2, 3, 4)
+#
+## Example 2
+##
+## Input: @ints = (1, 2, 1, 1, 3)
+## Output: (1, 3)
+##
+## Before: (1, 2, 1, 1, 3)
+## After : (1, 1, 1, 2, 3)
+##
+## Difference at indices: (1, 3)
+#
+## Example 3
+##
+## Input: @ints = (3, 1, 3, 2, 3)
+## Output: (0, 1, 3)
+##
+## Before: (3, 1, 3, 2, 3)
+## After : (1, 2, 3, 3, 3)
+##
+## Difference at indices: (0, 1, 3)
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# Create the sorted array, then comapre the two arrays by index.
+# Remember all positions where the two arrays differ.
+
+use v5.36;
+
+check_order(5, 2, 4, 3, 1);
+check_order(1, 2, 1, 1, 3);
+check_order(3, 1, 3, 2, 3);
+
+sub check_order {
+   my @ints = @_;
+   say "Input: (" . join(", ", @ints) . ")";
+   my @sorted = sort {$a<=>$b} @ints;
+   my @result = ();
+   foreach my $i (0..$#ints) {
+      push @result, $i if $ints[$i] != $sorted[$i];
+   }
+   say "Output: (" . join(", ", @result) . ")";
+}
diff --git a/challenge-307/jeanluc2020/perl/ch-2.pl b/challenge-307/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..ec9e8500ca
--- /dev/null
+++ b/challenge-307/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-307/#TASK2
+#
+# Find Anagrams
+# =============
+#
+# You are given a list of words, @words.
+#
+# Write a script to find any two consecutive words and if they are anagrams,
+# drop the first word and keep the second. You continue this until there is no
+# more anagrams in the given list and return the count of final list.
+#
+## Example 1
+##
+## Input: @words = ("acca", "dog", "god", "perl", "repl")
+## Output: 3
+##
+## Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god"
+##         => ("acca", "god", "perl", "repl")
+## Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl"
+##         => ("acca", "god", "repl")
+#
+## Example 2
+##
+## Input: @words = ("abba", "baba", "aabb", "ab", "ab")
+## Output: 2
+##
+## Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba"
+##         => ("baba", "aabb", "ab", "ab")
+## Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb"
+##         => ("aabb", "ab", "ab")
+## Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab"
+##         => ("aabb", "ab")
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# As long as the length of the array keeps changing, check if two consecutive
+# words are anagrams. If so, remove the first word and continue. Once the
+# length of the array no longer changes, we can output the length.
+
+use v5.36;
+
+find_anagrams("acca", "dog", "god", "perl", "repl");
+find_anagrams("abba", "baba", "aabb", "ab", "ab");
+
+sub find_anagrams (@words) {
+   say "Input: (" . join(", ", @words) . ")";
+   my $len = scalar(@words);
+   my $oldlen = 1 + $len;
+   while($oldlen != $len) {
+      my @tmp = ();
+      foreach my $i (0..$#words) {
+         if(is_anagram($words[$i], $words[$i+1])) {
+            push @tmp, @words[$i+1..$#words];
+            last;
+         } else {
+            push @tmp, $words[$i];
+         }
+      }
+      @words = @tmp;
+      $oldlen = $len;
+      $len = scalar(@words);
+   }
+   say "Output: $len";
+}
+
+sub is_anagram($word1, $word2) {
+   my $w1;
+   my $w2;
+   return 0 unless defined $word2;
+   return 0 if length($word1) != length($word2);
+   foreach my $c (split//,$word1) {
+      $w1->{$c}++;
+   }
+   foreach my $c (split//,$word2) {
+      $w2->{$c}++;
+   }
+   foreach my $c (keys %$w1) {
+      return 0 if $w1->{$c} != $w2->{$c};
+   }
+   return 1;
+}