Task 1 & 2

2 files changed, 169 insertions, 0 deletions

diff --git a/challenge-093/perlboy1967/perl/ch-1.pl b/challenge-093/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..35d575ba06
--- /dev/null
+++ b/challenge-093/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 093
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-093/
+#
+# Task 1 - Max Points
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::Util qw(max);
+use Algorithm::Combinatorics qw(combinations);
+use Data::Printer;
+
+# Unbuffered STDOUT
+$|++;
+
+while (<DATA>) {
+  chomp();
+  my @points = split(/;/);
+  my @pXY = map{[split(/,/)]} @points;
+
+  my %fP;
+  my %fPc;
+  my $formula;
+  
+  # Calculate 'a' and 'b' factors of line formula: 'y = ax + b'
+  # from two points
+  my $iter = combinations(\@pXY, 2);
+  while (my $ar = $iter->next) {
+
+    my $f;
+    my ($a, $b) = ('');
+
+    # Special case #1: X1 = X2 (vertical line)
+    if ($ar->[0][0] == $ar->[1][0]) {
+
+      $f = "x=$ar->[0][0]";
+
+    } else {
+
+      # Special case #2: Y1 = Y2 (horizontal line) 
+      if ($ar->[0][0] == $ar->[1][0]) {
+        $b = $ar->[0][1];
+      } else {
+        # a = dY / dX
+        $a = ($ar->[0][1] - $ar->[1][1]) / 
+             ($ar->[0][0] - $ar->[1][0]);
+        # b = y - a.x
+        $b = $ar->[0][1] - $a * $ar->[0][0];
+      }
+
+      $f = sprintf("y=%s*x+%s", $a, $b);
+    }
+
+    # Record the points against the line formula
+    for my $i (0,1) {
+      $fP{$f}{"($ar->[$i][0],$ar->[$i][1])"}++;
+    }
+      
+    $fPc{$f} = scalar keys %{$fP{$f}};
+  }
+
+  my $max = max(values(%fPc));
+  my @formulas = grep { $fPc{$_} == $max } keys %fPc;
+
+  printf "-------------------------------------------------------\n";
+  printf "Input: %s\n", '('.join('),(', @points).')';
+  printf "Max points on same line: %d\n", $max;
+  if ($max == 2) {
+    printf "Suppressing %d matching results\n", scalar @formulas; 
+  } else {
+    my $i = 1;
+    foreach $formula (sort @formulas) {
+      printf "%d)\tPoints on '%s':\n", $i++, $formula;
+      printf "\t%s\n", join(',', sort keys %{$fP{$formula}});
+    }
+  }
+  printf "-------------------------------------------------------\n";
+}
+
+__DATA__
+1,1;2,2;3,3
+1,1;2,2;3,1;1,3;5,3
+1,1;2,2;3,3;4,4;1,2;2,4;3,6;4,8;5,1;5,2;5,3;5,4
+1,1;2,2;3,6;4,8
diff --git a/challenge-093/perlboy1967/perl/ch-2.pl b/challenge-093/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..c7ddb43fb0
--- /dev/null
+++ b/challenge-093/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 093
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-093/
+#
+# Task 2 - Sum Path
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::Util qw(sum);
+use Data::Printer;
+
+sub treeTotal(\@\@\%);
+
+# Unbuffered STDOUT
+$|++;
+
+my %tree = ( 
+  'Tree 1' => {
+    1 => { 
+      2 => { 
+        3 => undef,
+        4 => undef,
+      }
+    }
+  },
+  'Tree 2' => {
+    1 => { 
+      2 => { 
+        4 => undef
+      },
+      3 => {
+        5 => undef,
+        6 => undef,
+      }
+    }
+  },
+  'Tree 3' => {
+    3 => {
+      9 => undef,
+      3 => {
+        2 => undef,
+        1 => undef,
+      },
+    }
+  },
+);
+
+foreach my $case (sort keys %tree) {
+  my (@sum, @nodes);
+
+  treeTotal(@sum, @nodes, %{$tree{$case}});
+
+  my $sum = sum(map{sum @$_} @sum);
+
+  printf "===============================\n";
+  printf "Tree: '%s'\n", $case;
+  printf "Sum: %d\n", $sum;
+  printf "Paths: (%s)\n", join('),(', map {join(',', @$_)} @sum);
+  printf "===============================\n\n";
+}
+
+sub treeTotal (\@\@\%) {
+  my ($arT, $arN, $hr) = @_;
+  my @n = @$arN;
+
+  foreach my $k (keys %$hr) {
+    if (scalar(keys %{$hr->{$k}})) {
+      push(@n, $k);
+      treeTotal(@$arT, @n, %{$hr->{$k}});
+      pop(@n);
+    } else {
+      push(@$arT, [@n, $k]);
+    }
+  }
+}