Merge pull request #3113 from benkasminbullock/master

Perl Weekly Challenge 093-ch1 solution

7 files changed, 256 insertions, 0 deletions

diff --git a/challenge-093/bkb/README b/challenge-093/bkb/README
new file mode 100644
index 0000000000..4721993bb3
--- /dev/null
+++ b/challenge-093/bkb/README
@@ -0,0 +1 @@
+Solution by Ben Bullock.
diff --git a/challenge-093/bkb/perl/ch1.pl b/challenge-093/bkb/perl/ch1.pl
new file mode 100755
index 0000000000..d376fa3cd5
--- /dev/null
+++ b/challenge-093/bkb/perl/ch1.pl
@@ -0,0 +1,48 @@
+#!/home/ben/software/install/bin/perl
+use warnings;
+use strict;
+
+use JSON::Parse 'json_file_to_perl';
+use JSON::Create 'create_json';
+use List::Util 'max';
+
+for my $file (@ARGV) {
+    my $p = json_file_to_perl ($file);
+    my $max = find_col ($p);
+    print create_json ({max => $max}, sort => 1, indent => 1);
+}
+
+sub find_col
+{
+    my ($p) = @_;
+    my @count;
+    my $n = scalar (@$p);
+    for my $i (0..$n-1) {
+	my $start = $p->[$i];
+	for my $j ($i+1..$n-1) {
+	    my $end = $p->[$j];
+	    my $c = 2;
+	    for my $k ($j+1..$n-1) {
+		my $pk = $p->[$k];
+		if (collinear ($start, $end, $pk)) {
+		    $c++;
+		}
+	    }
+	    push @count, $c;
+	}
+    }
+    return max @count;
+}
+
+sub collinear
+{
+    my ($a, $b, $c) = @_;
+    my $d = prod ($a, $b) + prod ($b, $c) + prod ($c, $a);
+    return $d == 0;
+}
+
+sub prod
+{
+    my ($a, $b) = @_;
+    return $a->{x} * $b->{y} - $a->{y} * $b->{x};
+}
diff --git a/challenge-093/bkb/perl/ch2.pl b/challenge-093/bkb/perl/ch2.pl
new file mode 100755
index 0000000000..cef651f7eb
--- /dev/null
+++ b/challenge-093/bkb/perl/ch2.pl
@@ -0,0 +1,47 @@
+#!/home/ben/software/install/bin/perl
+
+use warnings;
+use strict;
+
+use JSON::Parse 'json_file_to_perl';
+use Getopt::Long;
+
+my $ok = GetOptions (
+    debug => \my $debug,
+
+);
+for my $file (@ARGV) {
+    if (! -f $file) {
+	warn "$file not found";
+	next;
+    }
+    my $tree = json_file_to_perl ($file);
+    my $total = add ($tree, 0);
+    print "$file: $total\n";
+}
+exit;
+
+sub add
+{
+    my ($tree, $depth) = @_;
+    my $total;
+    my $n = $tree->{n};
+    for (qw!l r!) {
+	my $v = $tree->{$_};
+	if (! defined $tree->{$_}) {
+	    die "No $_ in tree at depth $depth";
+	}
+	if (ref $v) {
+	    $total += add ($v, $depth + 1);
+	}
+	else {
+	    $total += $v;
+	}
+	$total += $n;
+	if ($debug) {
+	    print "\t" x $depth;
+	    print "$_: $total\n";
+	}
+    }
+    return $total;
+}
diff --git a/challenge-093/bkb/test/make-tree.pl b/challenge-093/bkb/test/make-tree.pl
new file mode 100755
index 0000000000..52b20199e8
--- /dev/null
+++ b/challenge-093/bkb/test/make-tree.pl
@@ -0,0 +1,35 @@
+#!/home/ben/software/install/bin/perl
+
+# Make like a tree and blow.
+
+use warnings;
+use strict;
+use utf8;
+use FindBin '$Bin';
+use JSON::Create 'create_json';
+
+my $avd = 3;
+my $min = 1;
+my $max = 5;
+my $prob = 1/$avd;
+print create_json (node (0), indent => 1, sort => 1);
+exit;
+
+sub node
+{
+    my ($depth) = @_;
+    if (($depth > $min && rand () < $prob) || $depth >= $max) {
+	return number ();
+    }
+    my %node;
+    $node{l} = node ($depth + 1);
+    $node{r} = node ($depth + 1);
+    $node{n} = number ();
+    return \%node;
+}
+
+sub number
+{
+    return int (rand (10));
+}    
+    
diff --git a/challenge-093/bkb/test/paolo-tree-13.txt b/challenge-093/bkb/test/paolo-tree-13.txt
new file mode 100644
index 0000000000..464d4c8fde
--- /dev/null
+++ b/challenge-093/bkb/test/paolo-tree-13.txt
@@ -0,0 +1 @@
+{"n":1,"l":{"n":2,"l":3,"r":4},"r":0}
diff --git a/challenge-093/bkb/test/paolo-tree-26.txt b/challenge-093/bkb/test/paolo-tree-26.txt
new file mode 100644
index 0000000000..56621ebb14
--- /dev/null
+++ b/challenge-093/bkb/test/paolo-tree-26.txt
@@ -0,0 +1 @@
+{"l":{"l":4,"r":0,"n":2},"n":1,"r":{"l":5,"n":3,"r":6}}
diff --git a/challenge-093/bkb/test/points.pl b/challenge-093/bkb/test/points.pl
new file mode 100755
index 0000000000..d4168c9a10
--- /dev/null
+++ b/challenge-093/bkb/test/points.pl
@@ -0,0 +1,123 @@
+#!/home/ben/software/install/bin/perl
+use warnings;
+use strict;
+use utf8;
+use FindBin '$Bin';
+use JSON::Create;
+use JSON::Parse 'parse_json';
+use File::Slurper 'write_text';
+use IPC::Run3;
+use Test::More;
+
+my $binary = "$Bin/../perl/ch1.pl";
+
+my $jc = JSON::Create->new (sort => 1, indent => 1);
+
+# Paolo Custodio
+
+my $paolo1 = ["1 1  2 2  3 4" => {max => 2}];
+my $paolo2 = ["1 1  2 2  3 1  1 3  5 3" => {max => 3}];
+
+my $n = 1;
+for my $paolo ($paolo1, $paolo2) {
+    my $points = $paolo->[0];
+    my @n = split /\s+/, $points;
+    my @p;
+    while (@n) {
+	my $p = {};
+	$p->{x} = 0 + shift @n;
+	$p->{y} = 0 + shift @n;
+	push @p, $p;
+    }
+    run ("paolo-$n", \@p, $paolo->[1]);
+    $n++;
+}
+
+# Dave Jacoby
+
+my @examples;
+push @examples, [ 1, [ [ 1, 1 ], [ 2, 2 ], [ 3, 3 ] ] ];
+push @examples, [ 2, [ [ 1, 1 ], [ 2, 2 ], [ 3, 1 ], [ 1, 3 ], [ 5, 3 ] ] ];
+push @examples,
+    [
+    3,
+    [ [ 1, 1 ], [ 2, 2 ], [ 3, 1 ], [ 1, 3 ], [ 3, 3 ], [ 4, 4 ], [ 5, 3 ] ]
+    ];
+push @examples, [ 4, [ [ 1, 2 ], [ 2, 4 ], [ 3, 6 ], [ 4, 8 ] ] ];
+
+# Expected results
+
+my %jx = (
+    1 => {max => 3},
+    2 => {max => 3},
+    3 => {max => 4},
+    4 => {max => 4}
+);
+
+for my $jacoby (@examples) {
+    my $n = $jacoby->[0];
+    my @p;
+    for my $p (@{$jacoby->[1]}) {
+	push @p, {x => $p->[0], y => $p->[1]};
+    }
+    run ("jacoby-$n", \@p, $jx{$n});
+}
+
+# E. Choroba
+
+my @choroba = (
+[[[1, 1], [2, 2], [3, 3]], 3, 'Example 1'],
+[[[1,1], [2,2], [3,1], [1,3], [5,3]], 3, 'Example 2'],
+# The question doesn't really specify whether duplicates are allowed,
+# or how to count them if so, so this number is dubious.
+# [[[1, 1], [1, 1], [1, 1], [1, 1],
+#   [2, 2], [2, 2], [2, 2],
+#   [1, 2], [1, 2],
+#   [3, 1]],
+#  7, 'duplicates'],
+[[[2, 2], [3, 2], [4, 2], [5, 2], [5, 3], [6, 7]], 4, 'horizontal'],
+[[[2, 2], [2, 3], [2, 4], [2, 5], [5, 3], [6, 7]], 4, 'vertical'],
+[[[0, 0], [0, 1], [0, 2],
+  [1, 0], [1, 1], [1, 2],
+  [2, 0], [2, 1], [2, 2]], 3, '3x3'],
+[[[0, 0], [0, 1], [0, 2],
+  [1, 0], [1, 1], [1, 2],
+  [2, 0], [2, 1], [2, 2],
+  [4, 4]], 4, '3x3 diagonal'],
+[[[0, 0], [0, 1], [0, 2],
+  [1, 0], [1, 1], [1, 2],
+  [2, 0], [2, 1], [2, 2],
+  [3, 0]], 4, '3x3 horizontal'],
+[[[0, 0], [0, 1], [0, 2],
+  [1, 0], [1, 1], [1, 2],
+  [2, 0], [2, 1], [2, 2],
+  [2, 3]], 4, '3x3 vertical'],
+);
+
+for my $choroba (@choroba) {
+    my @p;
+    for (@{$choroba->[0]}) {
+	push @p, {x => $_->[0], y => $_->[1]};
+    }
+    my $name = 'choroba-' . $choroba->[2];
+    $name =~ s/\W/-/g;
+    run ($name, \@p, {max => $choroba->[1]});
+}
+
+done_testing ();
+exit;
+
+sub run
+{
+    my ($name, $input, $expect) = @_;
+    my $out = "$Bin/$name.json";
+    write_text ($out, $jc->run ($input));
+    run3 ("$binary $out", undef, \my $output, \my $errors);
+    unlink $out or die $!;
+    if ($errors) {
+	diag ("Errors from $binary: $errors");
+	return;
+    }
+    my $results = parse_json ($output);
+    cmp_ok ($results->{max}, '==', $expect->{max}, "$name count same");
+}