Merge pull request #10184 from atschneid/atschneid-branch

Initial commit of perl and haskell pwc 271 solutions

6 files changed, 426 insertions, 0 deletions

diff --git a/challenge-271/atschneid/README.md b/challenge-271/atschneid/README.md
new file mode 100644
index 0000000000..e0a5c17bd2
--- /dev/null
+++ b/challenge-271/atschneid/README.md
@@ -0,0 +1,133 @@
+# Semi-Functional Solutions
+
+**Challenge 271 solutions in Perl by Andrew Schneider**
+
+### Intro
+This is my first Perl Weekly Challenge. I'm mostly a Python programmer in my day job so I like the chance to develop some other skills. I have a soft spot in my heart for Perl, let's say I'm a Perl slacker. I was surprised how functional this turned out - like functional programming. Also semi-surprised my solution functions. Har har. I have big plans for keeping up with the PWC using a randomly rotating selection of languages each week. I'm working on a script to select the language(s) I'll use -- stay tuned for that.
+
+### What did we learn?
+It took me a little while to get the hang of multi-dimensional lists in Perl. Working on it for a little while eventually knocked something loose in the recesses of my brain, and now I feel sufficiently competent handling dimensions up to and including 3. As I said, I'm surprised with how functional these solutions turned out. It *could* be that is just the mindspace I'm in lately (see my Haskell contribution which I wrote after this one), or the problems just seemed suited to this. Anyway, functionally turned out to be a way to do it.
+
+One gotcha I bumped into a few times is the difference between Perl versions. I started using 5.38, then 5.34, then back to 5.38, then 5.34 again, and finally 5.38. Along the way somewhere I picked up subroutine signatures[^1]. After much confusion and cursing I finally realized these weren't added until 5.36, right in the sweet spot between the versions I was trying. The lesson here I suppose is Read the Docs.
+
+Now onto the code.
+
+## Task 1: Maximum Ones
+
+> You are given a m x n binary matrix.<br/>
+> <br/>
+> Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.<br/>
+> <br/>
+> Example 1<br/>
+> Input: $matrix = [ [0, 1],<br/>
+>                    [1, 0],<br/>
+>                  ]<br/>
+> Output: 1<br/>
+> <br/>
+> Row 1 and Row 2 have the same number of ones, so return row 1.<br/>
+> Example 2<br/>
+> Input: $matrix = [ [0, 0, 0],<br/>
+>                    [1, 0, 1],<br/>
+>                  ]<br/>
+> Output: 2<br/>
+> <br/>
+> Row 2 has the maximum ones, so return row 2.<br/>
+> Example 3<br/>
+> Input: $matrix = [ [0, 0],<br/>
+>                    [1, 1],<br/>
+>                    [0, 0],<br/>
+>                  ]<br/>
+> Output: 2<br/>
+> <br/>
+> Row 2 have the maximum ones, so return row 2.<br/>
+
+One thing that surprised me here, we want the 1 indexed row. For example, I would have expected the first solution to be 0, the zeroth row. But, I'll solve the problem I'm given.
+
+My solution here is to sum each row of the matrix. I do this using the old map reduce design
+
+```perl
+	my @counts = map { reduce {$a + $b} 0, $_->@* } @matrix;
+```
+
+Then find the first index of the max value over all the summed rows. I use a loop here for this (would recursion have been a more functional design?). I'm sure there is a better way to do this, but it works, and hey, this is my first PWC.
+
+```perl
+    my $idx = 0;
+    for (0..scalar(@counts) - 1) {
+		if ($counts[$_] > $counts[$idx]) {
+			$idx = $_;
+		}
+    }
+```
+
+And that's about it. I return that `$idx` value, then increment it (0 to 1 indexing) outside the function for no particularly good reason.
+
+## Task 2: Sort by 1 bits
+
+> You are give an array of integers, @ints.A<br/>
+> <br/>
+> Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.<br/>
+> <br/>
+> Example 1<br/>
+> Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)<br/>
+> Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)<br/>
+> <br/>
+> 0 = 0 one bits<br/>
+> 1 = 1 one bits<br/>
+> 2 = 1 one bits<br/>
+> 4 = 1 one bits<br/>
+> 8 = 1 one bits<br/>
+> 3 = 2 one bits<br/>
+> 5 = 2 one bits<br/>
+> 6 = 2 one bits<br/>
+> 7 = 3 one bits<br/>
+> Example 2<br/>
+> Input: @ints = (1024, 512, 256, 128, 64)<br/>
+> Output: (64, 128, 256, 512, 1024)<br/>
+> <br/>
+> All integers in the given array have one 1-bits, so just sort them in ascending order.<br/>
+
+At first I thought I was going to end up reusing some pieces of my solution to Task 1 for this, but it turned out to be just different enough that I didn't think it was worth it.
+
+So first we need to convert our integers to some kind of binary representation. In Perl it makes a lot if sense to go to strings, since converting between strings that look like numbers and numbers that look like strings is covered in minute 2 of the 15 Minutes to Perl crash course.
+
+```perl
+    my @bins = map { sprintf "%b", $_ } @input;
+```
+
+Next we need to sum them up. (Is there a better way to do this? I seem to be repeating this pattern alot.)
+
+```perl
+    my @bin_sums = map { reduce { $a + $b } 0, split(//, $_) } @bins;
+```
+
+Next I make a list of tuples (pairs) of ( binary sum, integer value ), which I can sort further on. Eep! It's another loop. I'm really harming my functional credentials.
+
+```perl
+	my @tuple_list = ();
+		for (0..scalar(@bin_sums) - 1) {
+			push @tuple_list, ([ $bin_sums[$_], $input[$_]]);
+	}
+```
+
+Then I sort this super-list, first on the 0th index, then on the 1st
+
+```perl
+    my @sorted_list = sort { ${$a}[0] <=> ${$b}[0] || ${$a}[1] <=> ${$b}[1] } @tuple_list;
+```
+
+Then map back just to a simple list of integers
+
+```perl
+	map { ${$_}[1] } @sorted_list;
+```
+
+I think that wraps it up.
+
+## Post script
+
+There wasn't a ton to figure out here, mostly it was an engineering challenge (how do I do *X*?). Plus some self inflicted versioning pain. Really with the amount of functional style stuff going in here, I wonder if I could one-line these. Hmm... Future work I suppose.
+
+Thanks for the challenge!
+
+[^1]: Really? Only just in 5.36?
diff --git a/challenge-271/atschneid/haskell/README.md b/challenge-271/atschneid/haskell/README.md
new file mode 100644
index 0000000000..d5fb0fbd8a
--- /dev/null
+++ b/challenge-271/atschneid/haskell/README.md
@@ -0,0 +1,10 @@
+# Challenge 271
+
+**Challenge 271 solutions in Haskell by Andrew Schneider**
+
+### Some words
+I have only just started learning Haskell. These solutions are basically the first things I have worked on. I have iterated on these solutions as I have worked my way through Learn You a Haskell. Tangentially, it's a great book for reading, but not so great for when I think, "what was that thing I learned about? what was the syntax?" and then try to find the section. But there are docs! I'm getting used to Haskell and I think these solutions look pretty good.
+
+I wrote these in a literate style, so there is more explanation in the files that I don't need to repeat here. I'm not sure how I feel about literate programming at this point but it was interesting to try.
+
+I compiled these using `ghc` (of course) without any issues. Check 'em out.
diff --git a/challenge-271/atschneid/haskell/ch-1.lhs b/challenge-271/atschneid/haskell/ch-1.lhs
new file mode 100644
index 0000000000..3a7c9dfca6
--- /dev/null
+++ b/challenge-271/atschneid/haskell/ch-1.lhs
@@ -0,0 +1,73 @@
+Perl Weekly Challenge #271 - Challenge 1 - Haskell Version
+
+************
+Description:
+You are given a m x n binary matrix.
+
+Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.
+
+Example 1
+Input: $matrix = [ [0, 1],
+                   [1, 0],
+                 ]
+Output: 1
+
+Row 1 and Row 2 have the same number of ones, so return row 1.
+Example 2
+Input: $matrix = [ [0, 0, 0],
+                   [1, 0, 1],
+                 ]
+Output: 2
+
+Row 2 has the maximum ones, so return row 2.
+Example 3
+Input: $matrix = [ [0, 0],
+                   [1, 1],
+                   [0, 0],
+                 ]
+Output: 2
+
+Row 2 have the maximum ones, so return row 2.
+************
+
+Seems easy enough. Let's try to create our test data first
+
+> test_cases = [
+>   [[0, 1], [1, 0]],
+>   [[0, 0, 0], [1, 0, 1]],
+>   [[0, 0], [1, 1], [0, 0]]]
+
+
+I want numpy style argmax, which I just realized is more like indexmax ...
+
+> indexMax :: (Ord a) => [a] -> Int
+> indexMax [] = error "index maximum of empty list"
+> indexMax l =
+>   let max_l = maximum l
+>       indexed_l = zip l [0..]
+>   in snd ( [iv | iv <- indexed_l, (\ x -> fst x == max_l) iv] !! 0 )
+
+With that in place, all we need is to:
+ - sum each row giving us a 1-d list
+ - find the indexMax on that list
+ - add 1 because this is like 1 indexed, not 0 indexed
+
+> maxRow :: (Num a, Ord a) => [[a]] -> Int
+> maxRow l = (+) 1 $ indexMax $ map sum l
+
+We can walk through this with a test case:
+let l = [[0, 0, 0], [1, 0, 1]]
+First we take `map sum l` -> [0, 2]
+Then we take `indexMax [0, 2]` -> 1
+Then, per the instructions, row 1 is the second row
+so we add 1 `(+) 1 1` -> 2
+Done.
+
+Now map our function over our test cases
+
+> row_sums = map maxRow test_cases
+
+And print out the output.
+
+> main = putStrLn $ show row_sums
+
diff --git a/challenge-271/atschneid/haskell/ch-2.lhs b/challenge-271/atschneid/haskell/ch-2.lhs
new file mode 100644
index 0000000000..a495d9bf0c
--- /dev/null
+++ b/challenge-271/atschneid/haskell/ch-2.lhs
@@ -0,0 +1,73 @@
+Perl Weekly Challenge #271 - Challenge 2 - Haskell Version
+
+> import Data.List ( sort )
+
+You are give an array of integers, @ints.
+
+Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.
+
+Example 1
+Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+
+0 = 0 one bits
+1 = 1 one bits
+2 = 1 one bits
+4 = 1 one bits
+8 = 1 one bits
+3 = 2 one bits
+5 = 2 one bits
+6 = 2 one bits
+7 = 3 one bits
+Example 2
+Input: @ints = (1024, 512, 256, 128, 64)
+Output: (64, 128, 256, 512, 1024)
+
+All integers in the given array have one 1-bits, so just sort them in ascending order.
+
+Lets start with our test data again
+
+> test_cases = [
+>   [0, 1, 2, 3, 4, 5, 6, 7, 8],
+>   [1024, 512, 256, 128, 64]
+>  ]
+
+The one thing I need is a function to convert an integer into a, ... let's say a list of bits
+
+> int2bits :: (Integral a) => a -> [a]
+> int2bits 0 = [0]
+> int2bits n = mod n 2 : int2bits (div n 2)
+
+That should be clear. We take an integer. If it is 0 we return [0]
+Otherwise, recursion!
+For a number n, mod n 2 will give us 0 if is even ie, the lowest bit is zero,
+or 1 if it is odd, ie, the lowest bit is 1.
+`div n 2` is effectively a right bitshift
+so `mod n 2 : int2bits (div n 2)` gives the bit value of the lowest bit appended to the list
+recursively generated on the right shifted value.
+Note this gives us a little-endian array. For the current problem it is completely irrelevant
+since we only care about the sum of the bits, and addition is commutative.
+
+The rest should wrap up easily
+
+> binary_sum_sort :: (Integral a) => [a] -> [a]
+> binary_sum_sort mat =
+>   let bit_sums = map (sum . int2bits) mat
+>       indexed_list = zip bit_sums mat
+>   in map snd $ sort indexed_list
+
+Hmm... Actually that's pretty ugly. And it took me a while to get right
+Let's break it down:
+let l = [0, 1, 2]
+`map (sum . int2bits) l` is going to apply the composition of sum and int2bits
+  to each element of l. Let's break this down as if it were `map sum (map int2bits l)`
+[we could have written it that way]
+
+
+
+Then map it onto our test cases, for testing
+
+> test_results = map binary_sum_sort test_cases
+> main = putStrLn $ show test_results
+
+
diff --git a/challenge-271/atschneid/perl/ch-1.pl b/challenge-271/atschneid/perl/ch-1.pl
new file mode 100644
index 0000000000..4547993e5d
--- /dev/null
+++ b/challenge-271/atschneid/perl/ch-1.pl
@@ -0,0 +1,75 @@
+# You are given a m x n binary matrix.
+
+# Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.
+
+# Example 1
+# Input: $matrix = [ [0, 1],
+#                    [1, 0],
+#                  ]
+# Output: 1
+
+# Row 1 and Row 2 have the same number of ones, so return row 1.
+# Example 2
+# Input: $matrix = [ [0, 0, 0],
+#                    [1, 0, 1],
+#                  ]
+# Output: 2
+
+# Row 2 has the maximum ones, so return row 2.
+# Example 3
+# Input: $matrix = [ [0, 0],
+#                    [1, 1],
+#                    [0, 0],
+#                  ]
+# Output: 2
+
+# Row 2 have the maximum ones, so return row 2.
+
+use strict;
+use warnings;
+
+use v5.38;
+
+use List::Util qw( reduce );
+
+my @examples = (
+    [ [0, 1],
+      [1, 0] ],
+    [ [0, 0, 0],
+      [1, 0, 1] ],
+    [ [0, 0],
+      [1, 1],
+      [0, 0] ]
+    );
+
+for (@examples) {
+    my @derefed_matrix = @$_;
+    say( show_matrix( @derefed_matrix ) );
+
+    my $max_row = find_max_earliest_sum( @derefed_matrix );
+
+    # very non-perlishly 1 indexed!?
+    ++$max_row;
+
+    say("max row :: $max_row");
+}
+
+sub show_matrix (@matrix) {
+    return join ",\n",
+	map { join ' ', '[', ( join ', ', $_->@* ), ']' } @matrix;
+}
+
+sub find_max_earliest_sum ( @matrix ) {
+    # map each row of the matrix to the sum of its elements
+    my @counts = map { reduce {$a + $b} 0, $_->@* } @matrix;
+
+    # iterate of indices and find the first index of the max element
+    my $idx = 0;
+    for (0..scalar(@counts) - 1) {
+	if ($counts[$_] > $counts[$idx]) {
+	    $idx = $_;
+	}
+    }
+
+    return $idx;
+}
diff --git a/challenge-271/atschneid/perl/ch-2.pl b/challenge-271/atschneid/perl/ch-2.pl
new file mode 100644
index 0000000000..d6639b26f9
--- /dev/null
+++ b/challenge-271/atschneid/perl/ch-2.pl
@@ -0,0 +1,62 @@
+# You are give an array of integers, @ints.A
+
+# Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.
+
+# Example 1
+# Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+# Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+
+# 0 = 0 one bits
+# 1 = 1 one bits
+# 2 = 1 one bits
+# 4 = 1 one bits
+# 8 = 1 one bits
+# 3 = 2 one bits
+# 5 = 2 one bits
+# 6 = 2 one bits
+# 7 = 3 one bits
+# Example 2
+# Input: @ints = (1024, 512, 256, 128, 64)
+# Output: (64, 128, 256, 512, 1024)
+
+# All integers in the given array have one 1-bits, so just sort them in ascending order.
+
+use strict;
+use warnings;
+
+use v5.38;
+
+use List::Util qw( reduce );
+
+my @examples = (
+     [0, 1, 2, 3, 4, 5, 6, 7, 8],
+     [1024, 512, 256, 128, 64]
+    );
+
+for (@examples) {
+    say "***||***";
+    my @derefed_array = @$_;
+    say "input: " . join ", ", @derefed_array;
+    my @sorted_array = sort_binary_ones( @derefed_array );
+    say "output: " . join ", ", @sorted_array;
+}
+
+sub sort_binary_ones ( @input ) {
+    # convert each integer to a binary string
+    my @bins = map { sprintf "%b", $_ } @input;
+    # sum up the value of each binary string
+    my @bin_sums = map { reduce { $a + $b } 0, split(//, $_) } @bins;
+
+    # make a list of tuples of type ( binary sum, integer value )
+    my @tuple_list = ();
+    for (0..scalar(@bin_sums) - 1) {
+	push @tuple_list, ([ $bin_sums[$_], $input[$_]]);
+    }
+
+    # sort tuple list, first on binary sum, then on integer value
+    my @sorted_list = sort { ${$a}[0] <=> ${$b}[0] || ${$a}[1] <=> ${$b}[1] } @tuple_list;
+
+    # return a list of the integer values from the sorted list
+    return map { ${$_}[1] } @sorted_list;
+}
+