Merge branch '2023-03'

2023/03/Part1.pm

@@ -0,0 +1,45 @@
+use 5.38.0;
+
+package Part1;
+
+use List::AllUtils qw/pairmap max sum /;
+
+sub find_numbers($line) {
+    my @entries;
+    while ( $line =~ /\d+/g ) {
+        push @entries => {
+            prefix => length $`,
+            length => length $&,
+            n => 0+$&,
+        };
+    }
+    return @entries;
+}
+
+sub near_symbol($numb,$lines) {
+        no warnings;
+    my $surrounding = join "", map {
+        substr $lines->[$_+$numb->{line}],
+            max($numb->{prefix}-1,0),
+            $numb->{length}+2
+    }  -1..1;
+
+    return $surrounding =~ /[^.\d]/;
+}
+
+sub numbers_near_symbols($input) {
+    my @lines = split "\n", $input;
+    unshift @lines, '';
+
+    my @numbers = pairmap { map { +{ %$_, line => $a } } @$b } map { $_ => [find_numbers($lines[$_])] } 1..$#lines;
+
+    @numbers = grep { near_symbol($_,\@lines) } @numbers;
+    return @numbers;
+}
+
+sub solution_1 ($input) {
+    my @numbers = numbers_near_symbols($input);
+    return sum map { $_->{n}} @numbers;
+}
+
+1;

2023/03/Part2.pm

@@ -0,0 +1,54 @@
+use 5.38.0;
+
+package Part2;
+
+use Part1;
+
+use List::AllUtils qw/ product sum /;
+
+sub find_gears($input) {
+    my @lines = split "\n", $input;
+    unshift @lines, '';
+
+    my @entries;
+
+    for my $i ( 1..$#lines ) {
+        my $line = $lines[$i];
+    while ( $line =~ /\*/g ) {
+        push @entries => {
+            prefix => length $`,
+            length => length $&,
+            line => $i,
+        };
+    }
+}
+    return @entries;
+}
+
+sub number_near_gear($gear,$number) {
+    return if abs( $number->{line} - $gear->{line} ) > 1;
+
+    return ($number->{prefix} <= $gear->{prefix} + 1 and $number->{prefix}+$number->{length} >= $gear->{prefix} ); 
+
+}
+
+sub numbers_near_gear($gear,@numbers) {
+    return grep { number_near_gear($gear,$_)} @numbers;
+}
+
+sub solution_2 ($input) {
+    my @numbers = Part1::numbers_near_symbols($input);
+    my @gears = find_gears($input);
+
+    my $sum = 0;
+
+    for my $gear ( @gears ) {
+        my @near = numbers_near_gear($gear,@numbers);
+        next unless @near == 2;
+        $sum += product map { $_->{n} } @near;
+    }
+
+    return $sum;
+}
+
+1;

2023/03/benchmark.pl

@@ -0,0 +1,45 @@
+use 5.38.0;
+
+use Benchmark ':hireswallclock';
+use Path::Tiny;
+use JSON qw/ to_json /;
+use DateTime;
+use File::Serialize;
+
+use Part1;
+use Part2;
+
+my $solutions = deserialize_file('solutions.yml');
+
+my $day = path('.')->absolute->basename =~ s/^0//r;
+my $year = path('.')->absolute->parent->basename;
+
+my @parts = (
+    { part => 1, sub => \&Part1::solution_1, expected => $solutions->{1} },
+    { part => 2, sub => \&Part2::solution_2, expected => $solutions->{2} },
+);
+
+my $input = path('./input')->slurp;
+
+for my $part (@parts) {
+    my $res = Benchmark::countit(
+        10,
+        sub {
+            $part->{sub}->($input) == $part->{expected} or die;
+        }
+    );
+
+    my $result = {
+        day  => $day,
+        year => $year,
+
+#        variant => 'v2',
+        language  => 'perl',
+        part      => $part->{part},
+        time      => $res->cpu_a / $res->iters,
+        parsec    =>$res->iters/$res->cpu_a ,
+        timestamp => DateTime->now->iso8601,
+    };
+    say to_json $result;
+}
+

2023/03/part1.t

@@ -0,0 +1,37 @@
+use 5.38.0;
+
+use Test2::V0;
+
+use Path::Tiny;
+
+use Part1;
+
+my $input = path('input')->slurp;
+
+my $example = <<'END';
+467..114..
+...*......
+..35..633.
+......#...
+617*......
+.....+.58.
+..592.....
+......755.
+...$.*....
+.664.598..
+END
+
+is [Part1::find_numbers('467..114..')] => [
+    { n => 467, prefix => 0, length =>3 },
+    { n => 114, prefix => 5, length =>3 },
+];
+
+my @n = Part1::numbers_near_symbols($example);
+is 0+@n => 8;
+is [ map { $_->{n}} @n] => [467,35,633,617,592,755,664,598];
+
+is Part1::solution_1($example) => 4361;
+
+is Part1::solution_1($input) => 'TODO';
+
+done_testing;

2023/03/part2.t

@@ -0,0 +1,30 @@
+use 5.38.0;
+
+use Test2::V0;
+
+use Path::Tiny;
+
+use Part2;
+
+my $input = path('input')->slurp;
+
+my $example = <<'END';
+467..114..
+...*......
+..35..633.
+......#...
+617*......
+.....+.58.
+..592.....
+......755.
+...$.*....
+.664.598..
+END
+
+
+is Part2::solution_2($example) => 467835;
+
+
+is Part2::solution_2($input) => 'TODO';
+
+done_testing;

2023/03/solutions.yml

@@ -0,0 +1,2 @@
+1: 529618
+2: 77509019

2023/benchmark.json

@@ -4,5 +4,7 @@
 {"day":1,"year":2023,"language":"javascript","part":"2","timestamp":"2023-12-01T20:55:40.989Z","time":0.004363576172638605,"persec":229.1698277826353}
 {"language":"perl","timestamp":"2023-12-02T16:40:42","part":1,"day":"2","persec":297.067171239357,"year":"2023","time":0.00336624203821656}
 {"language":"perl","timestamp":"2023-12-02T16:40:55","part":2,"day":"2","time":0.00338658146964856,"year":"2023","persec":295.283018867925}
-{"timestamp":"2023-12-02T18:29:20","day":"2","part":1,"variant":"v2","year":"2023","time":0.00388473053892216,"language":"perl","parsec":257.418111753372}
-{"day":"2","timestamp":"2023-12-02T18:29:32","part":2,"year":"2023","variant":"v2","parsec":258.117195004803,"language":"perl","time":0.00387420915519166}
+{"timestamp":"2023-12-02T18:29:20","day":"2","part":1,"variant":"v2","year":"2023","time":0.00388473053892216,"language":"perl","persec":257.418111753372}
+{"day":"2","timestamp":"2023-12-02T18:29:32","part":2,"year":"2023","variant":"v2","persec":258.117195004803,"language":"perl","time":0.00387420915519166}
+{"time":0.00837944664031621,"timestamp":"2023-12-03T20:10:46","parsec":119.339622641509,"day":"3","year":"2023","part":1,"language":"perl"}
+{"year":"2023","day":"3","parsec":4.03940886699507,"language":"perl","part":2,"time":0.247560975609756,"timestamp":"2023-12-03T20:10:59"}

2023/preset/day/templates/perl/benchmark.pl

@@ -9,7 +9,7 @@ use Part1;
 use Part2;
 
 my $day = path('.')->absolute->basename =~ s/^0//r;
-my $year = path('.')->absolute->dir->basename;
+my $year = path('.')->absolute->parent->basename;
 
 my @parts = (
     { part => 1, sub => \&Part1::solution_1, expected => 'TODO' },

2023/preset/day/templates/perl/part1.t

@@ -9,3 +9,5 @@ use Part1;
 my $input = path('input')->slurp;
 
 is Part1::solution_1($input) => 'TODO';
+
+done_testing;

2023/preset/day/templates/perl/part2.t

@@ -9,3 +9,5 @@ use Part2;
 my $input = path('input')->slurp;
 
 is Part2::solution_2($input) => 'TODO';
+
+done_testing;

2023/preset/day/templates/perl/solutions.yml

@@ -0,0 +1,2 @@
+1: TODO
+2: TODO