From 1bd00d8e73a4d6dd941ab4593eda29ae185fd0d0 Mon Sep 17 00:00:00 2001
From: Yanick Champoux <yanick@babyl.ca>
Date: Sun, 5 Dec 2021 11:45:03 -0500
Subject: [PATCH] 2021-04

---
 2021/04/part1.pm | 64 ++++++++++++++++++++++++++++++++++++++++++++++++
 2021/04/part2.pm | 35 ++++++++++++++++++++++++++
 2021/04/sample   | 19 ++++++++++++++
 2021/04/test.t   | 19 ++++++++++++++
 4 files changed, 137 insertions(+)
 create mode 100644 2021/04/part1.pm
 create mode 100644 2021/04/part2.pm
 create mode 100644 2021/04/sample
 create mode 100644 2021/04/test.t

diff --git a/2021/04/part1.pm b/2021/04/part1.pm
new file mode 100644
index 0000000..81aea45
--- /dev/null
+++ b/2021/04/part1.pm
@@ -0,0 +1,64 @@
+package part1;
+
+use 5.34.0;
+use warnings;
+use experimental 'signatures';
+
+use Path::Tiny;
+use List::AllUtils qw/ natatime any sum all sum0/;
+
+sub readFile($file) {
+    my @lines = path($file)->lines;
+
+    my @balls = split ',', shift @lines;
+    my $it = natatime 5, map { [split] } grep { /\d/ } @lines;
+
+    my @cards;
+    while( my @next = $it->() ) { push @cards, \@next }
+
+    return {
+        balls => \@balls,
+        cards => \@cards,
+    }
+}
+
+sub has_line($n,$card) {
+    return all { $_ == -1} $card->[$n]->@*;
+}
+
+sub has_column($n,$card) {
+    return all { $_ == -1 } map {$_->[$n]} @$card;
+}
+
+sub score( $n, $card ) {
+    return $n * sum map { sum0 grep { $_ > 0 } @$_ } @$card;
+}
+
+sub victory ($number, $card) {
+    for ( 0..4 ) {
+        if ( has_line($_,$card) or has_column($_,$card) ) {
+            return score($number,$card);
+        }
+    }
+
+    return 0;
+}
+
+sub solution($balls, $cards) {
+
+    my $number = shift @$balls;
+
+    for my $card ( @$cards ) {
+        for my $row ( @$card ) {
+            $row = [ map { $_ == $number ? -1 : $_ } @$row ];
+        }
+
+        if( my $score =  victory($number,$card) ) {
+            return $score;
+        }
+    }
+
+    goto &solution;
+}
+
+1;
diff --git a/2021/04/part2.pm b/2021/04/part2.pm
new file mode 100644
index 0000000..f422aca
--- /dev/null
+++ b/2021/04/part2.pm
@@ -0,0 +1,35 @@
+package part2;
+
+use 5.20.0;
+use warnings;
+use experimental 'signatures';
+
+use List::AllUtils qw/ /;
+
+require './part1.pm';
+
+use experimental qw/ signatures postderef /;
+use DDP;
+
+sub solution($balls, $cards) {
+    my $number = shift @$balls;
+
+    for my $index ( reverse 0..$cards->$#* ) {
+        my $card = $cards->[$index];
+
+        for my $row ( @$card ) {
+            $row = [ map { $_ == $number ? -1 : $_ } @$row ];
+        }
+
+        my $score =  part1::victory($number,$card) or next;
+
+        return $score if @$cards == 1;
+
+        splice @$cards, $index, 1;
+    }
+
+    @_ = ( $balls, $cards );
+    goto &solution;
+}
+
+1;
diff --git a/2021/04/sample b/2021/04/sample
new file mode 100644
index 0000000..669a51d
--- /dev/null
+++ b/2021/04/sample
@@ -0,0 +1,19 @@
+7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1
+
+22 13 17 11  0
+ 8  2 23  4 24
+21  9 14 16  7
+ 6 10  3 18  5
+ 1 12 20 15 19
+
+ 3 15  0  2 22
+ 9 18 13 17  5
+19  8  7 25 23
+20 11 10 24  4
+14 21 16 12  6
+
+14 21 17 24  4
+10 16 15  9 19
+18  8 23 26 20
+22 11 13  6  5
+ 2  0 12  3  7
diff --git a/2021/04/test.t b/2021/04/test.t
new file mode 100644
index 0000000..4f1f160
--- /dev/null
+++ b/2021/04/test.t
@@ -0,0 +1,19 @@
+use 5.34.0;
+
+use Test2::V0;
+
+require './part1.pm';
+require './part2.pm';
+
+my $sample = part1::readFile('sample');
+my $input = part1::readFile('input');
+
+subtest part1 => sub {
+    is part1::solution( $sample->{ balls }, $sample->{ cards }  ) => 4512;
+    is part1::solution( $input->{ balls }, $input->{ cards }  ) => 49860;
+};
+
+subtest part2 => sub {
+    is part2::solution( $sample->{ balls }, $sample->{ cards }  ) => 1924;
+    is part2::solution( $input->{ balls }, $input->{ cards }  ) => 24628;
+};