#!/usr/bin/env perl use strict; use warnings; my @wordgrid = (); while (<>) { next if /^\s*$/; chomp; push @wordgrid, [ split //, $_ ]; } my @directions = ( [[0, 0], [1, 1], [2, 2], [3, 3]], [[0, 0], [-1, 1], [-2, 2], [-3, 3]], [[0, 0], [0, 1], [0, 2], [0, 3]], [[0, 0], [1, 0], [2, 0], [3, 0]], [[0, 0], [-1, -1], [-2, -2], [-3, -3]], [[0, 0], [1, -1], [2, -2], [3, -3]], [[0, 0], [-1, 0], [-2, 0], [-3, 0]], [[0, 0], [0, -1], [0, -2], [0, -3]], ); my @diagonal = ([-1, -1], [0, 0], [1, 1]); my @otherdiagonal = ([1, -1], [0, 0], [-1, 1]); my $xmas_count = 0; my $mas_cross_count = 0; for my $y (0 .. $#wordgrid) { for my $x (0 .. $#{$wordgrid[$y]}) { $xmas_count += grep { search_xmas([$x, $y], $_)} @directions; $mas_cross_count++ if search_max_cross([ $x, $y ]); } } print "Part 1: ", $xmas_count, "\n"; print "Part 2: ", $mas_cross_count, "\n"; sub search_xmas { my ($start, $offsets) = @_; my @letters = ("X", "M", "A", "S"); for my $i (0 .. $#letters) { my $cord = [$start->[0] + $offsets->[$i]->[0], $start->[1] + $offsets->[$i]->[1]]; return 0 if ( $cord->[1] < 0 || $cord->[1] > $#wordgrid || $cord->[0] < 0 || $cord->[0] > $#{$wordgrid[$cord->[1]]} ); return 0 if $wordgrid[$cord->[1]][$cord->[0]] ne $letters[$i]; } return 1; } sub search_max_cross { my $start = shift; return 0 if $wordgrid[$start->[1]][$start->[0]] ne "A"; return 0 if ( !search_mas($start, \@diagonal) && !search_mas($start, [reverse @diagonal]) ); return 0 if ( !search_mas($start, \@otherdiagonal) && !search_mas($start, [reverse @otherdiagonal]) ); return 1; } sub search_mas { my ($start, $offsets) = @_; my @letters = ("M", "A", "S"); for my $i (0 .. $#letters) { my $cord = [$start->[0] + $offsets->[$i]->[0], $start->[1] + $offsets->[$i]->[1]]; return 0 if ( $cord->[1] < 0 || $cord->[1] > $#wordgrid || $cord->[0] < 0 || $cord->[0] > $#{$wordgrid[$cord->[1]]} ); return 0 if $wordgrid[$cord->[1]][$cord->[0]] ne $letters[$i]; } return 1; }