- Added solutions by Colin Crain.

4 files changed, 496 insertions, 0 deletions

diff --git a/challenge-055/colin-crain/perl/ch-1.pl b/challenge-055/colin-crain/perl/ch-1.pl
new file mode 100644
index 0000000000..b254faca28
--- /dev/null
+++ b/challenge-055/colin-crain/perl/ch-1.pl
@@ -0,0 +1,133 @@
+#! /opt/local/bin/perl
+#
+#       flipper_faster_than_lightning.pl
+#
+#         55 - TASK #1
+#         Flip Binary
+#             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.
+#
+#         method: what a strange puzzle. That's it, had to get that out there.
+#
+#             In any case, the challenge is that given an array of 1s and 0s, we
+#             construct windows to map on that array within which we toggle the
+#             values, so that 1 -> 0 and 0 -> 1. After the transformation we
+#             count the 1s for the whole array and produce the parameters of
+#             those windows that maximise this value.
+#
+#             There are quite a few moving parts to this challenge. We need to:
+#                 • construct the window endpoints
+#                 • flip the bits within the endpoints
+#                 • count the ones
+#                 • keep track of the tally, cross-referenced to the window endpoints
+#                 • find and output the pairs that produce the largest value
+#
+#             To create the windows, we need two loops: one to establish the starting index,
+#             the second to determine the width, which in turn can be used to determine the
+#             ending index.
+#
+#             Within each inner loop, we construct a string of 0s the same
+#             length as the binary input, with 1s placed in the window. This
+#             will serve as a bitmask. We can flip any bit by XORing that bit
+#             with 1 so converting the input and the bitmask to decimal and
+#             applying xor, then stringifying back to base 2 will give us the
+#             result we need.
+#
+#             There's a variety of ways we can count the ones after we first we
+#             split the string into an array. Because the data, 1 is the same as
+#             the incidence, we could for instance sum the digits, which would
+#             increment the count 1 for every 1 and add nothing for the 0s.
+#
+#                     $sum += $_ for split //, $str;
+#
+#             is cute and effective. Or use List::Util::sum for the task. Or use
+#             grep and a scalar context to directly count:
+#
+#                     $sum = grep /1/, split //, $str;
+#
+#             I can't decide who's prettier.
+#
+#             We need three related values to determine the output: the xor'd
+#             binary string, the count of 1s in that string and the window
+#             coordinates that created it. Two parallel hashes keyed on the
+#             binary string serve here. We extract the maximum value of the
+#             counted 1s and use this as a filter to make a list of those binary
+#             strings that produce that value. Then we can iterate over that
+#             list and lookup the window left and right indices that correspond
+#             for output.
+#
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN:
+
+
+my $bin = shift @ARGV // '100110011';
+my $len = length $bin;
+my $num = oct('0b' . $bin);
+
+say "$bin  binary input";
+
+my %ones;
+my %windows;
+
+for my $start ( 0..$len-1) {
+    for my $span ( 1..$len-$start) {
+        ## make bitmask
+        my $mask = ('0' x $start) . ('1' x $span) . ( '0' x ( $len - ($start + $span)));
+
+        ## convert to decimal, xor with input number and back to binary
+        my $xbin = sprintf "%0" . "$len" . "b", $num ^ oct('0b' . $mask);
+
+        ## hash number of 1s keyed on xor result, hash window start, end indices keyed on xor result
+        $ones{$xbin}    = count_ones( $xbin );
+        $windows{$xbin} = [$start, $start+$span-1];
+    }
+}
+
+my $maxval = (sort {$a<=>$b} values %ones)[-1];
+my @max    = grep { $ones{$_} == $maxval } keys %ones;
+
+say "$_  result for     L=$windows{$_}->[0], R=$windows{$_}->[1]" for sort {    $windows{$a}->[0] <=> $windows{$b}->[0]
+                                                                                                   ||
+                                                                                $windows{$a}->[1] <=> $windows{$b}->[1]   } @max;
+
+
+## ## ## ## ## SUBS:
+
+sub count_ones {
+    my $str = shift;
+    my $sum;
+    $sum += $_ for split //, $str;
+    return $sum;
+}
+
diff --git a/challenge-055/colin-crain/perl/ch-2.pl b/challenge-055/colin-crain/perl/ch-2.pl
new file mode 100644
index 0000000000..ca636dd00a
--- /dev/null
+++ b/challenge-055/colin-crain/perl/ch-2.pl
@@ -0,0 +1,140 @@
+#! /opt/local/bin/perl
+#
+#       waves.pl
+#
+#         55 - TASK #2
+#         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.
+#
+#         method: A wave sequence can be considered a special case of
+#             permutation, with the valid arrangements restricted by the greater
+#             than / less than cycle. As such it makes sense to proceed like a
+#             permutation generator, with the addition that we immediately throw
+#             out cases as they are formed when the next digit cannot fit the
+#             requirements.
+
+#             The recursive function
+#
+#                 wave_at_yourself(\@set, \@working, $waves, $direction)
+#
+#             takes a set of remaining possible list values, a working list
+#             under construction, an array holding references to completed wave
+#             sequences and a direction flag that toggles every recursion.
+#
+#             With each instantation we toggle the direction, refer to the last
+#             number placed on the working array and construct a subset of
+#             values either less than or greater than (or equal to) the previous
+#             value, as directed. For each of the possible next values in the
+#             subset, new sets are made moving the value from the possible
+#             values set to the working set and the function is called again
+#             using these. If at any time the subset has no values but we are
+#             not finished we have reached a contradiction and we return empty
+#             handed. If both the larger set and the subset each only have one
+#             value we have succesfully allocated our elements accoring to the
+#             rules and have completed a wave.
+#
+#             Between iterating over only the values greater or less than the
+#             previous and pruning the tree early when we cannot continue, the
+#             search space looking for valid solutions is greatly reduced as
+#             compared to a simple permutation recursion.
+#
+#             In permutation theory the actual values are not relevant, so a
+#             sequence of integers ( 1, 2, 3, 4, 5...) is substituted instead.
+#             So if we give a single arguant of the command line, it computes on
+#             an array of that length. Default is 5. Passing any arbitrary array
+#             of integers works as expected.
+#
+
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN:
+
+my @input_array = sort {$a <=> $b} @ARGV;
+my $array_length = scalar $ARGV[0] // 5;
+@input_array = (1..$array_length) if scalar @ARGV < 2;
+
+
+my @working;
+my $waves     = [];
+my $direction = 0;
+
+# wave_at_yourself( \@set, \@working, $waves, $direction);
+wave_at_yourself( \@input_array, \@working, $waves, $direction);
+
+say '[ ', (join ', ', $_->@*), ' ]' for $waves->@*;
+
+## ## ## ## ## SUBS:
+
+
+sub wave_at_yourself {
+## given a starting set, a working list and a waves set
+## computes complete waves as arrays and places the arrays on the waves array
+## which is maintained throughout by reference
+## $direction: 1 => gt, 0 => lt
+    my ($setref, $workref, $waves, $direction) = @_;
+    my @set    = $setref->@*;
+
+    ## toggle direction every recursion
+    $direction ^= 1;
+
+    ## the subset is those elements that are either greater or equal to or less
+    ## than or equal to the previous element as selected by the direction.
+
+    ## if the subset size is 0 we cannot continue and bail without adding to the
+    ## waves array
+    my $prev = $workref->[-1];
+    my @subset = defined $prev ? grep { $direction ? $_ >= $prev : $_ <= $prev } @set : @set;
+#     return if scalar @subset == 0;
+    if (scalar @subset == 0) {
+# say join ' -> ', $workref->@*;
+        return;
+    }
+
+
+    ## if there is only one element left in both the set and the subset,
+    ## then we have successfully made a wave.
+    ## we push it onto the working list,
+    ## push that array reference onto the waves array and return.
+    ## This unique wave is complete.
+    if ( scalar @set == 1 && scalar @subset == 1 ) {
+        my @working = $workref->@*;
+        push @working,      $set[0];
+        push $waves->@*,  \@working;
+
+#  say join ' -> ', @working;
+
+        return;
+    }
+
+    ## iterate through the remaining elements of the set,
+    ## creating  new copy of the working list, moving the element
+    ## from the set to the working list and recursing with these
+    ## new lists. The waves list reference is passed through unchanged.
+    for my $element ( @subset ) {
+
+        my @working = $workref->@*;
+        push @working, $element;
+        my @set_minus_one = grep { $_ != $element } @set;
+        wave_at_yourself( \@set_minus_one, \@working, $waves, $direction );
+    }
+}
+
diff --git a/challenge-055/colin-crain/raku/ch-1.p6 b/challenge-055/colin-crain/raku/ch-1.p6
new file mode 100644
index 0000000000..c35d11ddf5
--- /dev/null
+++ b/challenge-055/colin-crain/raku/ch-1.p6
@@ -0,0 +1,106 @@
+use v6.d;
+
+#
+#       flipper.raku
+#
+#         55 - TASK #1
+#         Flip Binary
+#             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.
+#
+#         method: what a strange puzzle. That's it, had to get that out there.
+#
+#             In any case, the challenge is that given an array of 1s and 0s, we
+#             construct windows to map on that array within which we toggle the
+#             values, so that 1 -> 0 and 0 -> 1. After the transformation we
+#             count the 1s for the whole array and produce the parameters of
+#             those windows that maximise this value.
+#
+#             There are quite a few moving parts to this challenge. We need to:
+#                 • construct the window endpoints
+#                 • flip the bits within the endpoints
+#                 • count the ones
+#                 • keep track of the tally, cross-referenced to the window
+#                   endpoints
+#                 • find and output the pairs that produce the largest value
+#
+#             To create the windows, we need two loops: one to establish the
+#             starting index, the second to determine the width, which in turn
+#             can be used to determine the ending index.
+#
+#             Within each inner loop, we construct a string of 0s the same
+#             length as the binary input, with 1s placed in the window. This
+#             will serve as a bitmask. We can flip any bit by XORing that bit
+#             with 1 so converting the input and the bitmask to decimal and
+#             applying xor, then stringifying back to base 2 will give us the
+#             result we need.
+#
+#             Counting the 1s can be swiftly dispatched in Raku by spitting the string
+#             into characters with comb and summing the resulting array. Because
+#             the item we are counting, 1s, have the same value as their
+#             incidence, this works out nicely.
+
+#             We need three related values to determine the output: the xor'd
+#             binary string, the count of 1s in that string and the window
+#             coordinates that created it. Two parallel hashes keyed on the
+#             binary string serve here. We extract the maximum value of the
+#             counted 1s and use this as a filter to make a list of those binary
+#             strings that produce that value. Then we can iterate over that
+#             list and lookup the window left and right indices that correspond
+#             for output.
+
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+sub MAIN ( Str:D $binary = '100110011' ) {
+
+    say "$binary  binary input";
+
+    my $chars = $binary.chars;
+    my $num   = :2( $binary );
+    my %ones;
+    my %windows;
+
+    for ( 0..$chars-1) -> $start {
+        for ( 1..$chars-$start) -> $span {
+            my $mskbin  = ('0' x $start) ~ ('1' x $span) ~ ( '0' x ( $chars - ($start + $span)));
+
+            my $mask    = :2( $mskbin );                       ## convert binary mask string to decimal number
+            my $xorbin  = ($num +^ $mask).base(2);             ## xor and convert to binary
+            %ones{$xorbin}    = $xorbin.comb.sum;              ## hash summed digits keyed on xor result
+            %windows{$xorbin} = [$start, $start+$span-1];      ## hash window parameters keyed on xor result
+        }
+    }
+
+    my @max    = %ones.keys.grep( { %ones{$_} == %ones.values.max } );
+
+    my $sort = sub { %windows{$^a}[0] <=> %windows{$^b}[0] || %windows{$^a}[1] <=> %windows{$^b}[1] }
+    say "$_  result for     L=%windows{$_}[0], R=%windows{$_}[1]" for @max.sort( $sort );
+
+
+
+}
+
diff --git a/challenge-055/colin-crain/raku/ch-2.p6 b/challenge-055/colin-crain/raku/ch-2.p6
new file mode 100644
index 0000000000..b09905f7f8
--- /dev/null
+++ b/challenge-055/colin-crain/raku/ch-2.p6
@@ -0,0 +1,117 @@
+use v6.d;
+
+#
+#       waves.raku
+#
+#         55 - TASK #2
+#         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.
+#
+#         method: A wave sequence can be considered a special case of
+#             permutation, with the valid arrangements restricted by the greater
+#             than / less than cycle. As such it makes sense to proceed like a
+#             permutation generator, with the addition that we immediately throw
+#             out cases as they are formed when the next digit cannot fit the
+#             requirements.
+#
+#             The recursive function
+#
+#                 wave_at_yourself(\@set, \@working, $waves, $direction)
+#
+#             takes a set of remaining possible list values, a working list
+#             under construction, an array holding references to completed wave
+#             sequences and a direction flag that toggles every recursion.
+#
+#             With each instantation we toggle the direction, refer to the last
+#             number placed on the working array and construct a subset of
+#             values either less than or greater than (or equal to) the previous
+#             value, as directed. For each of the possible next values in the
+#             subset, new sets are made moving the value from the possible
+#             values set to the working set and the function is called again
+#             using these. If at any time the subset has no values but we are
+#             not finished we have reached a contradiction and we return empty
+#             handed. If both the larger set and the subset each only have one
+#             value we have succesfully allocated our elements accoring to the
+#             rules and have completed a wave.
+#
+#             Between iterating over only the values greater or less than the
+#             previous and pruning the tree early when we cannot continue, the
+#             search space looking for valid solutions is greatly reduced as
+#             compared to a simple permutation recursion.
+#
+#             In raku it might be tempting to use the .permutations routine,
+#             check and filter the results for valid sequences. However this
+#             method will require computing every single permutation first,
+#             which for longer sequences will become increasingly
+#             computationally intensive. So we won't do that today. YMMV.
+#
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+sub MAIN (*@input) {
+
+    my @set = @input.elems < 2 ?? 1..@input[0] !! @input.sort({ $^a <=> $^b });
+
+    my @working;
+    my @waves;
+    my $direction = 0;
+
+    wave_at_yourself( @set, @working, @waves, $direction);
+
+    .join(', ').say for @waves;
+}
+
+
+sub wave_at_yourself ( @prev_set, @prev_working, @waves, $direction is copy){
+## Given a starting set, a working list, a waves set and a direction,
+## computes complete waves as arrays and places the arrays on the waves array
+## direction:  0 => down, 1 => up
+
+    ## Toggle direction every recursion
+    $direction +^= 1;
+
+    ## Create a new copy of the previous set
+    my @set    = @prev_set;
+
+    ## The subset is those elements that are either ≥ or ≤ the previous element as selected.
+    ## If the subset size is 0 we cannot continue and bail without adding to the waves array.
+    ## Not sure where I stand on using the non-ascii glyph options for overall readability.
+    my $prev   = @prev_working.tail;
+    my @subset = $prev.defined ?? @set.grep({ $direction ?? $_ ≥ $prev !! $_ ≤ $prev }) !! @set;
+    return if @subset.elems == 0;
+
+    ## If there is only one element left in both the set and the subset,
+    ## then we have successfully made a wave.
+    ## We add it to the working list,
+    ## push that array onto the waves array and return.
+    ## This unique wave is complete.
+    if ( @set.elems == 1 && @subset.elems == 1 ) {
+        my @working = @prev_working;
+        @working.append: @set;
+        @waves.push: @working;
+        return;
+    }
+
+    ## Iterate through the remaining elements of the set, for each creating new copy of
+    ## the working list, moving the selected element from the current set to the working list
+    ## and recursing with these new lists.
+    for @subset -> $element {
+        my @working = @prev_working;
+        @working.push: $element;
+        my @set_minus_one = @set.grep: { $_ != $element };
+        wave_at_yourself( @set_minus_one, @working, @waves, $direction );
+    }
+}