Advent of Code 2018 solutions

These are my solutions for this year's contest.

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my @list = @input;
my $freq = 0;
while (@list) {
    my $next = shift @list;
    $freq = $freq + $next;
}

say "Part 1: ", $freq;

my %seen = ( 0 => 1 );
$freq = 0;
my $loopcount = 0;
LOOP:
while (1) {
    my @list = @input;

    #    warn "==> $loopcount";
    while (@list) {
        my $next = shift @list;
        $freq = $freq + $next;
        $seen{$freq}++;
        if ( $seen{$freq} > 1 ) {
            last LOOP;
        }
    }
    $loopcount++;
}
say "Part 2: ", $freq;

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $count_2;
my $count_3;
foreach my $str (@input) {
    my %freq;
    foreach my $chr ( split( //, $str ) ) {
        $freq{$chr}++;
    }
    my $flag_2 = 0;
    my $flag_3 = 0;
    foreach my $k ( keys %freq ) {
        $flag_2++ if $freq{$k} == 2;
        $flag_3++ if $freq{$k} == 3;
    }
    $count_2++ if $flag_2;
    $count_3++ if $flag_3;
}

say "Part 1: ", $count_2 * $count_3;

LOOP:
foreach my $str1 (@input) {
    foreach my $str2 (@input) {
        next if ( $str1 eq $str2 );

        my @a1 = split( //, $str1 );
        my @a2 = split( //, $str2 );
        my @diffs;
        for ( my $i = 0 ; $i < scalar @a1 ; $i++ ) {
            if ( $a1[$i] ne $a2[$i] ) {
                push @diffs, $i;
            }
        }

        if ( scalar @diffs == 1 ) {
            my $res;
            my $same = $diffs[0];
            for ( my $i = 0 ; $i < scalar @a1 ; $i++ ) {
                $res .= $a1[$i] unless $i == $same;
            }
            say "Part 2: ", $res;
            last LOOP;
        }
    }
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my %swatches;
foreach my $line (@input) {
    if ( $line =~ m/\#(\d+)\ \@\ (\d+)\,(\d+)\:\ (\d+)x(\d+)/ ) {
	$swatches{$1} = { col => $2, row => $3, w => $4, h => $5 };
    }
    else {
        die "can't parse: $line";
    }
}

# populate the grid
my %grid;
foreach my $id ( keys %swatches ) {
    my ( $col, $row, $w, $h ) = map { $swatches{$id}->{$_} } qw/col row w h/;
    for ( my $c = $col ; $c < $col + $w ; $c++ ) {
        for ( my $r = $row ; $r < $row + $h ; $r++ ) {
            push @{ $grid{$c}->{$r} }, $id;
        }
    }
}

# count populated
my $count;
my %candidates;
foreach ( my $c = 0 ; $c < 1000 ; $c++ ) {
    foreach ( my $r = 0 ; $r < 1000 ; $r++ ) {
        next unless exists $grid{$c}->{$r};
        $count++ if scalar @{ $grid{$c}->{$r} } > 1;

        # which swatches are only on one square?
        if ( scalar @{ $grid{$c}->{$r} } == 1 ) {
            push @{ $candidates{ $grid{$c}->{$r}->[0] } }, [ $c, $r ];
        }
    }
}

say "Part 1: ", $count;

# compare one-square candidates with known swatches
# it turns out there's only one!
foreach my $id ( keys %candidates ) {

    if ( $swatches{$id}->{w} * $swatches{$id}->{h} ==
        scalar @{ $candidates{$id} } )
    {
        say "Part 2: ", $id;
    }
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum minstr maxstr/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $debug = 0;
my $id    = undef;
my %stats;
my %minutes;
my $awake = undef;
my ( $start, $end ) = ( undef, undef );
foreach my $line ( sort @input ) {
    my ( $h, $m ) = $line =~ m/ (\d{2}):(\d{2})\]/;
    if ( $line =~ m/Guard \#(\d+)/ ) {
        $id    = $1;
        $awake = 1;
        ( $start, $end ) = ( undef, undef );
    }
    if ( $line =~ m/falls asleep/ and $awake ) {
        $awake = 0;
        $start = $m;
    }
    if ( $line =~ m/wakes up/ and !$awake ) {
        $awake = 1;
        $end   = $m;
    }
    if ( defined $start and defined $end ) {
        push @{ $stats{$id}->{spans} }, [ $start, $end ];
        for ( my $i = $start ; $i < $end ; $i++ ) {
            $stats{$id}->{freq}->{$i}++;
            $minutes{$i}->{$id}++;
        }
        ( $start, $end ) = ( undef, undef );
    }
}

# Part 1

# Find the guard that has the most minutes asleep. What minute does
# that guard spend asleep the most?

my $maxsum = { id => -1, val => 0 };
foreach my $id ( keys %stats ) {
    my $sum = 0;
    foreach my $span ( @{ $stats{$id}->{spans} } ) {
        $sum += $span->[1] - $span->[0];
    }
    if ( $sum > $maxsum->{val} ) {
        $maxsum->{val} = $sum;
        $maxsum->{id}  = $id;
    }
}
my $sought_id = $maxsum->{id};

my $most_m = (
    sort {
        $stats{$sought_id}->{freq}->{$b} <=> $stats{$sought_id}->{freq}->{$a}
    } keys %{ $stats{$sought_id}->{freq} }
)[0];

say "Part 1: ", $sought_id * $most_m;

# Part 2

# Of all guards, which guard is most frequently asleep on the same minute?

my $maxasleep = { val => 0, id => -1, sought => 0 };

foreach my $min ( sort { $a <=> $b } keys %minutes ) {
    my $most_asleep = ( sort { $minutes{$min}->{$b} <=> $minutes{$min}->{$a} }
          keys %{ $minutes{$min} } )[0];

    if ( $minutes{$min}->{$most_asleep} > $maxasleep->{val} ) {
        $maxasleep->{val}    = $minutes{$min}->{$most_asleep};
        $maxasleep->{id}     = $most_asleep;
        $maxasleep->{sought} = $min;
    }
}

say "Part 2: ", $maxasleep->{sought} * $maxasleep->{id};

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

sub is_match {
    my ( $k, $m ) = @_;

    #my @in = split(//,$in);
    if ( abs( ord( $k ? $k : '' ) - ord($m) ) == 32 ) {
        return 1;
    }
    else {
        return 0;
    }
}

sub reduce {
    my ($str) = @_;
    my @in = split( //, $str );
    my @next;
    push @next, shift @in;
    while (@in) {
        my $unit = shift @in;
        if ( is_match( $next[-1], $unit ) ) {
            pop @next;
        }
        else {
            push @next, $unit;
        }
    }
    return scalar @next;
}

say "Part 1: ", reduce( $input[0] );

my $min = length( $input[0] );
foreach my $c ( 'a' .. 'z' ) {
    my $u         = uc $c;
    my $shortened = $input[0];
    $shortened =~ s/[$c,$u]//g;
    if ( $min > reduce($shortened) ) {
        $min = reduce($shortened);
    }
}
say "Part 2: $min";

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

sub manhattan_distance {
    my ( $p, $q ) = (@_);
    return abs( $p->[0] - $q->[0] ) + abs( $p->[1] - $q->[1] );
}
my $LIMIT = $testing ? 32 : 10000;

my $index = 1;

my @labels = ( 'A' .. 'F' );    # for testing

my %points;
my ( $maxcol, $maxrow ) = ( 0,    0 );
my ( $mincol, $minrow ) = ( 10e6, 10e6 );
foreach my $line (@input) {
    my ( $c, $r ) = $line =~ /(\d+)\,\ (\d+)/;
    $maxcol = $c if $c > $maxcol;
    $maxrow = $r if $r > $maxrow;
    $mincol = $c if $c < $mincol;
    $minrow = $r if $r < $minrow;

    my $label = $testing ? shift @labels : $index;
    $points{$label} = { row => $r, col => $c };
    $index++;

}

my @sought;
my %areas;
my %on_edges;
foreach my $r ( $minrow .. $maxrow ) {
    foreach my $c ( $mincol .. $maxcol ) {

        my %dists;
        foreach my $label ( keys %points ) {
            next if $label eq '.';

            # calculate the manhattan_distance to each point from where we are
            # add to the tally of closest
            my $d =
              manhattan_distance( [ map { $points{$label}->{$_} } qw/col row/ ],
                [ $c, $r ] );
            push @{ $dists{$d} }, $label;

        }

        my $sum;
        my $count = 0;
        foreach my $d ( sort { $a <=> $b } keys %dists ) {
            if ( !$count ) {
                my @closest = @{ $dists{$d} };
                if ( scalar @closest == 1 ) {
                    $points{ $closest[0] }->{count}++;
                    $on_edges{ $closest[0] }++
                      if ( $c == $mincol
                        or $c == $maxcol
                        or $r == $minrow
                        or $r == $maxrow );
                }
                else {    # more than 2 coordinates closest
                    $points{'.'}->{count}++;
                }

            }
            $sum += $d * scalar @{ $dists{$d} };
            $count++;
        }
        if ( $sum < $LIMIT ) {
            push @sought, [ $r, $c ];
        }
    }
}

my $largest_id = (
    grep { !exists $on_edges{$_} }
    sort { $points{$b}->{count} <=> $points{$a}->{count} } keys %points
)[0];
say "Part 1: ", $points{$largest_id}->{count};
say "Part 2: ", scalar @sought;

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my %graph;
foreach my $line (@input) {
    my ( $input, $output ) = $line =~ /^Step (.) .*step (.) can begin.$/;
    $graph{$output}->{from}->{$input}++;
    $graph{$input}->{to}->{$output}++;
}
my @queue;

push @queue,
  sort grep { scalar keys %{ $graph{$_}->{from} } == 0 } keys %graph;

my @result;
my %processed;
while (@queue) {
    my $next = shift @queue;
    push @result, $next;
    $processed{$next}++;

    my @possible = keys %{ $graph{$next}->{to} };

    # can we add to queue?
    while (@possible) {
        my $candidate = shift @possible;
        my $ok        = 1;
        foreach my $r ( keys %{ $graph{$candidate}->{from} } ) {
            $ok = 0 unless exists $processed{$r};
        }
        push @queue, $candidate if $ok;
    }
    @queue = sort @queue;

}

say "Part 1: ", @result;

#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

my $threshold = $testing? 0 : 60;

sub time_per_task {
    my ( $label ) = @_;
    return $threshold + ord( $label ) - 64;
}
my $no_of_workers = $testing ? 2 : 5;
my %graph;
foreach my $line (@input) {
    my ( $input, $output ) = $line =~ /^Step (.) .*step (.) can begin.$/;
    $graph{$output}->{from}->{$input}++;
    $graph{$input}->{to}->{$output}++;

}

my @queue;
push @queue, sort grep {scalar keys %{$graph{$_}->{from}}==0}  keys %graph;
my @result;
my @workers = (1..$no_of_workers);
my @processing;
my %processed;
my $time = 0;
my %pool;
# seed the pool
for (@queue ) {
    my $w = shift @workers;
    $pool{$_} = {worker=>$w, time=>time_per_task( $_ )} if defined $w;
}

sub dump_state {
    my $ws;
    foreach my $k(sort keys %pool) {
	$ws .= "$k w=$pool{$k}->{worker} t=$pool{$k}->{time} ";
    }
    printf("T=%4d Q=(%s) R=(%s) W=[ %s]\n",
	  $time, join('',@queue),join('',@result),$ws?$ws:'');
}
dump_state if $debug;
while (@queue) {
    # scan the pool, decrementing time
    my @finished;
    while (my ($task, $data) = each %pool)      {
	$data->{time}--;
	if ($data->{time}==0) {
	   push @finished,$task;
	    push @workers, $data->{worker};
	    delete $pool{$task}
	}
    }
    while (@finished) {
	my $done =shift @finished;
	push @result, $done;
	$processed{$done}++;
	# modify the queue
	my @newqueue;
	while (@queue) {
	    my $val = shift @queue;
	    push @newqueue, $val unless $val eq $done;
	}
	@queue = @newqueue;

	# we have processed stuff, so check for new entries
	my @possible = keys %{$graph{$done}->{to}};
	# can we add to queue?
	while (@possible) {
	    my $candidate = shift @possible;
	    my $ok =1;
	    foreach my $r (keys %{$graph{$candidate}->{from}}) {
		$ok = 0 unless exists $processed{$r};
	    }
	    push @queue, $candidate if $ok;
	}
	# assign new worker
	@queue = sort @queue;
	for (@queue) {
	    next if exists $pool{$_};
	    my $w = shift @workers;

	    $pool{$_} = {worker => $w, time=>time_per_task( $_ )}
	      if defined $w;

	}
    }
    $time++;
    dump_state if $debug;

}

say "Part 2: ",$time;

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $data = [ split / /, $input[0] ];

sub parse_tree;
sub get_meta_sum;
sub get_node_values;

my $tree = parse_tree($data);

say "Part 1: ", get_meta_sum($tree);
say "Part 2: ", get_node_values($tree);

sub parse_tree {
    my ($in) = @_;
    my ( $nr_children, $nr_meta ) = splice @{$in}, 0, 2;
    my $node;
    foreach ( 1 .. $nr_children ) {
        push @{ $node->{C} }, parse_tree($in);
    }
    $node->{M} = [ splice @{$in}, 0, $nr_meta ];
    return $node;
}

sub get_meta_sum {
    my ($in) = @_;
    my $sum;
    foreach my $node ( @{ $in->{C} } ) {
        $sum += get_meta_sum($node);
    }
    $sum += sum @{ $in->{M} };
    return $sum;
}

sub get_node_values {
    my ($in) = @_;
    my $sum;
    if ( @{ $in->{C} } ) {
        foreach my $m ( @{ $in->{M} } ) {
            $sum += get_node_values( $in->{C}->[ $m - 1 ] )
              if defined $in->{C}->[ $m - 1 ];
        }
    }
    else {
        $sum += sum @{ $in->{M} };
    }

    return $sum;
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum max/;

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my ( $no_of_players, $last_marble ) =
  $input[0] =~ /^(\d+).* worth (\d+) points/;

# give an argument, any argument, for part 2
my $part2 = shift @ARGV // undef;

my @players = ( 1 .. $no_of_players );
my %score;
sub add_to_circle;
sub remove_from_circle;
sub print_circle;

# initialize our data structure (circular double-linked list
my $circle->{0} = { next => 0, prev => 0 };
my $current = 0;
$last_marble = 100 * $last_marble if $part2;
my @marbles = ( 1 .. $last_marble );
while (@marbles) {

    my @list = @players;

    # play
    while (@list) {
        my $current_player = shift @list;
        my $marble         = shift @marbles;
        last unless defined $marble;    # don't overrun the number of marbles!
        if ( $marble % 23 == 0 ) {
            my $removed = remove_from_circle;
            $score{$current_player} += ( $marble + $removed );
        }
        else {
            $current = add_to_circle($marble);
        }
    }
}

say 'Part ', $part2 ? '2: ' : '1: ', max values %score;

sub add_to_circle {
    my ($new_val) = @_;
    my $one       = $circle->{$current}->{next};
    my $two       = $circle->{$one}->{next};

    # insert between one and two
    $circle->{$new_val}->{prev} = $one;
    $circle->{$new_val}->{next} = $two;

    $circle->{$one}->{next} = $new_val;
    $circle->{$two}->{prev} = $new_val;
    return $new_val;
}

sub remove_from_circle {

    my $steps   = 0;
    my $pointer = $current;

    # hardcoded 7 steps
    while ( $steps < 7 ) {
        $pointer = $circle->{$pointer}->{prev};
        $steps++;
    }

    my $prev = $circle->{$pointer}->{prev};
    my $next = $circle->{$pointer}->{next};

    $circle->{$prev}->{next} = $next;
    $circle->{$next}->{prev} = $prev;
    $current                 = $next;
    delete $circle->{$pointer};
    return $pointer;
}

sub print_circle {
    my $start = 0;
    my @list;
    push @list, $start;
    my $next = $circle->{$start}->{next};
    while ($next) {
        $next = $circle->{$start}->{next};
        push @list, $next;
        $start = $next;
    }
    pop @list;
    say join( ' ', @list );
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

# load into an array of positions and velocities, keep track of
# initial size
my ( $X, $Y ) = ( 0, 1 );
my $state;
my $velocity;
my $bounds = { map { $_ => 0 } qw(xmax xmin ymax ymin) };
while (@input) {
    my $line = shift @input;
    my ( $pos, $vel ) = $line =~ m/<(.*)>.*<(.*)>$/;
    my ( $x,   $y )   = split /\,/, $pos;
    my ( $vx,  $vy )  = split /\,/, $vel;

    push @{$velocity}, [ $vx, $vy ];
    push @{$state},    [ $x,  $y ];

    $bounds->{xmax} = $x if $x > $bounds->{xmax};
    $bounds->{ymax} = $y if $y > $bounds->{ymax};
    $bounds->{xmin} = $x if $x < $bounds->{xmin};
    $bounds->{ymin} = $y if $y < $bounds->{ymin};
}
my $count = 0;
# assuming we converge to a minimal state space... print that!
while (1) {
    my $new_bounds = { map { $_ => 0 } qw(xmax xmin ymax ymin) };
    my $new_state;
    for ( my $idx = 0 ; $idx < scalar @{$state} ; $idx++ ) {
        my $x = $state->[$idx]->[$X] + $velocity->[$idx]->[$X];
        my $y = $state->[$idx]->[$Y] + $velocity->[$idx]->[$Y];

        $new_state->[$idx]->[$X] = $x;
        $new_state->[$idx]->[$Y] = $y;

        $new_bounds->{xmax} = $x if $x > $new_bounds->{xmax};
        $new_bounds->{ymax} = $y if $y > $new_bounds->{ymax};
        $new_bounds->{xmin} = $x if $x < $new_bounds->{xmin};
        $new_bounds->{ymin} = $y if $y < $new_bounds->{ymax};
    }

    # area expanding?

    if ( ( $new_bounds->{xmax} - $new_bounds->{xmin} ) >
            ( $bounds->{xmax} - $bounds->{xmin} )
        and ( $new_bounds->{ymax} - $new_bounds->{ymin} ) >
        ( $bounds->{ymax} - $bounds->{ymin} ) )
    {
        # keep the last known state, break out of loop
        last;
    }
    $state  = $new_state;
    $bounds = $new_bounds;
    $count++;
}

# print results!

my $grid;
foreach my $p ( @{$state} ) {
    $grid->{ $p->[$Y] }->{ $p->[$X] }++;
}

say "Part 1:";
foreach my $y ( 0 .. ( $bounds->{ymax} ) ) {
    my $line;
    foreach my $x ( 0 .. ( $bounds->{xmax} ) ) {
        if ( exists $grid->{$y}->{$x} ) {
            $line .= '#';
        }
        else {
            $line .= ' ';
        }
    }

    # some whitespace munging to clean up the output
    $line =~ s/^\s+//;
    next if length($line) == 0;
    say $line;
}

say "Part 2: ", $count;

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;

my (@in) = @ARGV;
my ( $test_x, $test_y, $serial );
if ( scalar @in > 0 ) {    # testing input
    ( $test_x, $test_y, $serial ) = @in;
}
else {
    $serial = 3628;
}

### CODE
my $MAX = 300;
sub power_level;
sub subsquare_sum;

# precalculate subsquares
# https://en.wikipedia.org/wiki/Summed-area_table
my $grid;
my $SA;

# some pre-init to prevent warnings later
map { $SA->[0]->[$_] = 0 } ( 0 .. $MAX );
map { $SA->[$_]->[0] = 0 } ( 0 .. $MAX );

foreach my $x ( 1 .. $MAX ) {
    foreach my $y ( 1 .. $MAX ) {
        my $val = power_level( $x, $y, $serial );
        $grid->[$x]->[$y] = $val;
        my $sum = $grid->[$x]->[$y];
        $sum += $SA->[$x]->[ $y - 1 ];
        $sum += $SA->[ $x - 1 ]->[$y];
        $sum -= $SA->[ $x - 1 ]->[ $y - 1 ];

        $SA->[$x]->[$y] = $sum;
    }
}

my $global_max = { x => 0, y => 0, val => 0, grid => 0 };
my $gridsize;
foreach $gridsize ( 1 .. 20 ) {   # cutoff found by inspection

    my $local_max = { x => 0, y => 0, val => 0 };

    foreach my $x ( 1 .. $MAX - $gridsize ) {
        foreach my $y ( 1 .. $MAX - $gridsize ) {
            my $sum = subsquare_sum( [ $x - 1, $y - 1 ],
                [ $x + $gridsize, $y + $gridsize ] );

            $global_max = { x => $x, y => $y, val => $sum, grid => $gridsize }
              if $sum > $global_max->{val};

	    $local_max = { x => $x, y => $y, val => $sum }
              if $sum > $local_max->{val} and $gridsize==2;
        }
    }
    if ( $gridsize == 2 ) {
        say "Part 1: ", join( ',', map { $global_max->{$_} } qw/x y/ );
    }
}
say "Part 2: ",
  join( ',', ( map { $global_max->{$_} } qw/x y/ ), $global_max->{grid} + 1 );

### SUBS

sub power_level {
    my ( $x, $y, $s ) = @_;
    my $rack_id     = $x + 10;
    my $power_level = $rack_id * $y;
    $power_level = $power_level + $s;
    $power_level = $power_level * $rack_id;
    if ( $power_level < 100 ) {
        $power_level = 0;
    }
    else {
        $power_level = int( $power_level / 100 );
        $power_level = $power_level % 10;
    }
    return $power_level - 5;
}

sub subsquare_sum {
    my ( $top_left, $bottom_right ) = @_;
    my ( $x_0,      $y_0 )          = @{$top_left};
    my ( $x_1,      $y_1 )          = @{$bottom_right};

    return $SA->[$x_1]->[$y_1] +
      $SA->[$x_0]->[$y_0] -
      $SA->[$x_1]->[$y_0] -
      $SA->[$x_0]->[$y_1];
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/min  max sum first/;
use List::MoreUtils qw/first_index/;
use Data::Dumper;
use Clone 'clone';
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

my $iterations = shift @ARGV || 20;

my $state;
my %patterns;

foreach my $line (@input) {
    if ( $line =~ m/^initial state: (.*)$/ ) {

        my @in = split //, $1;
        my $id = 0;
        while (@in) {
            my $pot = shift @in;
            push @{$state}, { id => $id, status => $pot };
            $id++

        }
    }
    elsif ( $line =~ m/^(\S{5}) \=\> (.$)/ ) {

        $patterns{$1} = $2;
    }
}

my $round = 0;
while ( $round < $iterations ) {

    # add pots to the beginning and the end
    my $first_id = $state->[0]->{id};
    my $last_id  = $state->[-1]->{id};

    unshift @{$state},
      map { { id => $first_id - $_, status => '.' } } ( -4, -3, -2, -1 );
    push @{$state},
      map { { id => $last_id + $_, status => '.' } } ( 1, 2, 3, 4 );

    if ($testing) {
        my $str;
        foreach my $pot ( @{$state} ) {
            $str .= $pot->{status} if $pot->{id} >= -5;
        }
        printf "%2d %s\n", $round, $str;
    }
    my $new_state = clone $state;

    for ( my $idx = 2 ; $idx <= $#{$state} - 2 ; $idx++ ) {
        my $pattern;
        foreach my $offset ( -2, -1, 0, 1, 2 ) {
            $pattern .= $state->[ $idx + $offset ]->{status};
        }

        if ( exists $patterns{$pattern} ) {

            $new_state->[$idx]->{status} = $patterns{$pattern};
        }
        else {

            if ($testing) {
                $new_state->[$idx]->{status} = '.';
            }
            else {

                die "can't find $pattern in list!";
            }

        }

    }
    $state = clone $new_state;

    $round++;
}

my $sum;

my $count;
my $first = 0;

foreach my $pot ( @{$state} ) {

    if ( $pot->{status} eq '#' ) {
        $first = $pot->{id} unless $first;
        $count++;

        $sum += $pot->{id};
    }

}

my $str = join '', map { $_->{status} } @{$state};
$str =~ s/^\.+//;
$str =~ s/\.+$//;

if ($iterations == 20) {
    say "Part 1: ", $sum;
} else {
    # output to research part 2
    say join( ' ', $iterations, $count, $first, $sum, $str );
}

#! /usr/bin/env perl
use Modern::Perl '2015';

### CODE
my $in = shift @ARGV || 50_000_000_000;
die "input must be >= 129" unless $in>=129;

# these patterns and constants found by inspecting output of part 1
my $pattern = '##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##';
my $offset = 26;
my $sum = -52;

my $index = $in-$offset;

my @list = split //,$pattern;
while (@list) {
    my $token =shift @list;
    if ($token eq '#') {
	$sum += $index;
    }
    $index++;
}
say "Part 2: ", $sum;

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#use Clone qw/clone/;
#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my ( $X, $Y ) = ( 0, 1 );

my $Track;
my $Cars;

my %rail_types = map { $_ => 1 } qw {/ \ | - +  };
my %car_types  = map { $_ => 1 } qw {> < ^ v};

my $row = 0;
my $col;
my $car_id = 1;

while (@input) {
    my $curr = shift @input;
    $col = 0;
    foreach my $el ( split //, $curr ) {
        if ( defined $rail_types{$el} ) {
            $Track->[$col]->[$row] = $el;
        }
        elsif ( defined $car_types{$el} ) {

            # mark position on Track, but rail type currently unknown
            # it's given it's always on straight track

            if ( $el eq '>' or $el eq '<' ) {
                $Track->[$col]->[$row] = '-';
            }
            elsif ( $el eq '^' or $el eq 'v' ) {
                $Track->[$col]->[$row] = '|';
            }
            $Cars->{$car_id} =
              { x => $col, y => $row, dir => $el, turns => [qw/L S R/] };
            $car_id++;

        }
        $col++;
    }
    $row++;
}

my %turn_left  = ( '>' => '^', '^' => '<', '<' => 'v', 'v' => '>' );
my %turn_right = ( '>' => 'v', 'v' => '<', '<' => '^', '^' => '>' );

my %move = (
    '>' => sub { my ($p) = @_; return [ $p->[$X] + 1, $p->[$Y] ] },
    '<' => sub { my ($p) = @_; return [ $p->[$X] - 1, $p->[$Y] ] },
    '^' => sub { my ($p) = @_; return [ $p->[$X], $p->[$Y] - 1 ] },
    'v' => sub { my ($p) = @_; return [ $p->[$X], $p->[$Y] + 1 ] },
);

my %turn = (
    '-'  => sub { return $_[0] },
    '|'  => sub { return $_[0] },
    '/'  => \&turn_1,
    '\\' => \&turn_2,
    '+'  => \&crossroads
);

### MAIN LOOP

my $tick             = 0;
my $no_of_collisions = 0;
while (1) {
    my @removed;
    foreach my $id (
        sort {
                 $Cars->{$a}->{y} <=> $Cars->{$b}->{y}
              || $Cars->{$a}->{x} <=> $Cars->{$b}->{x}
        }
        keys %{$Cars}
      )
    {

        my ( $dir, $x, $y, $next_turn ) =
          map { $Cars->{$id}->{$_} } qw/dir x y turns/;

        my $newpos = $move{$dir}->( [ $x, $y ] );

        # collision?

        my @crash = grep {
            $Cars->{$_}->{x} == $newpos->[$X]
              and $Cars->{$_}->{y} == $newpos->[$Y]
        } keys %{$Cars};
        if (@crash) {
            if ( $no_of_collisions == 0 ) {
                say "Part 1: ", join( ',', @{$newpos} );
                $no_of_collisions++;
            }
            push @removed, ( @crash, $id );
        }

        # what's under the new position, do we have to change direction?

        my $type = $Track->[ $newpos->[$X] ]->[ $newpos->[$Y] ];

        die "off the rails at ", join( ',', @{$newpos} ) unless defined $type;

        my $newdir;

        if ( $type eq '+' ) {    # need to check which direction to choose
            my $choice = shift @{$next_turn};
            push @{$next_turn}, $choice;
            $newdir = $turn{$type}->( $dir, $choice );
        }
        else {
            $newdir = $turn{$type}->($dir);
        }

        # update this car with new info

        $Cars->{$id} = {
            x     => $newpos->[$X],
            y     => $newpos->[$Y],
            dir   => $newdir,
            turns => $next_turn
        };

    }
    if (@removed) {
        foreach my $car (@removed) {
            delete $Cars->{$car};
        }
    }
    if ( keys %{$Cars} == 1 ) {    # last one!

        #		print Dumper $Cars;
        say "Part 2: ", join ',',
          map { $Cars->{ ( keys %{$Cars} )[0] }->{$_} } qw/x y/;
        last;
    }

    $tick++;
}

### SUBS

sub turn_1 {    # denoted by /
    my %newdirs = ( '>' => '^', '<' => 'v', '^' => '>', 'v' => '<' );
    return $newdirs{ $_[0] };
}

sub turn_2 {    # denoted by \
    my %newdirs = ( '>' => 'v', '<' => '^', '^' => '<', 'v' => '>' );
    return $newdirs{ $_[0] };
}

sub crossroads {
    my ( $dir, $choice ) = @_;
    return $dir              if $choice eq 'S';
    return $turn_left{$dir}  if $choice eq 'L';
    return $turn_right{$dir} if $choice eq 'R';
}

#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;

### CODE

my $target = shift @ARGV || 890691;

my $debug = 0;
my @recipes = (3,7);
my %elves= (e1 => 0, e2=>1 );

my $rounds = 0;

# we need 10 more entries than our target
while (scalar @recipes <= $target+10 ) {

    # create new recipes
    my @newrec = split(//, sum (map {$recipes[$elves{$_}] } qw/e1 e2/  ));
    push @recipes, @newrec;

    # move the elves
    foreach my $e (keys %elves) {
	my $newpos = $elves{$e} + 1 + $recipes[$elves{$e}];
	if ($newpos > $#recipes) {
	    $newpos %= @recipes;
	}
	say $newpos if $debug;
	$elves{$e} = $newpos;
    }
    $rounds++;
}

my @sought = @recipes[$target..$target+9];
say "Part 1: ",join('', @sought);

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules

use List::Util qw/sum/;

### CODE

my $target = shift @ARGV || 890691;

my $debug   = 0;
my @recipes = ( 3, 7 );
my %elves   = ( e1 => 0, e2 => 1 );

my $rounds = 0;
my $len    = length($target);

while (1) {
    no warnings qw/uninitialized/;
    say "> $rounds" if $rounds % 100_000 == 0;

    # create new recipes
    my @newrec = split( //, sum( map { $recipes[ $elves{$_} ] } qw/e1 e2/ ) );
    say join ' ', @newrec if $debug;

    push @recipes, @newrec;

    # move the elves
    foreach my $e ( keys %elves ) {

        my $newpos = $elves{$e} + 1 + $recipes[ $elves{$e} ];

        if ( $newpos > $#recipes ) {

            $newpos %= @recipes;
        }
        say $newpos if $debug;
        $elves{$e} = $newpos;
    }

    if ( join( '', @recipes[ -8 .. -1 ] ) =~ /$target/ ) {
        say "Part 2: ", index( join( '', @recipes ), $target );

        last;
    }
    $rounds++;
}

#! /usr/bin/env perl
use Modern::Perl '2015';

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $debug = 0;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
# parse the input, we have 2 separate sections
my @events;
my $is_token = 0;
my $event;
my @program;
foreach my $line (@input) {
    if ( $line =~ m/^Before: \[(.*)\]/ ) {
        $is_token = 1;
        my $str = $1;
        $str =~ s/\,//g;
        push @{$event}, [ split( / /, $str ) ];
    }
    elsif ( $is_token and $line =~ m/^(\d+.*)/ ) {
        push @{$event}, [ split( / /, $1 ) ];
    }
    elsif ( $is_token and $line =~ m/^After:  \[(.*)\]/ ) {
        my $str = $1;
        $str =~ s/\,//g;
        push @{$event}, [ split( / /, $str ) ];
        push @events, $event;
        $is_token = 0;
        $event    = undef;
    }
    elsif ( !$is_token and $line =~ m/^(\d+.*)/ ) {
        push @program, [ split( / /, $1 ) ];
    }
}
my @Reg = ( 0, 0, 0, 0 );
sub compare_registers;


my ( $A, $B, $C ) = ( 0, 1, 2 );
my %ops = (
    addi => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] + $_[$B] },
    addr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] + $Reg[ $_[$B] ] },
    bani => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] & $_[$B] },
    banr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] & $Reg[ $_[$B] ] },
    bori => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] | $_[$B] },
    borr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] | $Reg[ $_[$B] ] },
    eqir => sub { $Reg[ $_[$C] ] = $_[$A] == $Reg[ $_[$B] ] ? 1 : 0 },
    eqri => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] == $_[$B] ? 1 : 0 },
    eqrr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] == $Reg[ $_[$B] ] ? 1 : 0 },
    gtir => sub { $Reg[ $_[$C] ] = $_[$A] > $Reg[ $_[$B] ] ? 1 : 0 },
    gtri => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] > $_[$B] ? 1 : 0 },
    gtrr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] > $Reg[ $_[$B] ] ? 1 : 0 },
    muli => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] * $_[$B] },
    mulr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] * $Reg[ $_[$B] ] },
    seti => sub { $Reg[ $_[$C] ] = $_[$A] },
    setr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] },
);

my @results;
my %stats;
while (@events) {
    my $event = shift @events;

    my ( $before, $instr, $after ) = @{$event};
    my $count = 0;
    foreach my $op ( sort keys %ops ) {
        @Reg = @{$before};
        my $test = $ops{$op}->( @{$instr}[ 1, 2, 3 ] );
        printf(
            "[%s] [%s] - %s - [%s] (%s)\n",
            $op,
            join( ',', @{$before} ),
            join( ',', @{$instr} ),
            join( ',', @{$after} ),
            join( ',', @Reg )
        ) if $testing;
        my $ok =
          (      $Reg[0] == $after->[0]
              && $Reg[1] == $after->[1]
              && $Reg[2] == $after->[2]
              && $Reg[3] == $after->[3] ) ? 1 : 0;
        say $ok ? 'OK' : 'XX' if $debug;
        $count++ if $ok;
        $stats{ $instr->[0] }->{$op}++ if $ok;

    }
    say ">> $count" if $testing;
    push @results, $count if $count >= 3;
}

#say join(',',@results);
say "Part 1: ", scalar @results;

my %solution;
while ( keys %stats ) {
    foreach my $id ( keys %stats ) {
        if ( scalar keys %{ $stats{$id} } == 1 ) {    # found a lone op
            my $op = ( keys %{ $stats{$id} } )[0];
            say ">> found lone op $op at $id" if $debug;

            $solution{$id} = $op;
            delete $stats{$id};
        }

        # remove existing known ops
        while ( my ( $k, $op ) = each %solution ) {
            foreach my $v ( keys %{ $stats{$id} } ) {
                if ( $v eq $op ) {

                    #	    say ">> found $v matching $op, deleting...";
                    delete $stats{$id}->{$v};
                }

            }
        }

        # check for empty sets
        if ( scalar keys %{ $stats{$id} } == 0 ) {
            delete $stats{$id};
        }
    }

}
@Reg = (0,0,0,0);
while ( @program ) {
    my $instr = shift @program;
    my $op    = $solution{ $instr->[0] };
    $ops{$op}->( @{$instr}[ 1, 2, 3 ] );
}
say "Part 2: ", $Reg[0];

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Clone qw/clone/;
use Digest::MD5 qw/md5_hex/;
#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $Map;
my ( $X,    $Y )    = ( 0, 1 );
my ( $xmax, $ymax ) = ( 0, 0 );
my $row = 0;
while (@input) {
    my @line = split( //, shift @input );
    my $col = 0;
    foreach my $el (@line) {
        $Map->{$col}->{$row} = $el;
        $col++;
        $xmax = $col if $col > $xmax;
    }
    $row++;
}
$ymax = $row;

sub dump_state;
sub map_digest;
sub map_value;

my %generate = (
    '.' => \&open_field,
    '#' => \&lumberyard,
    '|' => \&forest,
);

if ($testing) {

    say "Initial state:";
    dump_state;
    say '';
}
my $count = 0;
my %stats;
my @list;
my %sequences;
my $Id;
my $part_2;
while ( $count < 1000 ) {


    my $Next;
    foreach my $x ( 0 .. $xmax - 1 ) {
        foreach my $y ( 0 .. $ymax - 1 ) {
            my $type = $Map->{$x}->{$y};

            # find neighbors
            my $neighbors;
            $neighbors = find_neighbors( [ $x, $y ] );

            $Next->{$x}->{$y} = $generate{$type}->($neighbors);
        }
    }

    $Map = clone $Next;

    # gather data for the sequence detection
    my $md5 = map_digest;
    my $val = map_value;

    say "Part 1: $val" if $count == 9;
    
    if ( exists $sequences{$md5} ) {
        my $cycle_length = $count - $sequences{$md5}->{count};
        $part_2 = $sequences{$md5}->{count} +
          ( 1_000_000_000 - 1 - $count ) % $cycle_length;
        say "Part 2: ", $list[$part_2];
        last;

    }
    $sequences{$md5}->{val}   = $val;
    $sequences{$md5}->{count} = $count;
    push @list, $val;
    if ($testing) {

        say "After ", $count + 1, " minutes:";
        dump_state;

        say '';
    }
    $count++;
}

#### SUBS

sub map_value {    # as per problem definition
    my ( $forest, $lumber ) = ( 0, 0 );
    foreach my $x ( keys %{$Map} ) {
        foreach my $y ( keys %{ $Map->{$x} } ) {
            $forest++ if $Map->{$x}->{$y} eq '|';
            $lumber++ if $Map->{$x}->{$y} eq '#';
        }
    }
    return $forest * $lumber;
}

sub map_digest {
    my $string;
    foreach my $x ( sort { $a <=> $b } keys %{$Map} ) {
        foreach my $y ( sort { $a <=> $b } keys %{ $Map->{$x} } ) {
            $string .= $Map->{$x}->{$y};
        }
    }
    return md5_hex($string);
}

sub forest {
    my ($n) = @_;
    if ( exists $n->{'#'} and $n->{'#'} >= 3 ) {
        return '#';
    }
    else {
        return '|';
    }
}

sub lumberyard {
    my ($n) = @_;
    if (    ( exists $n->{'#'} and $n->{'#'} >= 1 )
        and ( exists $n->{'|'} and $n->{'|'} >= 1 ) )
    {
        return '#';
    }
    else {
        return '.';
    }
}

sub open_field {
    my ($n) = @_;
    if ( exists $n->{'|'} and $n->{'|'} >= 3 ) {
        return '|';
    }
    else {
        return '.';
    }
}

sub find_neighbors {
    my ($point) = @_;
    my $result;
    for my $i ( -1, 0, 1 ) {
        for my $j ( -1, 0, 1 ) {
            next if ( $i == 0 and $j == 0 );    # skip point itself
            my $m = $Map->{ $point->[$X] + $i }->{ $point->[$Y] + $j };
            $m = defined $m ? $m : '_';
            printf "(%2d,%2d) -> (%2d,%2d) %s\n",
              @{$point}, $point->[$X] + $i, $point->[$Y] + $j, $m
              if $debug;

            $result->{$m}++;
        }
    }
    printf "(%2d,%2d) %s\n", $point->[$X], $point->[$Y],
      join( ' ', map { "$_ => $result->{$_}" } sort keys %{$result} )
      if $debug;
    return $result;
}

sub dump_state {
    foreach my $row ( 0 .. $ymax - 1 ) {
        foreach my $col ( 0 .. $xmax - 1 ) {
            print $Map->{$col}->{$row};
        }
        print "\n";
    }
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;


#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;

my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $Ip = 0;
my $ipval;
my @Reg = ( 0, (0) x 5 );
my @instr;
while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^\#ip (\d+)$/ ) {
        $ipval = $1;
    }
    elsif ( $line =~ m/^(....) (\d+) (\d+) (\d+)$/ ) {
        push @instr, [ $1, $2, $3, $4 ];
    }
    else {
        die "can't parse $line !";
    }
}
my ( $A, $B, $C ) = ( 0, 1, 2 );

my $counter = 0;
say "Instruction pointer: $ipval" if $debug;

my %ops = (
    addi => \&addi,
    addr => \&addr,
    bani => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] & $_[$B] },
    banr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] & $Reg[ $_[$B] ] },
    bori => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] | $_[$B] },
    borr => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] | $Reg[ $_[$B] ] },
    eqir => sub { $Reg[ $_[$C] ] = $_[$A] == $Reg[ $_[$B] ] ? 1 : 0 },
    eqri => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] == $_[$B] ? 1 : 0 },
    eqrr => \&eqrr,
    gtir => sub { $Reg[ $_[$C] ] = $_[$A] > $Reg[ $_[$B] ] ? 1 : 0 },
    gtri => sub { $Reg[ $_[$C] ] = $Reg[ $_[$A] ] > $_[$B] ? 1 : 0 },
    gtrr => \>rr,
    muli => \&muli,
    mulr => \&mulr,
    seti => \&seti,
    setr => \&setr,
);

my %stats;

my @before;

my $count = 0;

while ( ( $Ip >= 0 or $Ip <= $#instr ) ) {
    $stats{$Ip}++;
    my $working = $instr[$Ip];
    @before = @Reg;

    # execute the instruction
    $Reg[$ipval] = $Ip;
    last unless defined $ops{ $working->[0] };

    # return value used for debugging output
    my $pp = $ops{ $working->[0] }->( @{$working}[ 1, 2, 3 ] );
    if ($debug) {
        printf "ip=%2d %12s | %-20s [%s]\n", $Ip, join( ' ', @{$working} ), $pp,
          join( ',', @Reg );

    }

    $Ip = $Reg[$ipval];
    $Ip++;
    $count++;
}

if ($debug) {

    foreach ( my $idx = 0 ; $idx <= $#instr ; $idx++ ) {
        printf( "%2d [%s] %d\n",
            $idx, join( ' ', @{ $instr[$idx] } ),
            $stats{$idx} );
    }
}
say "Part 1 (brute force): ", $before[0];

#### Part 2

# Algo computes the sum of divisors of value in $Reg[4]

@Reg = ( 1, (0) x 5 );
$Ip = 0;

while ( ( $Ip >= 0 or $Ip <= $#instr ) ) {
    my $working = $instr[$Ip];
    @before = @Reg;

    # execute the instruction
    $Reg[$ipval] = $Ip;
    last unless defined $ops{ $working->[0] };

    my $pp = $ops{ $working->[0] }->( @{$working}[ 1, 2, 3 ] );

    #    last if ($pp eq 'GOTO 1'); # we've reached end of init phase
    last if $Reg[$ipval] == 1;
    $Ip = $Reg[$ipval];
    $Ip++;

}
my $num = $Reg[4];
# https://www.perlmonks.org/?node_id=371578
my @divisors = grep { $num % $_ == 0 } 1 .. $num;
say "Part 2 (calculated) : ", sum @divisors;

### SUBS

sub addi {
    my $i = $Reg[ $_[$A] ];
    my $j = $_[$B];
    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] + $_[$B];
    if ( $_[$C] == $ipval ) {
        return sprintf "GOTO %d", $i + $j + 1;
    }
    else {
        return sprintf "R[%d] = %d+%d", $_[$C], $i, $j;
    }
}

sub addr {
    my ( $i, $j ) = ( $Reg[ $_[$A] ], $Reg[ $_[$B] ] );
    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] + $Reg[ $_[$B] ];
    my $str;
    if ( $_[$C] == $ipval ) {
        $str = sprintf "GOTO %d", $i + $j + 1;
    }
    else {
        $str = sprintf "R[%d] = %d+%d", $_[$C], $i, $j;
    }
    return $str;
}

sub eqrr {
    my ( $i, $j ) = ( $Reg[ $_[$A] ], $Reg[ $_[$B] ] );
    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] == $Reg[ $_[$B] ] ? 1 : 0;
    if ( $i == $j ) {
        return sprintf "%d==%d => R[%d] = 1", $i, $j, $_[$C];
    }
    else {
        return sprintf "%d!=%d => R[%d] = 0", $i, $j, $_[$C];
    }
}

sub gtrr {
    my ( $i, $j ) = ( $Reg[ $_[$A] ], $Reg[ $_[$B] ] );
    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] > $Reg[ $_[$B] ] ? 1 : 0;
    if ( $i > $j ) {
        return sprintf "%d >%d => R[%d] = 1", $i, $j, $_[$C];
    }
    else {
        return sprintf "%d!>%d => R[%d] = 0", $i, $j, $_[$C];
    }

}

sub mulr {
    my ( $i, $j ) = ( $Reg[ $_[$A] ], $Reg[ $_[$B] ] );

    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] * $Reg[ $_[$B] ];
    if ( $_[$C] == $ipval ) {
        return sprintf "GOTO %d", $i * $j + 1;
    }
    else {
        return sprintf "R[%d] = %d*%d", $_[$C], $i, $j;
    }
}

sub muli {
    my ( $i, $j ) = ( $Reg[ $_[$A] ], $_[$B] );

    $Reg[ $_[$C] ] = $Reg[ $_[$A] ] * $_[$B];
    if ( $_[$C] == $ipval ) {
        return sprintf "GOTO %d", $i * $j + 1;
    }
    else {
        return sprintf "R[%d] = %d*%d", $_[$C], $i, $j;
    }
}

sub seti {
    my $i = $_[$A];
    $Reg[ $_[$C] ] = $_[$A];
    if ( $_[$C] == $ipval ) {
        return sprintf "GOTO %d", $i + 1;
    }
    else {
        return sprintf "R[%d] = %d", $_[$C], $i;
    }

}

sub setr {
    my $i = $Reg[ $_[$A] ];
    $Reg[ $_[$C] ] = $Reg[ $_[$A] ];
    return sprintf "R[%d] = %d", $_[$C], $i;
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

use List::Util qw/all/;

#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
# standard form of input
my ($depth) = $input[0] =~ m/depth: (\d+)/;
my ( $x_t, $y_t ) = $input[1] =~ m/target: (\d+)\,(\d+)/;

my $Map;    # memoization
sub calculate_type;
sub bydistance;

my $risk;

for my $x ( 0 .. $x_t ) {
    for my $y ( 0 .. $y_t ) {
        $risk += calculate_type( $x, $y )->{type};
    }
}

say "Part 1: $risk";

# find the fastest path using Djikstra's

## combination of type and tool
#   0         1        2
# ['Rocky',  'Wet',   'Narrow'];
# ['nEither','Torch', 'Gear'];

#   E T G
# R X . .
# W . X .
# N . . X

#my @allowed_tools = ( [1,2], [0,2], [0,1]);
my %allowed_states = (
    0 => { 1 => 1, 2 => 1 },
    1 => { 0 => 1, 2 => 1 },
    2 => { 0 => 1, 1 => 1 }
);

my $infinity = 'inf';
my @node;
my $root = '0,0,1';    # start with torch

# search outside the box above
my $x_limit = 3 * $x_t;
my $y_limit = $y_t + 3 * $x_t;

for ( my $x = 0 ; $x <= $x_limit ; $x++ ) {
    for ( my $y = 0 ; $y <= $y_limit ; $y++ ) {
        my $type = calculate_type( $x, $y )->{type};
        foreach my $tool ( keys %{ $allowed_states{$type} } ) {
            push @node, join( ',', $x, $y, $tool );
        }
    }
}

my @unsolved = @node;
my @solved;

my %dist;
my %edge;
my %prev;

# calculate vertices
for ( my $x = 0 ; $x <= $x_limit ; $x++ ) {
    for ( my $y = 0 ; $y <= $y_limit ; $y++ ) {
        my $type = calculate_type( $x, $y )->{type};

        # what states are legal for this type?
        my @tools = keys %{ $allowed_states{$type} };

        # cost for switching tools
        $edge{ join( ',', $x, $y, $tools[0] ) }
          ->{ join( ',', $x, $y, $tools[1] ) } = 7;
        $edge{ join( ',', $x, $y, $tools[1] ) }
          ->{ join( ',', $x, $y, $tools[0] ) } = 7;

        # try to move
        for my $d ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] ) {
            next
              if ( $x + $d->[0] < 0
                or $y + $d->[1] < 0
                or $x + $d->[0] > $x_limit
                or $y + $d->[1] > $y_limit );

            my ( $x2, $y2 ) = ( $x + $d->[0], $y + $d->[1] );
            my $type2 = calculate_type( $x2, $y2 )->{type};

            # can we get to the next node using our currently equipped tool?
            foreach my $tool (@tools) {
                $edge{ join( ',', $x, $y, $tool ) }
                  ->{ join( ',', $x2, $y2, $tool ) } = 1
                  if exists $allowed_states{$type2}->{$tool};
            }

        }
    }
}

foreach my $n (@node) {
    $dist{$n} = $infinity;
    $prev{$n} = $n;
}
$dist{$root} = 0;

while (@unsolved) {
    @unsolved = sort bydistance @unsolved;
    my $n = shift @unsolved;
    push @solved, $n;
    foreach my $n2 ( keys %{ $edge{$n} } ) {
        if (   ( $dist{$n2} eq $infinity )
            || ( $dist{$n2} > ( $dist{$n} + $edge{$n}->{$n2} ) ) )
        {
            $dist{$n2} = $dist{$n} + $edge{$n}->{$n2};
            $prev{$n2} = $n;
        }
    }
}
say "Part2: ", $dist{ join( ',', $x_t, $y_t, 1 ) };    # end in target with torch

#### SUBS ####
sub bydistance {
        $dist{$a} eq $infinity ? +1
      : $dist{$b} eq $infinity ? -1
      :                          $dist{$a} <=> $dist{$b};
}

sub calculate_type {
    my ( $x, $y ) = @_;

    # recursive with memoization
    if ( defined $Map->[$x]->[$y] ) {
        return {
            type  => $Map->[$x]->[$y]->{type},
            level => $Map->[$x]->[$y]->{level}
        };
    }
    my ( $geo_index, $level, $type );
    if ( $x == 0 and $y == 0 ) {
        $geo_index = 0;
    }
    elsif ( $x == $x_t and $y == $y_t ) {
        $geo_index = 0;
    }
    elsif ( $x == 0 ) {
        $geo_index = $y * 48271;
    }
    elsif ( $y == 0 ) {
        $geo_index = $x * 16807;
    }
    else {
        $geo_index =
          calculate_type( $x - 1, $y )->{level} *
          calculate_type( $x,     $y - 1 )->{level};
    }
    die "how did we get here?!" unless defined $geo_index;
    $level = ( $geo_index + $depth ) % 20183;
    $type  = $level % 3;
    $Map->[$x]->[$y] = { type => $type, level => $level };
    return { type => $type, level => $level };
}

#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my $boost = shift || 0;

# parse input

my $groups;    # keep one single record
my $id = 1;
my ( $immune_id, $infection_id ) = ( 1, 1 );
my $infection_section = 0;
my $type              = 1;
sub attacking_power;
sub dump_groups;
while (@input) {
    my $line = shift @input;
    next if length($line) == 0;
    next if $line =~ m/^Immune/;
    if ( $line =~ m/Infection:/ ) {
        $infection_section = 1;
        $type              = -1;
        next;
    }
    my ( $units, $hp, $attack, $attack_type, $initiative );
    my $item;
    if ( $line =~
m/^(\d+) units each with (\d+) hit points \((.*)\) with an attack that does (\d+) (\S+) damage at initiative (\d+)$/
      )
    {
        #	say "$1 $2 $3 $4 $5 $6";
        $item = {
            units       => $1,
            hp          => $2,
            attack      => $4,
            attack_type => $5,
            initiative  => $6
        };

        my @attributes = split( /;/, $3 );
        foreach my $attribute (@attributes) {
            if ( $attribute =~ m/^\ ?(\S+) to (.*)$/ ) {
                my $id = $1;
                my @types = split( /\,/, $2 );
                foreach my $t (@types) {
                    $t =~ s/^\s+//;
                    $item->{attribute}->{$id}->{$t}++;
                }

            }
            else {
                die "can't parse attribute: $attribute";
            }
        }

    }
    elsif ( $line =~
m/(\d+) units each with (\d+) hit points with an attack that does (\d+) (\S+) damage at initiative (\d+)$/
      )
    {
        $item = {
            units       => $1,
            hp          => $2,
            attack      => $3,
            attack_type => $4,
            initiative  => $5
        };

    }
    else {
        die "can't parse: $line";
    }
    my $label;
    if ($infection_section) {
        $label = "Infection group " . $infection_id;

        $infection_id++;
    }
    else {
        $label = "Immune group " . $immune_id;
        $immune_id++;
    }
    $groups->{$id}          = $item;
    $groups->{$id}->{label} = $label;
    $groups->{$id}->{type}  = $type;

    $id++;
}

# apply boost
foreach my $id ( keys %$groups ) {
    if ( $groups->{$id}->{type} == 1 ) {
        $groups->{$id}->{attack} += $boost;
    }
}

# find attack multipliers
my $multipliers;
foreach my $id ( keys %$groups ) {
    foreach my $id2 ( keys %$groups ) {
        next if ( $id == $id2 );
        next if ( $groups->{$id}->{type} eq $groups->{$id2}->{type} );

        if (
            exists $groups->{$id2}->{attribute}->{weak}
            ->{ $groups->{$id}->{attack_type} } )
        {
            $multipliers->{$id}->{$id2} = 2;
        }
        elsif (
            exists $groups->{$id2}->{attribute}->{immune}
            ->{ $groups->{$id}->{attack_type} } )
        {
            $multipliers->{$id}->{$id2} = 0;
        }
        else {
            $multipliers->{$id}->{$id2} = 1;
        }
    }
}

# selection phase
sub effective_power {
    my ($id) = @_;
    if ( $groups->{$id}->{units} <= 0 ) {
        return 0;
    }
    else {
        return $groups->{$id}->{units} * $groups->{$id}->{attack};
    }

}
my $round = 1;
LOOP: while (1) {

    my %targets;
    my %filter;
    foreach my $id (
        sort {
            effective_power($b) <=> effective_power($a)
              || $groups->{$b}->{initiative} <=> $groups->{$a}->{initiative}
        }
        keys %$groups
      )
    {
        my @opponents =
          grep { !exists $filter{$_} }
          grep { $multipliers->{$id}->{$_} > 0 }
          sort {
            effective_power($id) * $multipliers->{$id}->{$b}
              <=> effective_power($id) * $multipliers->{$id}->{$a}
              || effective_power($b) <=> effective_power($a)
              || $groups->{$b}->{initiative} <=> $groups->{$a}->{initiative}
          } keys %{ $multipliers->{$id} };
        if ($debug) {
            foreach my $opponent (@opponents) {
                printf(
                    "%s would deal defending %s %d damage\n",
                    $groups->{$id}->{label},
                    $groups->{$opponent}->{label},
                    effective_power($id) * $multipliers->{$id}->{$opponent}
                ) if $debug;
            }
        }
        next unless scalar @opponents;
        $targets{$id} = $opponents[0];
        %filter = reverse %targets;
    }

    # attacking phase

    # perform attacks in desc initiative order
    foreach my $attacker (
        sort { $groups->{$b}->{initiative} <=> $groups->{$a}->{initiative} }
        keys %targets )
    {
        my $defender = $targets{$attacker};

        # need to recompute power here, attacker may have lost units
        my $power =
          effective_power($attacker) * $multipliers->{$attacker}->{$defender};
        my $kills = int( $power / $groups->{$defender}->{hp} );
        say
"$groups->{$attacker}->{label} attacks $groups->{$defender}->{label}, killing $kills units"
          if $debug;
        $groups->{$defender}->{units} -= $kills;
    }
    my @counts = ( 0, 0 );
    say "ROUND: $round" if $debug;
    foreach my $id ( sort { $a <=> $b } keys %$groups ) {
        if ( $groups->{$id}->{units} <= 0 )
        {    # no units remain, remove this group
            say "no units remain in $groups->{$id}->{label}, deleting!"
              if $debug;
            delete $multipliers->{$id};
            foreach my $id2 ( keys %$multipliers ) {
                if ( exists $multipliers->{$id2}->{$id} ) {
                    delete $multipliers->{$id2}->{$id};
                }
            }
            delete $groups->{$id};
            next;

        }
        say join( ' ', map { "$_: $groups->{$id}->{$_}" } qw/label units/ )
          if $debug;
        $counts[0]++ if $groups->{$id}->{type} == -1;
        $counts[1]++ if $groups->{$id}->{type} == 1;
    }
    $round++;
    last LOOP if ( $counts[0] == 0 or $counts[1] == 0 );
}
my $sum;
my $types;
foreach my $id ( keys %$groups ) {
    $sum   += $groups->{$id}->{units};
    $types += $groups->{$id}->{type};
}
say $types< 0 ? "Infection" : "Immune", " win: $sum units remaining";

#! /usr/bin/env perl
use Modern::Perl '2015';

#### INIT - load input data from file into array

my @input;

while (<>) { chomp; s/\r//gm; push @input, $_; }

### CODE
sub distance;
sub dump_point;

my @points;
for my $line (@input) {
    push @points, { pos => [ split( /\,/, $line ) ], const_id => undef };
}
my $const_id = 0;

for ( my $i = 0 ; $i < scalar @points ; $i++ ) {
    if ( !defined $points[$i]->{const_id} ) {
        my @list;

        $const_id++;

        $points[$i]->{const_id} = $const_id;
        push @list, $i;
        while (@list) {
            my $j = shift @list;

            # check is any other points are in range
            for ( my $k = 0 ; $k < scalar @points ; $k++ ) {
                next if $j == $k;
                next if defined $points[$k]->{const_id};

                my $d = distance( $points[$k]->{pos}, $points[$j]->{pos} );
                if ( $d <= 3 ) {
                    $points[$k]->{const_id} = $const_id;
                    push @list, $k;
                }
            }
        }
    }
}

say "Part 1: ", $const_id;

### SUBS
sub dump_point {
    my ($p) = @_;
    printf(
        "[%2d,%2d,%2d,%2d] id=%s\n",
        @{ $p->{pos} },
        defined $p->{const_id} ? $p->{const_id} : ''
    );
}

sub distance {
    my ( $p, $q ) = @_;
    my $d;
    for my $idx ( 0 .. 3 ) {
        $d += abs( $p->[$idx] - $q->[$idx] );
    }
    return $d;

}