aoc2022

Advent of Code 2022 solutions in Perl.
git clone git://git.samirparikh.com/aoc2022
Log | Files | Refs | README

Day12.pm (4793B) - raw


      1 package Day12;
      2 
      3 use strict;
      4 use warnings;
      5 use v5.32;
      6 use feature qw( signatures );
      7 no warnings qw( experimental::signatures );
      8 
      9 use Exporter qw( import );
     10 our @EXPORT = qw( define_matrix define_graph find_path );
     11 
     12 use Data::Dumper;
     13 
     14 use Log::Log4perl ();
     15 use Log::Log4perl::Level ();
     16 Log::Log4perl->easy_init(
     17     Log::Log4perl::Level::to_priority( 'OFF' )
     18 ); # set to 'OFF', 'INFO', 'DEBUG' or 'TRACE'  for successively more information
     19 my $logger = Log::Log4perl->get_logger();
     20 
     21 my $LIMIT = ord ( 'z' ) + 10;
     22 
     23 sub define_matrix ( $input )
     24 {
     25     my $matrix;
     26 
     27     push @$matrix => [ ( map{ ord( $_ ) } split // ), $LIMIT ] foreach (split /\n/, $input);
     28     push @$matrix => [ ( $LIMIT ) x scalar @{$matrix->[0]} ];
     29 
     30     return $matrix;
     31 }
     32 
     33 sub define_graph ( $matrix_ref )
     34 {
     35     my @mat = @{ $matrix_ref };
     36     my %neighbors;
     37     my %elevation;
     38     my $r = scalar @mat;
     39     my $c = scalar @{ $mat[ 0 ] };
     40     foreach my $row ( 0 .. $r - 2 )
     41     {
     42         foreach my $col ( 0 .. $c - 2 )
     43         {
     44             # default values
     45             my $key   = "$row:$col";
     46             my $value = $mat[ $row ][ $col ];
     47 
     48             if ( $value == ord( 'S' ) )
     49             {
     50                 $value = ord( 'a' );
     51                 push @{ $neighbors{ "start" } } => $key;
     52             }
     53 
     54             if ( $value == ord( 'E' ) )
     55             {
     56                 $value = ord( 'z' );
     57                 push @{ $neighbors{ $key } } => "end";
     58             }
     59             
     60             $elevation{ $key } = $value;
     61 
     62             foreach my $neighbor ( [0, 1], [1, 0], [0, -1], [-1, 0] )
     63             {
     64                 my $n_row = $row + $neighbor->[0];
     65                 my $n_col = $col + $neighbor->[1];
     66 
     67                 # it's possible we have to add a neighbor which is the end square
     68                 # but whose elevation needs to be set to ord( 'z' ), which is 122,
     69                 # rather than ord( 'E' ), which is 69.
     70                 my $neighbor_elevation = ( $mat[ $n_row ][ $n_col ] == ord( 'E' ) ) ?
     71                                          ord( 'z' ) :
     72                                          $mat[ $n_row ][ $n_col ];
     73                 # we don't want to update the value of $mat[ $n_row ][ $n_col ] just
     74                 # yet because we have to process the end node above
     75 
     76                 push @{ $neighbors{ $key } } => "$n_row:$n_col"
     77                     unless ( $neighbor_elevation > $value + 1 );
     78             }
     79         }
     80     }
     81     return ( \%neighbors, \%elevation );
     82 }
     83 
     84 # arguments are reference to hash containing neighbors and reference to hash
     85 # containing elevations
     86 sub find_path ( $n, $e )
     87 {
     88     # hash that stores reference to array that contains the square's neighbors
     89     my %neighbors = %{ $n };
     90 
     91     # hash that stores square's elevation
     92     my %elevation = %{ $e };
     93 
     94     # hash that stores whether or not the square has already been searched
     95     my %searched;
     96 
     97     my $search = "start";
     98 
     99     # hash that stores reference to array that contains squares visited to
    100     # reach current squaure
    101     my %paths;
    102     $paths{ $search } = [ ];
    103 
    104     # array that stores list of squares to be searched
    105     my @queue = ( $search );
    106 
    107     while ( @queue )
    108     {
    109         $logger->debug( "queue is @queue" );
    110         my $square = shift @queue;
    111         $logger->info( "checking $square" );
    112         # unless we've already searched this square
    113         unless ( $searched{ $square } )
    114         {
    115             # check if we've found the "end" square
    116             if ( $square eq "end" )
    117             {
    118                 $logger->info( "we found the end" );
    119                 $logger->info( "we got here via ",
    120                                ( join " > ", @{ $paths{ $square } }, $square ) );
    121                 # don't need "start" to first square or end square to "end"
    122                 return ( scalar @{ $paths{ $square } } ) - 2;
    123             }
    124             else
    125             {
    126                 $logger->info( "$square is not the end" );
    127                 # add all of $square's neighbors to the queue
    128                 foreach my $neighbor ( @{ $neighbors{ $square } } )
    129                 {
    130                     unless ( $searched{ $neighbor } )
    131                     {
    132                         $logger->trace( "adding $square to $neighbor path" );
    133                         @{ $paths{ $neighbor } } = ( @{ $paths{ $square } }, $square );
    134                         $logger->trace( "path to $neighbor is now ",
    135                                         join "->", @{ $paths{ $neighbor } } );
    136                         $logger->trace( "adding $neighbor to the queue" );
    137                         push @queue => $neighbor;
    138                     }
    139                 }
    140                 # add the just searched $sqaure to the searched hash
    141                 $searched{ $square } = 1;
    142             }
    143         }
    144     }
    145 
    146     return 0; # end square not found
    147 }
    148 
    149 1;