Merge pull request #2169 from shawnw/challenge-075-solution

Challenge 075 solution

3 files changed, 115 insertions, 0 deletions

diff --git a/challenge-075/shawn-wagner/ocaml/ch-1.ml b/challenge-075/shawn-wagner/ocaml/ch-1.ml
new file mode 100644
index 0000000000..05d4052ff0
--- /dev/null
+++ b/challenge-075/shawn-wagner/ocaml/ch-1.ml
@@ -0,0 +1,28 @@
+let sum = List.fold_left (+) 0
+
+let rec solve coins s =
+  if s = 0 then
+    [[]]
+  else begin
+    let solutions = ref [] in
+    List.iter (function coin ->
+        let f solution = if (sum solution) + coin = s then
+            Some (coin :: solution)
+          else
+            None in
+        if s - coin >= 0 then
+          solutions :=
+            List.append (List.filter_map f (solve coins (s - coin)))
+              !solutions) coins;
+    !solutions
+  end
+
+let task1 coins s =
+  let solutions= solve coins s in
+  let solutions = List.map (List.sort Int.compare) solutions in
+  let solutions = List.sort_uniq compare solutions in
+  Printf.printf "There are %d possible ways to make sum %d\n" (List.length solutions) s
+
+let _ =
+  task1 [1;2;4] 6
+    
diff --git a/challenge-075/shawn-wagner/perl/ch-1.pl b/challenge-075/shawn-wagner/perl/ch-1.pl
new file mode 100755
index 0000000000..51e2afceef
--- /dev/null
+++ b/challenge-075/shawn-wagner/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use feature qw/say/;
+use List::Util qw/sum0/;
+
+sub solve {
+  my ($C, $S) = @_;
+  if ($S == 0) {
+    return ([]);
+  }
+  my @solutions;
+  for my $coin (@$C) {
+    if ($S - $coin >= 0) {
+      push @solutions,  grep { sum0(@$_) == $S }
+        map { [ $coin, @$_ ] } solve($C, $S - $coin);
+    }
+  }
+  return @solutions;
+}
+
+sub task1 :prototype(\@$) {
+  my ($C, $S) = @_;
+  my @solutions = solve $C, $S;
+  # Get rid of duplicates. There's gotta be a cleaner way than this...
+  my %canonical;
+  local $" = ", ";
+  for my $solution (@solutions) {
+    my @sorted = sort { $a <=> $b } @$solution;
+    $canonical{"@sorted"}++;
+  }
+  @solutions = sort keys %canonical;
+  my $num = @solutions;
+  say "There are $num possible ways to make sum $S";
+  my $id = "a";
+  for my $solution (@solutions) {
+    say "$id) ($solution)";
+    $id++;
+  }
+}
+
+my @C = (1, 2, 4);
+my $S = 6;
+task1 @C, $S;
diff --git a/challenge-075/shawn-wagner/perl/ch-2.pl b/challenge-075/shawn-wagner/perl/ch-2.pl
new file mode 100755
index 0000000000..e95f1ec475
--- /dev/null
+++ b/challenge-075/shawn-wagner/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use utf8;
+use open qw/:std encoding(UTF-8)/;
+use feature qw/say/;
+use List::Util qw/max/;
+
+# Fancy unicode histogram printer
+sub histogram {
+  my @A = @_;
+  my $rows = max @A;
+  for my $row (reverse (1 .. $rows)) {
+    print $row, "│";
+    for my $col (@A) {
+      print $col >= $row ? "█" : " ", " ";
+    }
+    print "\n";
+  }
+  print " └", "──" x @A, "\n  ";
+  print $_, " " for @A;
+  print "\n";
+}
+
+sub task2 {
+  my @A = @_;
+  histogram @A;
+  my $maxsize = 0;
+  for my $left (0 .. $#A) {
+    for my $top (1 .. $A[$left]) {
+      for my $right ($left+1 .. $#A) {
+        last if ($A[$right] < $top);
+        my $size = ($right - $left + 1) * $top;
+        $maxsize = max $maxsize, $size;
+      }
+    }
+  }
+  say "Largest rectangle area: $maxsize";
+}
+
+task2 2, 1, 4, 5, 3, 7;
+print "\n";
+task2 3, 2, 3, 5, 7, 5;