aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xchallenge-093/perlboy1967/perl/ch-1.pl89
-rwxr-xr-xchallenge-093/perlboy1967/perl/ch-2.pl80
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]);
+ }
+ }
+}