Skip to content

Commit cf418c6

Browse files
tobyinktobyink
committed
Dat 24 in Perl
1 parent 3953e4f commit cf418c6

File tree

13 files changed

+499
-2
lines changed

13 files changed

+499
-2
lines changed

‎2022/24/Perl/Makefile

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
.PHONY: all
2+
all: deps run
3+
4+
.PHONY: deps
5+
deps:
6+
cpanm -n --cpanfile cpanfile --installdeps .
7+
8+
.PHONY: clean
9+
clean:
10+
11+
.PHONY: run
12+
run:
13+
perl -Ilib bin/main.pl

‎2022/24/Perl/bin/main.pl

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
#!perl
2+
use v5.24;
3+
use warnings;
4+
use experimental qw( signatures );
5+
use constant FILENAME => $ENV{ADVENT_INPUT};
6+
7+
use Data::Dumper;
8+
use State ();
9+
use State::Start ();
10+
use Valley ();
11+
12+
sub part1 () {
13+
my $state = Valley::->read_from_file( FILENAME )
14+
->starting_state
15+
->find_path_until( sub ( $state ) {
16+
$state->isa( 'State::End' )
17+
} );
18+
say "PART1: ", $state->minute;
19+
}
20+
21+
sub part2 () {
22+
my $valley = Valley::->read_from_file( FILENAME );
23+
24+
my $first_trip = $valley
25+
->starting_state
26+
->find_path_until( sub ( $state ) {
27+
$state->isa( 'State::End' )
28+
} );
29+
say "Initial trip in ", $first_trip->minute, " minutes.";
30+
31+
my $second_trip = $valley
32+
->ending_state( $first_trip->minute )
33+
->find_path_until( sub ( $state ) {
34+
$state->isa( 'State::Start' )
35+
} );
36+
say "Back tracking brought us to ", $second_trip->minute, " minutes.";
37+
38+
my $third_trip = $valley
39+
->starting_state( $second_trip->minute )
40+
->find_path_until( sub ( $state ) {
41+
$state->isa( 'State::End' )
42+
} );
43+
say "Final trip brought us to ", $third_trip->minute, " minutes.";
44+
45+
say "PART2: ", $third_trip->minute; # 803 too low?
46+
}
47+
48+
unless ( caller ) {
49+
part1();
50+
part2();
51+
}
52+

‎2022/24/Perl/cpanfile

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
requires 'Moo';
2+
requires 'Types::Common';
3+
requires 'List::UtilsBy';

‎2022/24/Perl/lib/Blizzard.pm

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
use v5.24;
2+
use warnings;
3+
4+
package Blizzard;
5+
6+
use Moo;
7+
use Types::Common -types;
8+
use experimental qw( signatures );
9+
10+
has valley => ( is => 'rw', isa => Object, weak_ref => !!1 );
11+
has init_row => ( is => 'ro', isa => PositiveOrZeroInt );
12+
has init_col => ( is => 'ro', isa => PositiveOrZeroInt );
13+
has direction => ( is => 'ro', isa => PositiveOrZeroInt );
14+
15+
use constant {
16+
NORTH => 1,
17+
EAST => 2,
18+
SOUTH => 4,
19+
WEST => 8,
20+
};
21+
22+
sub position_at_minute ( $self, $minute ) {
23+
my $row = $self->init_row;
24+
my $col = $self->init_col;
25+
my $dir = $self->direction;
26+
27+
if ( $dir == NORTH ) {
28+
$row -= $minute;
29+
$row %= $self->valley->height;
30+
}
31+
elsif ( $dir == SOUTH ) {
32+
$row += $minute;
33+
$row %= $self->valley->height;
34+
}
35+
elsif ( $dir == WEST ) {
36+
$col -= $minute;
37+
$col %= $self->valley->width;
38+
}
39+
elsif ( $dir == EAST ) {
40+
$col += $minute;
41+
$col %= $self->valley->width;
42+
}
43+
44+
return ( $row, $col );
45+
}
46+
47+
1;

‎2022/24/Perl/lib/Map.pm

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
use v5.24;
2+
use warnings;
3+
4+
package Map;
5+
6+
use Moo;
7+
use Types::Common -types;
8+
use experimental qw( signatures );
9+
10+
use constant {
11+
EMPTY => 0,
12+
BLIZZARD_N => 1,
13+
BLIZZARD_E => 2,
14+
BLIZZARD_S => 4,
15+
BLIZZARD_W => 8,
16+
WALL => 16,
17+
};
18+
19+
has valley => ( is => 'ro', isa => Object, weak_ref => !!1 );
20+
has grid => ( is => 'ro', isa => ArrayRef );
21+
22+
sub has_empty_square ( $self, $row, $col ) {
23+
$self->grid->[$row][$col] == EMPTY
24+
}
25+
26+
sub draw ( $self, $E = undef ) {
27+
my $str = '#.' . ( '#' x $self->valley->width ) . "\n";
28+
for my $row ( $self->grid->@* ) {
29+
$str .= '#';
30+
for my $cell ( $row->@* ) {
31+
$str .=
32+
( $cell == EMPTY ) ? '.' :
33+
( $cell == WALL ) ? '#' :
34+
( $cell == BLIZZARD_N ) ? '^' :
35+
( $cell == BLIZZARD_E ) ? '>' :
36+
( $cell == BLIZZARD_S ) ? 'v' :
37+
( $cell == BLIZZARD_W ) ? '<' : 'X';
38+
}
39+
$str .= "#\n";
40+
}
41+
$str .= ( '#' x $self->valley->width ) . ".#\n";
42+
43+
if ( $E ) {
44+
my ( $e_row, $e_col ) = $E->@*;
45+
my @lines = split /\n/, $str;
46+
substr( $lines[$e_row + 1], $e_col + 1, 1 ) = 'E';
47+
$str = join "\n", @lines;
48+
}
49+
50+
chomp $str;
51+
return $str;
52+
}
53+
54+
1;

‎2022/24/Perl/lib/State.pm

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,122 @@
1+
use v5.24;
2+
use warnings;
3+
4+
package State;
5+
6+
use Moo;
7+
use Types::Common -types;
8+
use List::UtilsBy qw( uniq_by );
9+
use experimental qw( signatures );
10+
11+
has valley => ( is => 'ro', isa => Object, required => !!1 );
12+
has parent => ( is => 'ro', isa => Object, predicate => !!1 );
13+
has minute => ( is => 'ro', isa => PositiveOrZeroInt );
14+
has row => ( is => 'ro', isa => PositiveOrZeroInt );
15+
has col => ( is => 'ro', isa => PositiveOrZeroInt );
16+
17+
sub as_string ( $self ) {
18+
sprintf( 'q[%d:%d,%d]', $self->minute, $self->row, $self->col );
19+
}
20+
21+
sub _maybe_safe_state ( $self, $minute, $row, $col ) {
22+
my $map = $self->valley->map_for_minute( $minute );
23+
return if $row < 0;
24+
return if $col < 0;
25+
return if $row >= $self->valley->height;
26+
return if $col >= $self->valley->width;
27+
return unless $map->has_empty_square( $row, $col );
28+
return ref($self)->new(
29+
valley => $self->valley,
30+
parent => $self,
31+
minute => $minute,
32+
row => $row,
33+
col => $col,
34+
);
35+
}
36+
37+
sub next_states ( $self ) {
38+
my @states;
39+
40+
if ( $self->row == $self->valley->height - 1
41+
and $self->col == $self->valley->width - 1 ) {
42+
# We are in the extreme south east of the valley.
43+
# The end state is possible!!!
44+
require State::End;
45+
push @states, 'State::End'->new(
46+
valley => $self->valley,
47+
parent => $self,
48+
minute => $self->minute + 1,
49+
);
50+
}
51+
52+
if ( $self->row == 0
53+
and $self->col == 0 ) {
54+
# We are in the extreme north west of the valley.
55+
# The start state is possible!!!
56+
require State::Start;
57+
push @states, 'State::Start'->new(
58+
valley => $self->valley,
59+
parent => $self,
60+
minute => $self->minute + 1,
61+
);
62+
}
63+
64+
# Depending on the openings on the map, there are up to five possible
65+
# states that can be returned:
66+
67+
# 1. State where we move right.
68+
push @states, $self->_maybe_safe_state(
69+
$self->minute + 1,
70+
$self->row,
71+
$self->col + 1,
72+
);
73+
74+
# 2. State where we move down.
75+
push @states, $self->_maybe_safe_state(
76+
$self->minute + 1,
77+
$self->row + 1,
78+
$self->col,
79+
);
80+
81+
# 3. State where we don't move.
82+
push @states, $self->_maybe_safe_state(
83+
$self->minute + 1,
84+
$self->row,
85+
$self->col,
86+
);
87+
88+
# 4. State where we move up.
89+
push @states, $self->_maybe_safe_state(
90+
$self->minute + 1,
91+
$self->row - 1,
92+
$self->col,
93+
);
94+
95+
# 5. State where we move left.
96+
push @states, $self->_maybe_safe_state(
97+
$self->minute + 1,
98+
$self->row,
99+
$self->col - 1,
100+
);
101+
102+
return @states;
103+
}
104+
105+
sub draw ( $self ) {
106+
my $map = $self->valley->map_for_minute( $self->minute );
107+
return $map->draw( [ $self->row, $self->col ] );
108+
}
109+
110+
sub find_path_until ( $self, $callback ) {
111+
my @states = ( $self );
112+
my $minutes = 0;
113+
while ( @states ) {
114+
@states = uniq_by { $_->as_string } map $_->next_states, @states;
115+
++$minutes;
116+
my @ends = grep $callback->( $_ ), @states;
117+
return $ends[0] if @ends;
118+
}
119+
die "Ran out of states?!";
120+
}
121+
122+
1;

‎2022/24/Perl/lib/State/End.pm

Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
use v5.24;
2+
use warnings;
3+
4+
package State::End;
5+
6+
use Moo;
7+
use Types::Common -types;
8+
use experimental qw( signatures );
9+
10+
use State ();
11+
12+
extends 'State';
13+
14+
has '+row' => ( is => 'rwp', init_arg => undef );
15+
has '+col' => ( is => 'rwp', init_arg => undef );
16+
17+
sub BUILD ( $self, $args ) {
18+
$self->_set_row( $self->valley->height );
19+
$self->_set_col( $self->valley->width - 1 );
20+
}
21+
22+
sub next_states ( $self ) {
23+
24+
my $next_minute = $self->minute + 1;
25+
my $map = $self->valley->map_for_minute( $next_minute );
26+
my @states;
27+
28+
# State where we enter valley.
29+
{
30+
my $row = $self->valley->height - 1;
31+
my $col = $self->valley->width - 1;
32+
push @states, State::->new(
33+
valley => $self->valley,
34+
parent => $self,
35+
minute => $next_minute,
36+
row => $row,
37+
col => $col,
38+
) if $map->has_empty_square( $row, $col );
39+
}
40+
41+
# State where we go nowhere.
42+
push @states, ref($self)->new(
43+
valley => $self->valley,
44+
parent => $self,
45+
minute => $next_minute,
46+
);
47+
48+
return @states;
49+
}
50+
51+
1;

‎2022/24/Perl/lib/State/Start.pm

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
use v5.24;
2+
use warnings;
3+
4+
package State::Start;
5+
6+
use Moo;
7+
use Types::Common -types;
8+
use experimental qw( signatures );
9+
10+
use State ();
11+
12+
extends 'State';
13+
14+
has '+row' => ( isa => Int, init_arg => undef, default => -1 );
15+
has '+col' => ( isa => Int, init_arg => undef, default => 0 );
16+
17+
sub next_states ( $self ) {
18+
19+
my $next_minute = $self->minute + 1;
20+
my $map = $self->valley->map_for_minute( $next_minute );
21+
my @states;
22+
23+
# State where we enter valley.
24+
{
25+
my $row = $self->row + 1;
26+
my $col = $self->col;
27+
push @states, State::->new(
28+
valley => $self->valley,
29+
parent => $self,
30+
minute => $next_minute,
31+
row => $row,
32+
col => $col,
33+
) if $map->has_empty_square( $row, $col );
34+
}
35+
36+
# State where we go nowhere.
37+
push @states, ref($self)->new(
38+
valley => $self->valley,
39+
parent => $self,
40+
minute => $next_minute,
41+
);
42+
43+
return @states;
44+
}
45+
46+
1;

0 commit comments

Comments
 (0)