Merge pull request #1531 from fluca1978/pwc54

Pwc54

4 files changed, 96 insertions, 0 deletions

diff --git a/challenge-055/luca-ferrari/blog-1.txt b/challenge-055/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..32654af2ad
--- /dev/null
+++ b/challenge-055/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2020/04/06/PerlWeeklyChallenge55.html#task1
diff --git a/challenge-055/luca-ferrari/blog-2.txt b/challenge-055/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..d50f858738
--- /dev/null
+++ b/challenge-055/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2020/04/06/PerlWeeklyChallenge55.html#task2
diff --git a/challenge-055/luca-ferrari/raku/ch-1.p6 b/challenge-055/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..8a63de97a8
--- /dev/null
+++ b/challenge-055/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,49 @@
+#!env raku
+#
+# You are given a binary number B,
+# consisting of N binary digits 0 or 1: s0, s1, …, s(N-1).
+# Choose two indices L and R such that 0 ≤ L ≤ R < N
+# and flip the digits s(L), s(L+1), …, s(R).
+# By flipping, we mean change 0 to 1 and vice-versa.
+#
+# For example, given the binary number 010,
+# the possible flip pair results are listed below:
+#
+#    L=0, R=0 the result binary: 110
+#    L=0, R=1 the result binary: 100
+#    L=0, R=2 the result binary: 101
+#    L=1, R=1 the result binary: 000
+#    L=1, R=2 the result binary: 001
+#    L=2, R=2 the result binary: 011
+#
+# Write a script to find the indices (L,R)
+# that results in a binary number with maximum number of 1s.
+# If you find more than one maximal pair L,R then print all of them.
+# 
+# Continuing our example, note that we had three pairs
+# (L=0, R=0), (L=0, R=2), and (L=2, R=2) that resulted
+# in a binary number with two 1s, which was the maximum.
+# So we would print all three pairs.
+
+
+sub MAIN( Int:D $number where { $number.chars > 1 && $number ~~ / ^ <[01]>+ $ / } ) {
+    say "Number $number";
+
+    my @src = $number.comb;
+    my $N = @src.elems;
+
+    my $wanted =  $N - 1;
+    say "Searching for at least $wanted ones...";
+    
+    for 0 ..^ $N -> $L {
+        my @working = @src;
+        @working[ $L ] = @working[ $L ] == 1 ?? 0 !! 1;
+       
+        for $L  ..^ $N -> $R {
+            @working[ $R ] = @working[ $R ] == 1 ?? 0 !! 1 if ( $L != $R );
+            say "Found { @working } with L = $L and R = $R" if @working.grep(  * == 1  ).elems >= $wanted;
+        }
+        
+        
+    }
+}
diff --git a/challenge-055/luca-ferrari/raku/ch-2.p6 b/challenge-055/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..ab441c61b0
--- /dev/null
+++ b/challenge-055/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,45 @@
+#!env raku
+#
+#Wave Array
+#
+# Any array N of non-unique, unsorted integers can be arranged
+# into a wave-like array such that n1 ≥ n2 ≤ n3 ≥ n4 ≤ n5 and so on.
+#
+# For example, given the array [1, 2, 3, 4],
+# possible wave arrays include [2, 1, 4, 3] or [4, 1, 3, 2],
+# since 2 ≥ 1 ≤ 4 ≥ 3 and 4 ≥ 1 ≤ 3 ≥ 2. This is not a complete list.
+#
+# Write a script to print all possible wave arrays
+# for an integer array N of arbitrary length.
+#  Notes:
+#
+# When considering N of any length,
+# note that the first element is always greater
+# than or equal to the second, and then the ≤, ≥, ≤, …
+# sequence alternates until the end of the array.
+
+
+# Test if a single sequence is ok.
+# The third argument checks if the test has to be done as >= or <=.
+sub is-ok( Int:D $a, Int:D $b, Bool:D $greater ) {
+    return $a >= $b if ( $greater );
+    return $a <= $b if ( ! $greater );
+}
+
+
+sub MAIN( Int:D $number where { $number.chars > 1 } ){
+    my @array = $number.comb;
+
+    say "Waving { @array } of { @array.elems } elements ";
+    for @array.permutations -> @current {
+        my $ok = False;
+        my $test = True; # true = greater
+        for 0 ..^ @current.elems - 1 -> $index {
+            $ok   = is-ok @current[ $index ].Int, @current[ $index + 1 ].Int, $test;
+            $test = ! $test;
+            last if ! $ok;
+        }
+
+        say "Found wave { @current }" if $ok;
+    }
+}