Advent of Code 2017 solutions

This are my solutions for this year's contest.

Main page on my blog.

If you want to copy these files, use the GitHub link.

All files covered by the UNLICENSE.

Table of contents

Advent of Code 2017 day 1

[ AoC problem link ] [ Discussion ].

Day 1 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### INIT - load input data 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   = split( //, shift @input );
my $length = scalar @list;
my $sum_1  = 0;
my $sum_2  = 0;

# circular list, just make a copy to avoid funky rollover arithmetic
my @check = ( @list, @list );
for ( my $i = 0 ; $i <= $length - 1 ; $i++ ) {
    my $j = $i + $length / 2;
    if ( $check[$i] == $check[ $i + 1 ] ) { $sum_1 += $check[$i] }

    if ( $check[$i] == $check[$j] ) { $sum_2 += $check[$i] }
}
say "Captcha 1: $sum_1";
say "Captcha 2: $sum_2";

22 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 2

[ AoC problem link ] [ Discussion ].

Day 2 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max min/;

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

### CODE
my $sum_1 = 0;
my $sum_2 = 0;
foreach my $line (@input) {

    # sort the values for easier division comparison down the line
    my @row = sort { $b <=> $a } split( /\s+/, $line );

    $sum_1 += $row[0] - $row[$#row];

    my $found = 0;
    while ( @row and !$found ) {
        my $a = shift @row;
	# using a reverse here slightly increases the chance of
	# finding a divisor faster
        foreach my $b ( reverse @row) {
            if ( $a % $b == 0 ) {
                $sum_2 += $a / $b;
                $found = 1;
            }
        }
    }
}
say "Checksum      : $sum_1";
say "Sum of results: $sum_2";

29 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 3

[ AoC problem link ] [ Discussion ].

Day 3 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/min/;

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

### CODE
my $target = $input[0];

sub diagonal_values {
    # from Project Euler 28, the values of numbers on diagonals
    my ($x) = @_;
    my $n = 2 * $x + 1;
    return [
        $n * $n - 3 * $n + 3,
        $n * $n - 2 * $n + 2,
        $n * $n - $n + 1,
        $n * $n
    ];
}

my $x        = 0;
my $distance = 0;
while (1) {
    my $diags = diagonal_values($x);

    # find the "ring" where the target value lies
    if ( $target >= $diags->[0] and $target <= $diags->[3] ) {

        # the diagonal values represent the largest Manhattan distance 2x
        # find the minimum distance to the diagonals
        my $min = min( map { abs( $target - $diags->[$_] ) } ( 0, 1, 2, 3 ) );
        $distance = 2 * $x - $min;
        last;
    }
    $x++;
}

say "Steps to take: $distance";

35 lines [ Plain text ] [ ^Top ]

Day 3 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;

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

### CODE

#### subs

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for steplengths
# we go 1,1,2,2,3,3,... steps before changing direction
sub steplengths {
    my ($m) = @_;
    my $flag = 0;
    return Iterator {
        if ( $flag % 2 == 0 ) {
            $m++;
        }
        $flag++;
        return $m;
    }
}

my $M;

sub adjacent_sum {
    my ( $x, $y ) = @_;
    my $sum = 0;
    foreach my $i ( $x - 1, $x, $x + 1 ) {
        foreach my $j ( $y - 1, $y, $y + 1 ) {
            if ( defined $M->{$i}->{$j} ) {
                $sum += $M->{$i}->{$j};
            }
        }
    }
    return $sum;
}

my $dirs = [ [ 1, 0 ], [ 0, 1 ], [ -1, 0 ], [ 0, -1 ] ];

#### init

my $target = $input[0];

my $current_val = 1;
my ( $x, $y ) = ( 0, 0 );

# store the values for each coordinate in a href of hrefs
# an arrayref of arrayrefs might be "cleaner" but needs to be pre-created
$M->{$x}->{$y} = $current_val;

my $dir_idx = 0;
my $iter    = steplengths(0);

#### main loop

LOOP: while ( my $step = NEXTVAL($iter) ) {

    if ( $dir_idx == 4 ) { $dir_idx = 0 }
    while ( $step > 0 ) {
        ( $x, $y ) =
          ( $x + $dirs->[$dir_idx]->[0], $y + $dirs->[$dir_idx]->[1] );
        $current_val = adjacent_sum( $x, $y );
        if ( $current_val >= $target ) {
            last LOOP;
        }
        $M->{$x}->{$y} = $current_val;
        $step--;
    }
    $dir_idx++;

}
say "First value larger than $target: $current_val";

56 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 4

[ AoC problem link ] [ Discussion ].

Day 4 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my ( $count_1, $count_2 ) = ( 0, 0 );
foreach my $line (@input) {
    my @passphrase = split( /\s+/, $line );
    my %dupe_words;
    map { $dupe_words{$_}++ } @passphrase;
    my %anagrams;
    map { $anagrams{ join( '', sort( split( //, $_ ) ) ) }++ } @passphrase;
    $count_1++ if ( scalar @passphrase == scalar keys %dupe_words );
    $count_2++ if ( scalar @passphrase == scalar keys %anagrams );
}

say "1. Number of valid passphrases: $count_1";
say "2. Number of valid passwords  : $count_2";

19 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 5

[ AoC problem link ] [ Discussion ].

Day 5 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### INIT - load input data 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

sub debug {
    say join ' ', @input;
}
# pass a non-false argument to enable part 2
my $part2 = shift || 0;

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

while ( $pointer >= 0 and $pointer < scalar @input ) {
    my $jump = $input[$pointer];
    if ( $jump == 0 ) {
        $steps++;
        $input[$pointer]++;
        next;
    }
    else {
        my $pos  = $pointer;
        $pointer = $pointer + $jump;
        $steps++;
        if ( $jump >= 3 and $part2 ) {
            $input[$pos]--;
        }
        else {
            $input[$pos]++;
        }
    }
    debug if $testing;
}
print 'Part ' , $part2 ? '2' : '1' ,  '. ';
say "number of steps: $steps";

36 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 6

[ AoC problem link ] [ Discussion ].

Day 6 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

#### INIT - load input data 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 @state = split( /\t/, $input[0] );
my %seen_states;

sub debug {
    say join( ',', @state );
}

my $count = 0;
$seen_states{ "@state" } = $count;

# let's loop!
while (1) {
    my $largest_el = max @state;
    my @positions  = grep { $state[$_] == $largest_el } (0 .. $#state);
    # we might have more than one position with the same number of elements
    # choose the first
    my $start      = shift @positions;
    my $blocks     = $state[$start];
    $state[$start] = 0;
    my $next = $start + 1;
    while ( $blocks > 0 ) {
	# do we need to wrap around?
        if ( $next >= scalar @state ) { $next = 0 }
        $state[$next]++;
        $blocks--;
        $next++;
    }
    $count++;
    if ( exists $seen_states{ "@state" } ) {
        last;
    }
    else {
        $seen_states{ "@state" } = $count;
    }
}
say "1. number of cycles: $count";
say "2. size of loop    : ", $count - $seen_states{ "@state" };


42 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 7

[ AoC problem link ] [ Discussion ].

Day 7 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### INIT - load input data 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 %towers;

sub total_weight;
sub compare_levels;

# construct a hash holding values - weights and children
foreach my $line (@input) {
    if ( $line =~ m/^(?.*) \((?\d+)\) \-\> (?.*)$/ ) {
        my  $tower  = $+{tower};
        $towers{$tower}->{weight} = $+{weight};
        foreach my $el ( split( /\,/, $+{list} ) ) {
            $el =~ s/^\s+|\s+$//g;    # trim whitespace
            $towers{$el}->{held_by} = $tower;
            push @{ $towers{$tower}->{holding} }, $el;
        }
    }
    elsif ( $line =~ m/^(?.*) \((?\d+)\)$/ ) {
        $towers{$+{tower}}->{weight} = $+{weight};
    }
    else {
        die "can't parse input line: $line\n";
    }
}

# find the root (part 1)
my $root;
foreach my $tower ( keys %towers ) {
    if ( !exists $towers{$tower}->{held_by} ) {
        $root = $tower;
        last;
    }
}
say "1. name of root disk: $root";
say "2. adjusted weight  : ", compare_levels( $root, 0 );

########################################

# recursively calculate the weight of a tower, given a base
sub total_weight {
    my ($base) = @_;
    my $weight;

    if ( !exists $towers{$base}->{holding} ) {    # leaf
        $weight = $towers{$base}->{weight};
    }
    else {
        $weight = $towers{$base}->{weight};
        foreach my $child ( @{ $towers{$base}->{holding} } ) {
            $weight += total_weight($child);
        }
    }
    return $weight;
}

# compare the weights of a base tower's children, return corrected
# weight
sub compare_levels {
    my ( $base, $diff ) = @_;
    my %values;
    foreach my $child ( @{ $towers{$base}->{holding} } ) {
        push @{ $values{ total_weight($child) } }, $child;
    }

    # do we have any diffs?
    if ( scalar keys %values == 1 )
    {    # no diffs, return corrected weight of parent
        return $towers{$base}->{weight} - $diff;
    }
    else {    # calculate new diff (should be the same for each step
              # but we might as well have the latest value...
        my ( $lo, $hi ) = sort { $a <=> $b } keys %values;
        $diff = $hi - $lo;
    }

    # find the outlier to send on to the next level
    my $differing;
    foreach my $val ( keys %values ) {
        if ( scalar @{ $values{$val} } == 1 ) {
            $differing = $values{$val}->[0];
        }
    }
    compare_levels( $differing, $diff );
}

76 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 8

[ AoC problem link ] [ Discussion ].

Day 8 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

#### INIT - load input data 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 %registers;
my $max_val = 0;

sub value_of;
sub compare;
foreach my $line (@input) {
    my @args = split( /\s+/, $line );

    my ( $target, $inc_dec, $val_1, $if, $source, $cmp, $val_2 ) = @args;

    my $curr = value_of($target);

    if ( compare( $source, $cmp, $val_2 ) ) {
        if ( $inc_dec eq 'inc' ) {
            $curr = $curr + $val_1;
        }
        else {
            $curr = $curr - $val_1;
        }
        $max_val = $curr if ( $curr > $max_val );
        $registers{$target} = $curr;
    }
}
say "1. largest value when done : ", max values %registers;
say "2. largest value during run: ", $max_val;

#################################################################

sub value_of {
    my ($v) = @_;
    my $ret;
    if ( exists $registers{$v} ) {
        $max_val = $registers{$v} if ( $registers{$v} > $max_val );
        $ret = $registers{$v};
    }
    else {
        $registers{$v} = 0;
        $ret = 0;
    }
    return $ret;
}

sub compare {
    my ( $src, $cmp, $arg_2 ) = @_;
    my $arg_1 = value_of($src);
    my $ret   = undef;

    # from stats, we have: != < <= == > >=
    if    ( $cmp eq '!=' ) { $ret = ( $arg_1 != $arg_2 ) }
    elsif ( $cmp eq '<'  ) { $ret = ( $arg_1 <  $arg_2 ) }
    elsif ( $cmp eq '<=' ) { $ret = ( $arg_1 <= $arg_2 ) }
    elsif ( $cmp eq '==' ) { $ret = ( $arg_1 == $arg_2 ) }
    elsif ( $cmp eq '>'  ) { $ret = ( $arg_1 >  $arg_2 ) }
    elsif ( $cmp eq '>=' ) { $ret = ( $arg_1 >= $arg_2 ) }
    die "can't set return value based on args" unless defined $ret;
    return $ret;
}

57 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 9

[ AoC problem link ] [ Discussion ].

Day 9 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 ( $score, $invalid_flag, $garbage_count ) = ( 0, 0, 0 );
my @groups;
my @garbage;

# dispatch table
my %act = (
    '{' => \&open_group,
    '}' => \&close_group,
    '<' => \&garbage_in,
    '>' => sub { pop @garbage },
    '!' => sub { $invalid_flag = 1 if @garbage },
);

# process the stream
my @stream = split( //, shift @input );
my $char;
while (@stream) {
    $char = shift @stream;

    if ($invalid_flag) {
        $invalid_flag = 0;
        next;
    }
    
    if ( defined $act{$char} ) {
        $act{$char}->();
    }
    else {
        $garbage_count++ if @garbage;
    }
}
say "1. total score              : $score";
say "2. characters within garbage: $garbage_count";

########################################

sub open_group {
    if ( !@garbage ) {
        push @groups, '{';
        $score += scalar @groups;
    }
    else {
        $garbage_count++;
    }
}

sub close_group {
    if ( !@garbage ) {
        pop @groups;
    }
    else {
        $garbage_count++;
    }
}

sub garbage_in {
    if ( !@garbage ) {
        push @garbage, '<';
    }
    else {
        $garbage_count++;
    }
}

60 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 10

[ AoC problem link ] [ Discussion ].

Day 10 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 @array = $testing ? ( 0 .. 4 ) : ( 0 .. 255 );
my @lengths = split( /\,/, shift @input );
sub dump_state;
my $skip = 0;
my $pos  = 0;
my $len  = 0;

dump_state if $testing;
while (@lengths) {
    $len = shift @lengths;
    my $end     = $pos + $len - 1;
    my $overlap = $end % @array;

    # do we overlap?
    if ( $overlap == $end ) {    #no
        my @segment = @array[ $pos .. $end ];
        @array[ $pos .. $end ] = reverse @segment;
    }
    else {
        my @seg1 = @array[ $pos .. $#array ];
        my @seg2 = @array[ 0 .. $overlap ];
        say join( ' ', @seg1, @seg2 ) if $testing;
        my @replace = reverse( @seg1, @seg2 );
        say join( ' ', @replace ) if $testing;
        @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
        @array[ 0 .. $overlap ] =
          @replace[ ( $#replace - $overlap ) .. $#replace ];
    }

    $pos = ( $pos + $len + $skip ) % @array;
    $skip++;
    dump_state if $testing;
}
say "Product of first 2 elements: ",$array[0] * $array[1];

########################################

sub dump_state {
    printf( "curr length: %d curr skip: %d next pos: %d\n",
	    $len, $skip, $pos );
    my @copy = @array;
    if ($testing) {
        say join( ' ', map { sprintf( "%2d", $_ ) } @copy );
    }
    else {
        while (@copy) {
            my @row = splice( @copy, 0, 16 );
            say join( ' ', map { sprintf( "%3d", $_ ) } @row );
        }
    }
}

53 lines [ Plain text ] [ ^Top ]

Day 10 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my @array = ( 0 .. 255 );
my @key;
my @salt = ( 17, 31, 73, 47, 23 );
my $teststring = '1,2,3';
if ($testing) {
    my @convert = map { ord($_) } split( //, $teststring );
    @key = ( @convert, @salt );
}
else {
    my @in = map { ord($_) } split( //, shift @input );
    @key = ( @in, @salt );
}
my $skip = 0;
my $pos  = 0;
my $len  = 0;
sub array_to_hex;

foreach my $round ( 1 .. 64 ) {
    my @lengths = @key;
    while (@lengths) {
        $len = shift @lengths;
        my $end     = $pos + $len - 1;
        my $overlap = $end % @array;

        # do we overlap?
        if ( $overlap == $end ) {    #no
            my @segment = @array[ $pos .. $end ];
            @array[ $pos .. $end ] = reverse @segment;
        }
        else {
            my @seg1    = @array[ $pos .. $#array ];
            my @seg2    = @array[ 0 .. $overlap ];
            my @replace = reverse( @seg1, @seg2 );
            @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
            @array[ 0 .. $overlap ] =
              @replace[ ( $#replace - $overlap ) .. $#replace ];
        }

        $pos = ( $pos + $len + $skip ) % @array;
        $skip++;
    }
}
say "Knot Hash of puzzle input: ", array_to_hex;

########################################

sub array_to_hex {
    my $string;
    while (@array) {
        my @row = splice( @array, 0, 16 );
        my $xor;
        my $el_1 = shift @row;
        while (@row) {
            my $el_2 = shift @row;
            $xor  = $el_1 ^ $el_2;
            $el_1 = $xor;
        }
        $string .= sprintf( "%02x", $xor );
    }
    return $string;
}

63 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 11

[ AoC problem link ] [ Discussion ].

Day 11 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

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

### CODE
# x,y,z coordinates - see https://www.redblobgames.com/grids/hexagons/
my %move = (
    n  => sub { [ 0,  1,  -1 ] },
    ne => sub { [ 1,  0,  -1 ] },
    se => sub { [ 1,  -1, 0 ] },
    s  => sub { [ 0,  -1, 1 ] },
    sw => sub { [ -1, 0,  1 ] },
    nw => sub { [ -1, 1,  0 ] },
);

my @dirs = split( /,/, shift @input );
my @path;

#         x, y, z
my $position = [ 0, 0, 0 ];
my ( $dist, $max_dist ) = ( 0, 0 );
while (@dirs) {
    my $ins = shift @dirs;
    my $d   = $move{$ins}->();
    map { $position->[$_] += $d->[$_] } 0 .. 2;
    $dist = max( map { abs($_) } @$position );
    $max_dist = max( $max_dist, $dist );
}
say "1. steps to end point: ", $dist;
say "2. max distance      : ", $max_dist;

29 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 12

[ AoC problem link ] [ Discussion ].

Day 12 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 %pipes;
while (@input) {
    my $line = shift @input;
    if ( $line =~ /^(\d+)\ \<\-\>\ (.*)$/ ) {
        $pipes{$1} = [split( ', ', $2 )];
    }
    else {
        die "cannot parse input line: $line";
    }
}

my %seen;
my %groups;
foreach my $id ( sort keys %pipes ) {
    next if $seen{$id};
    my %connections = ( $id => 1 );
    my @list = @{ $pipes{$id} };
    while (@list) {
        my $p = shift @list;
        $seen{$p}++;
        next if exists $connections{$p};
        $connections{$p}++;
        push @list, @{ $pipes{$p} };
    }
    $groups{$id} = \%connections;
}
say "1. connections to '0': ", scalar keys %{ $groups{'0'} };
say "2. total groups      : ", scalar keys %groups;

35 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 13

[ AoC problem link ] [ Discussion ].

Day 13 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

# useful modules
use List::Util qw/max/;
#### 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
# parse input
my %depths;
my $max = 0;
while (@input) {
    my ( $pos, $depth ) = split( /: /, shift @input );
    $depths{$pos} = $depth;
    $max = max( $max, $pos );
}

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for states
sub states {
    my ($m) = @_;
    return Iterator {
        for my $i ( 0 .. scalar @$m - 1 ) {
            if ( exists $depths{$i} ) {
                my $new = $m->[$i] + 1;
                $m->[$i] = $new % ( 2 * $depths{$i} - 2 );
            }
        }
        return $m;
    }
}

my $firewall = [ (0) x ( $max + 1 ) ];
my $iter     = states($firewall);
my $curr     = 0;
my $severity = 0;

while ( $curr <= $max ) {
    if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
        $severity += $depths{$curr} * $curr;
    }
    $firewall = NEXTVAL($iter);
    $curr++;

}
say "Severity: ",$severity;

42 lines [ Plain text ] [ ^Top ]

Day 13 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

# useful modules
use List::Util qw/max/;
use Storable qw/dclone/;
#### 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
# parse input

my %depths;
my $max = 0;
while (@input) {
    my ( $pos, $depth ) = split( /: /, shift @input );
    $depths{$pos} = $depth;
    $max = max( $max, $pos );
}

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for states
sub states {
    my ($m) = @_;
    return Iterator {
        for my $i ( 0 .. scalar @$m - 1 ) {
            if ( exists $depths{$i} ) {
                my $new = $m->[$i] + 1;
                $m->[$i] = $new % ( 2 * $depths{$i} - 2 );
            }
        }
        return $m;
    }
}

my $initial = [ (0) x ( $max + 1 ) ];
my $iter1   = states($initial);
my $starter = NEXTVAL($iter1);

my $delay = 1;
while (1) {
    my $curr     = 0;
    my $hit      = 0;
    my $firewall = dclone $starter;
    my $iter2    = states($firewall);
  INNER: while ( $curr <= $max ) {
        if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
            $hit = 1;
            last INNER;
        }
        $firewall = NEXTVAL($iter2);
        $curr++;
    }
    last if ( $hit == 0 );
    $delay++;
    $starter = NEXTVAL($iter1);
}

say "Delay: ",$delay;

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 14

[ AoC problem link ] [ Discussion ].

Day 14 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $max_dim = 127;
my $group_count = 0;
sub knot_hash_bin;
sub fill_flood;

my $seed    = $input[0];

my $sum = 0;
my $Map;
foreach my $idx ( 0 .. $max_dim ) {
    my $binrow = knot_hash_bin( $seed . '-' . $idx );

    my @ones = grep { $_ == 1 } split( //, $binrow );
    $sum += scalar @ones;

    # populate map
    foreach my $el ( split( //, $binrow ) ) {
        push @{ $Map->[$idx] }, { val => $el, seen => 0 };
    }
}

# process the map

foreach my $row ( 0 .. scalar @$Map - 1 ) {
    foreach my $col ( 0 .. scalar @{ $Map->[$row] } - 1 ) {
        next if $Map->[$row]->[$col]->{val} == 0;
        next if $Map->[$row]->[$col]->{seen} > 0;
	# fill flood the ones
        $group_count++;
        fill_flood( $row, $col );
    }
}

say "1. number of used squares   : ", $sum;
say "2. number of distinct groups: ", $group_count;

###############################################################################

sub fill_flood {
    my ( $r, $c ) = @_;
    my @dirs = ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] );
    foreach my $d (@dirs) {
        my $new_r = $r + $d->[0];
        my $new_c = $c + $d->[1];
        next
          if ( $new_r < 0
            or $new_r > $max_dim
            or $new_c < 0
            or $new_c > $max_dim );
        next
          if ( $Map->[$new_r]->[$new_c]->{val} == 0
            or $Map->[$new_r]->[$new_c]->{seen} > 0 );
        $Map->[$new_r]->[$new_c]->{seen} = $group_count;
        fill_flood( $new_r, $new_c );
    }
}

# code adapted from day 10, part 2
sub knot_hash_bin {
    my ($string) = @_;
    my @salt = ( 17, 31, 73, 47, 23 );
    my @convert = map { ord($_) } split( //, $string );
    my @key = ( @convert, @salt );

    my @array = ( 0 .. 255 );
    my $skip  = 0;
    my $pos   = 0;
    my $len   = 0;
    foreach my $round ( 1 .. 64 ) {
        my @lengths = @key;
        while (@lengths) {
            $len = shift @lengths;
            my $end     = $pos + $len - 1;
            my $overlap = $end % @array;

            # do we overlap?
            if ( $overlap == $end ) {    #no
                my @segment = @array[ $pos .. $end ];
                @array[ $pos .. $end ] = reverse @segment;
            }
            else {
                my @seg1    = @array[ $pos .. $#array ];
                my @seg2    = @array[ 0 .. $overlap ];
                my @replace = reverse( @seg1, @seg2 );
                @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
                @array[ 0 .. $overlap ] =
                  @replace[ ( $#replace - $overlap ) .. $#replace ];
            }

            $pos = ( $pos + $len + $skip ) % @array;
            $skip++;
        }
    }
    my $hexstring;
    while (@array) {
        my @row = splice( @array, 0, 16 );
        my $xor;
        my $el_1 = shift @row;
        while (@row) {
            my $el_2 = shift @row;
            $xor  = $el_1 ^ $el_2;
            $el_1 = $xor;
        }
        $hexstring .= sprintf( "%02x", $xor );
    }
    my @chars = split( //, $hexstring );
    my $out;
    while (@chars) {
        $out .= sprintf( "%04b", hex( shift @chars ) );
    }
    return $out;
}

104 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 15

[ AoC problem link ] [ Discussion ].

Day 15 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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

# pass a non-false value for part 2
my $part2 = shift || 0;

my @start;
my @factors = ( 16807, 48271 );
my @evendivs = $part2 ? ( 4, 8 ) : ( undef, undef );
my $divisor  = 2147483647;
my $mask     = 0xFFFF;

while (@input) {
    my $str = shift @input;
    if ( $str =~ m/(\d+)$/ ) {
        push @start, $1;
    }
    else {
        die "can't parse input: $str";
    }
}

# cribbed from HOP
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

sub generator {
    my ( $start, $factor, $divide_by ) = @_;
    return Iterator {
        my $nextval;
        if ( defined $divide_by ) {

            do {
                $nextval = ( $start * $factor ) % $divisor;
                $start   = $nextval;
            } until ( $nextval % $divide_by == 0 );
            return $start;
        }
        else {
            $nextval = ( $start * $factor ) % $divisor;
            $start   = $nextval;
            return $start;
        }
    }
}

my $count = 1;
my $match = 0;

my $gen_A = generator( $start[0], $factors[0], $evendivs[0] );
my $gen_B = generator( $start[1], $factors[1], $evendivs[1] );

my $LIMIT = 1_000_000 * ( $part2 ? 5 : 40 );

while ( $count <= $LIMIT ) {
    $match++ if ( ( NEXTVAL($gen_A) & $mask ) == ( NEXTVAL($gen_B) & $mask ) );
    $count++;
}
printf "No. of matches for part %d: %d\n", $part2 ? 2 : 1, $match;

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 16

[ AoC problem link ] [ Discussion ].

Day 16 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE

my @list = 'a' .. 'p';

my %actions = (
    s => \&spin,
    x => \&exchange,
    p => \&partner,
);

my @seq;
for my $el ( split( /,/, $input[0] ) ) {
    if    ( $el =~ m/s(\d+)/ )        { push @seq, [ 's', $1, undef ] }
    elsif ( $el =~ m/x(\d+)\/(\d+)/ ) { push @seq, [ 'x', $1, $2 ] }
    elsif ( $el =~ m/p(\S+)\/(\S+)/ ) { push @seq, [ 'p', $1, $2 ] }
    else                              { die "can't parse: $el" }
}

my $count = 1;
my $period;
my $LIMIT = 1_000_000_000;

# find answer to part 1, and the recurrence period;
while ( $count <= $LIMIT ) {
    say "==> $count" if $count % 100 == 0;
    foreach my $el (@seq) {
        $actions{ $el->[0] }->( $el->[1], $el->[2] );
    }
    say "1. result after 1  round : ", join( '', @list ) if $count == 1;
    if ( join( '', @list ) eq join( '', 'a' .. 'p' ) ) {
        $period = $count;
        last;
    }
    $count++;
}

# find part 2;
$count = 1;
@list  = 'a' .. 'p';
while ( $count <= $LIMIT % $period ) {
    foreach my $el (@seq) {
        $actions{ $el->[0] }->( $el->[1], $el->[2] );
    }
    $count++;
}

say "2. result after 1B rounds: ", join( '', @list );

###############################################################################

sub spin {
    my ( $x, $_0 ) = @_;
    my @tail = @list[ -$x .. -1 ];
    my @head = @list[ 0 .. $#list - $x ];
    @list = ( @tail, @head );
}

sub exchange {
    my ( $p, $q ) = @_;
    my $newp = $list[$q];
    my $newq = $list[$p];
    $list[$p] = $newp;
    $list[$q] = $newq;
}

sub partner {
    my ( $r, $s ) = @_;
    my ($r_idx) = grep { $list[$_] eq $r } ( 0 .. $#list );
    my ($s_idx) = grep { $list[$_] eq $s } ( 0 .. $#list );
    $list[$s_idx] = $r;
    $list[$r_idx] = $s;
}

64 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 17

[ AoC problem link ] [ Discussion ].

Day 17 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $steps  = $input[0];
my @buffer = (0);

my $pos = 0;
my $val = 1;

while ( $val <= 2017 ) {
    my $count = 0;
    my $newpos;
    while ( $count < $steps ) {
        $newpos = $pos + 1;
        if ( $newpos > $#buffer ) {
            $newpos = 0;
        }
        $pos = $newpos;
        $count++;
    }
    my @head = splice( @buffer, 0, $pos + 1 );
    @buffer = ( @head, $val, @buffer );
    $pos = scalar @head;
    $val++;
}
my ($last_pos) = grep { $buffer[$_] == 2017 } ( 0 .. $#buffer );
say "1. value after 2017 is: ", $buffer[ $last_pos + 1 ];

30 lines [ Plain text ] [ ^Top ]

Day 17 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $steps = $input[0];

my $val     = 1;
my $size    = 1;
my $pos = 1;
my $index_1;
while ( $val <= 50_000_000 ) {
    $pos = ( ( $pos + $steps ) % $size ) + 1;
    $size++;
    if ( $pos == 1 ) {
        $index_1 = $val;
    }
    $val++;
}
say "2. value after    0 is: $index_1";

22 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 18

[ AoC problem link ] [ Discussion ].

Day 18 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 = 1;
my %registers;
my @sounds;
my @ins;
while (@input) {
    my @atoms = split( /\s+/, shift @input );
    push @ins, \@atoms;
}

sub value_of;
sub dump_registers;
my %action = (
    set => \&set_register,
    snd => \&play_sound,
    add => \&add_to_register,
    mul => \&multiply_register,
    mod => \&divmod_register,
    rcv => \&recover_freq,
    jgz => \&jump_gt_zero,
);

my $pos = 0;

while ( $pos >= 0 and $pos <= $#ins ) {
    my ( $cmd, $arg1, $arg2 ) = @{ $ins[$pos] };

    my $ret = $action{$cmd}->( $arg1, $arg2 );
    if ( $cmd eq 'rcv' and scalar @sounds and $ret > 1 ) {

        last;
    }
    $pos = $pos + $ret;
}

say "1. last sound played: $sounds[-1]";

###############################################################################
sub dump_registers {
    for my $k (sort {$a cmp $b} keys %registers) {
	print "$k => $registers{$k} ";
    }
    print "\n";
}
sub value_of {
    my ($x) = @_;
    my $val;
    if ( exists $registers{$x} ) {
        $val = $registers{$x};
    }
    else {
        $val = $x;
    }
    return $val;
}

sub play_sound {
    my ( $x, $dummy ) = @_;
    push @sounds, value_of($x);
    return 1;
}

sub set_register {
    my ( $x, $y ) = @_;
    $registers{$x} = value_of($y);
    return 1;
}

sub add_to_register {
    my ( $x, $y ) = @_;
    $registers{$x} += value_of($y);
    return 1;
}

sub multiply_register {
    my ( $x, $y ) = @_;
    my $factor = $registers{$x} // 0;
    my $res    = $factor * value_of($y);
    $registers{$x} = $res;
    return 1;
}

sub divmod_register {
    my ( $x, $y ) = @_;
    my $num = $registers{$x} // 0;
    my $den = value_of($y);
    my $res = $num % $den;
    $registers{$x} = $res;
    return 1;
}

sub recover_freq {
    my ( $x, $dummy ) = @_;
    my $val = value_of($x);
    my $ret = 1;
    if ( $val != 0 ) {
        $ret = 2;
    }
    return $ret;
}

sub jump_gt_zero {
    my ( $x, $y ) = @_;
    my $flag = value_of($x);
    my $jump = 1;
    if ( $flag > 0 ) {
        $jump = value_of($y);
    }
    return $jump;
}


102 lines [ Plain text ] [ ^Top ]

Day 18 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my $debug   = 0;
my @program = (
    {
        registers => { p => 0 },
        queue     => [],
    },
    {
        registers => { p => 1 },
        queue     => [],
    },
);

while (@input) {
    my @atoms = split( /\s+/, shift @input );
    for ( 0, 1 ) {
        push @{ $program[$_]->{ins} }, \@atoms;
    }
}

sub value_of;
sub dump_registers;
my %action = (
    set => \&set_register,
    snd => \&send_value,
    add => \&add_to_register,
    mul => \&multiply_register,
    mod => \&divmod_register,
    rcv => \&receive_value,
    jgz => \&jump_gt_zero,
);

my @pos = ( 0, 0 );

while ( ( $pos[0] >= 0 and $pos[1] >= 0 )
    and ( $pos[0] <= scalar @{ $program[0]->{ins} } - 1 )
    and ( $pos[1] <= scalar @{ $program[1]->{ins} } - 1 ) )
{
    my @compare = @pos;
    for my $p ( 0, 1 ) {
        my ( $cmd, $arg1, $arg2 ) = @{ $program[$p]->{ins}->[ $pos[$p] ] };
        my $ret = $action{$cmd}->( $arg1, $arg2, $p );
        $pos[$p] = $pos[$p] + $ret;
        if ($debug) {
            print "    $p: ";
            dump_registers($p);

        }
    }
    if ( $compare[0] == $pos[0] and $compare[1] == $pos[1] ) {
        last;
    }
}

say "2. number of messages sent by program 1: ",$program[1]->{sends};

###############################################################################
sub dump_registers {
    my ($p) = @_;
    for my $k ( sort { $a cmp $b } keys %{ $program[$p]->{registers} } ) {
        print "$k => $program[$p]->{registers}->{$k} ";
    }
    print "\n";
}

sub value_of {
    my ( $x, $p ) = @_;
    my $val;
    if ( exists $program[$p]->{registers}->{$x} ) {
        $val = $program[$p]->{registers}->{$x};
    }
    else {
        $val = $x;
    }
    return $val;
}

sub send_value {
    my ( $x, $dummy, $p ) = @_;
    my $rec = ( $p == 1 ? 0 : 1 );
    my $msg = value_of( $x, $p );
    push @{ $program[$rec]->{queue} }, $msg;
    say "==> $p sends $msg to $rec" if $debug;
    $program[$p]->{sends}++;
    return 1;
}

sub set_register {
    my ( $x, $y, $p ) = @_;
    $program[$p]->{registers}->{$x} = value_of( $y, $p );
    return 1;
}

sub add_to_register {
    my ( $x, $y, $p ) = @_;
    $program[$p]->{registers}->{$x} += value_of( $y, $p );
    return 1;
}

sub multiply_register {
    my ( $x, $y, $p ) = @_;
    my $factor = $program[$p]->{registers}->{$x} // 0;
    my $res = $factor * value_of( $y, $p );
    $program[$p]->{registers}->{$x} = $res;
    return 1;
}

sub divmod_register {
    my ( $x, $y, $p ) = @_;
    my $num = $program[$p]->{registers}->{$x} // 0;
    my $den = value_of( $y, $p );
    my $res = $num % $den;
    $program[$p]->{registers}->{$x} = $res;
    return 1;
}

sub receive_value {
    my ( $x, $dummy, $p ) = @_;
    my $ret = 0;
    if ( @{ $program[$p]->{queue} } ) {
        my $val = shift @{ $program[$p]->{queue} };
        set_register( $x, $val, $p );
        $ret = 1;
    }
    return $ret;
}

sub jump_gt_zero {
    my ( $x, $y, $p ) = @_;
    my $flag = value_of( $x, $p );
    my $jump = 1;
    if ( $flag > 0 ) {
        $jump = value_of( $y, $p );
    }
    return $jump;
}


127 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 19

[ AoC problem link ] [ Discussion ].

Day 19 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

#### 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 $map;
my ( $maxrow, $maxcol ) = ( 0, 0 );
while (@input) {
    my @line = split( //, shift @input );
    $maxcol = max( $maxcol, scalar @line );
    push @{$map}, \@line;
    $maxrow++;
}

# add buffer row
push @{$map}, [ ' ' x $maxcol ];
my %dirs = (
    up    => [ -1, 0 ],
    down  => [ 1,  0 ],
    left  => [ 0,  -1 ],
    right => [ 0,  1 ]
);

my @sequence;

# sensible dependence on initial starting condition
my $row = 0;
my ($col) =
  grep { $map->[$row]->[$_] eq '|' } ( 0 .. scalar @{ $map->[$row] } - 1 );

my $dir   = 'down';
push @sequence, '|';

# traverse the tubes!
while ( $row >= 0 and $row < $maxrow and $col >= 0 and $col < $maxcol ) {

    my $nextr = $row + $dirs{$dir}->[0];
    my $nextc = $col + $dirs{$dir}->[1];
    my $nextdir;
    my $char = $map->[$nextr]->[$nextc] // ' ';

    if ( $char =~ m/\-|\||[A-Z]/ ) {

        # grab them all, let grep sort 'em out
        push @sequence, $char;
        $nextdir = $dir;
    }
    elsif ( $char eq '+' ) {    # change dir
	push @sequence, $char;
        foreach my $d ( sort keys %dirs ) {
            next if ( $d eq $dir );
            next
              if ( $dirs{$d}->[0] + $dirs{$dir}->[0] == 0
                or $dirs{$d}->[1] + $dirs{$dir}->[1] == 0 );
            my $neighbor =
              $map->[ $nextr + $dirs{$d}->[0] ]->[ $nextc + $dirs{$d}->[1] ]
              // ' ';
            next if ( $neighbor eq ' ' );
            $nextdir = $d;
        }

    }
    elsif ( $char eq ' ' ) {
        last;
    }
    $row = $nextr;
    $col = $nextc;
    $dir = $nextdir;
}

say '1. string: ', join '', grep { $_ =~ m/[A-Z]/ } @sequence;
say '2. count : ', scalar @sequence;


63 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 20

[ AoC problem link ] [ Discussion ].

Day 20 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

#### 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 $id = 0;
my %positions;
while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
        my @p = split( /,/, $1 );
        my @v = split( /,/, $2 );
        my @a = split( /,/, $3 );
        my $d = sum map { abs $_ } @p;
        $positions{$id} = { p => \@p, v => \@v, a => \@a, d => $d };
    }
    else {
        die "cannot parse input line: $line";
    }
    $id++;
}

my $closest =
  ( sort { $positions{$a}->{d} <=> $positions{$b}->{d} } keys %positions )[0];
my $compare = -1;

for my $count ( 0 .. 391 ) {    # limit found by inspection
    $compare = $closest;
    foreach my $id ( keys %positions ) {
        foreach my $m ( 0, 1, 2 ) {
            $positions{$id}->{v}->[$m] += $positions{$id}->{a}->[$m];
            $positions{$id}->{p}->[$m] += $positions{$id}->{v}->[$m];
        }
        $positions{$id}->{d} = sum map { abs $_ } @{ $positions{$id}->{p} };
    }
    $closest =
      ( sort { $positions{$a}->{d} <=> $positions{$b}->{d} } keys %positions )
      [0]

}

say "1. closest particle: ", $closest;

42 lines [ Plain text ] [ ^Top ]

Day 20 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

#### 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 $id = 0;
my %positions;

while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
        my @p = split( /,/, $1 );
        my @v = split( /,/, $2 );
        my @a = split( /,/, $3 );

        $positions{$id} = { p => \@p, v => \@v, a => \@a, };
    }
    else {
        die "cannot parse input line: $line";
    }
    $id++;
}

for my $count ( 0 .. 50 ) {    # value found from inspection
    my %collisions;

    # update positions, find collisions
    foreach my $id ( keys %positions ) {
        foreach my $m ( 0, 1, 2 ) {
            $positions{$id}->{v}->[$m] += $positions{$id}->{a}->[$m];
            $positions{$id}->{p}->[$m] += $positions{$id}->{v}->[$m];
        }
        push @{ $collisions{ join( ',', @{ $positions{$id}->{p} } ) } }, $id;
    }

    my @same;
    foreach my $key ( keys %collisions ) {
        push @same, @{ $collisions{$key} } if scalar @{ $collisions{$key} } > 1;
    }
    if (@same) {
        foreach my $el (@same) {
            delete $positions{$el};
        }

    }
}

say "2. particles remaining after collisions: ", scalar keys %positions;

45 lines [ Plain text ] [ ^Top ]

Day 20 - alternative part 1 - closed form


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;

#### 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 $id = 0;
my %positions;
while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
        my $p = sum map { abs $_ } split( /,/, $1 );
        my $v = sum map { abs $_ } split( /,/, $2 );
        my $a = sum map { abs $_ } split( /,/, $3 );
        $positions{$id} = { p => $p, v => $v, a => $a };
    }
    else {
        die "cannot parse input line: $line";
    }
    $id++;
}

# Select the particle with the lowest absolute acceleration. This
# works for my input, but maybe not for all. In that case the tie
# needs to be broken by absolute velocity.

say "1. closest particle: ",
  ( sort { $positions{$a}->{a} <=> $positions{$b}->{a} } keys %positions )[0];

26 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 21

[ AoC problem link ] [ Discussion ].

Day 21 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

# useful modules
use List::Util qw/sum max/;
use Storable qw/dclone/;
#### 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 string_to_pattern;
sub pattern_to_string;
sub pretty_print;
sub transform_2;
sub transform_3;

my %patterns;
my $id = 1;
foreach my $line (@input) {
    my ( $in, $out ) = $line =~ m/^(.*)\ \=\>\ (.*)$/;
    my $keys;
    if ( length $in == 5 ) {
        $keys = transform_2($in);
    }
    else {
        $keys = transform_3($in);
    }
    foreach my $k (@$keys) {
        if ( exists $patterns{$k} ) {
            say "==> already seen key $k, skipping";
            next;
        }
        $patterns{$k} = { id => $id, pat => $out };
    }
    $id++;
}
my $part2 = shift || 0;
my $grid = [ '.#.', '..#', '###' ];
my $iter = 0;

my $limit = $part2 ? 18 : 5;
while ( $iter < $limit ) {

    my $subgrids;

    my $div;
    if    ( scalar @$grid % 2 == 0 ) { $div = 2 }
    elsif ( scalar @$grid % 3 == 0 ) { $div = 3 }
    else                             { die "weird grid size: scalar @$grid" }
    printf(
        "==> Gridsize: %d  | size / 2 = %.3f  | size / 3 = %.3f | div = %d\n",
        scalar @$grid,
        ( scalar @$grid / 2 ),
        ( scalar @$grid / 3 ), $div
    ) if $debug;

    my ( $mrow, $mcol ) = ( 0, 0 );
    for ( my $i = 0 ; $i < scalar @$grid ; $i += $div ) {
        $mcol = 0;

        for ( my $j = 0 ; $j < length $grid->[$i] ; $j += $div ) {
            for my $offset ( 0 .. $div - 1 ) {
                push @{ $subgrids->[$mrow]->[$mcol]->{array} },
                  substr $grid->[ $i + $offset ], $j, $div;
            }

            $mcol++;
        }
        $mrow++;
    }
    if ($debug) {

        say "grid: ";
        foreach my $r (@$grid) {
            say $r;
        }
    }
    my $newgrid;

    for my $r ( 0 .. $mrow - 1 ) {
        for my $c ( 0 .. $mcol - 1 ) {
            my $count = 0;
            my $string = join( '/', @{ $subgrids->[$r]->[$c]->{array} } );
            say "$r $c $string -> $patterns{$string}->{pat}" if $debug;
            my @repl = split( /\//, $patterns{$string}->{pat} );
            my $size = max map { length $_ } @repl;

            #	    say join( ' ', $size, @repl);
            for my $idx ( 0 .. $size - 1 ) {
                $newgrid->[ $r * $size + $count ] .= shift @repl;
                $count++;
            }
        }
    }
    $grid = dclone $newgrid;
    $iter++;
}
my $count;
foreach my $r (@$grid) {
    $count += grep { $_ eq '#' } split( //, $r );
}

if ($part2) {
    say "2. number of lit pixels: $count"
} else {
    say "1. number of lit pixels: $count"
}


###############################################################################

sub pretty_print {
    my ($str) = @_;
    $str =~ s/\//\n/g;
    say $str;
    print "\n";
}

sub string_to_pattern {
    my ($str) = @_;
    my @rows = split( /\//, $str );
    my $out;
    foreach my $r (@rows) {
        foreach my $el ( split( //, $r ) ) {
            push @{$out}, $el;
        }
    }
    return $out;
}

sub pattern_to_string {
    my ($pat) = @_;
    my $out;
    my $group;

    # we can have 2x2 or 3x3 patterns
    if ( scalar @$pat == 4 ) {
        $group = 2;
    }
    elsif ( scalar @$pat == 9 ) {
        $group = 3;
    }
    else {
        die "can't parse pattern: ", join( '', @{$pat} );
    }

    #    my $group = scalar @$pat ;
    my $idx = 0;
    foreach my $el ( @{$pat} ) {
        if ( !defined $el ) {
            die "bad value";
        }
        $out .= $el;
        $idx++;
        if ( $idx % $group == 0 ) {
            $out .= '/';
        }
    }
    $out =~ s/\/$//gm;
    return $out;
}

sub transform_2 {
    my ($str) = @_;
    my $p = string_to_pattern($str);
    my $transforms;
    $transforms->{ pattern_to_string( [ $p->[0], $p->[1], $p->[2], $p->[3], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[0], $p->[2], $p->[1], $p->[3], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[1], $p->[0], $p->[3], $p->[2], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[1], $p->[3], $p->[0], $p->[2], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[2], $p->[0], $p->[3], $p->[1], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[2], $p->[3], $p->[0], $p->[1], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[3], $p->[1], $p->[2], $p->[0], ] )
    }++;
    $transforms->{ pattern_to_string( [ $p->[3], $p->[2], $p->[1], $p->[0], ] )
    }++;

    return [ keys %{$transforms} ];
}

sub transform_3 {
    my ($str) = @_;
    my $p = string_to_pattern($str);
    my $transforms;
    $transforms->{
        pattern_to_string(
            [
                $p->[0], $p->[1], $p->[2], $p->[3], $p->[4],
                $p->[5], $p->[6], $p->[7], $p->[8],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[0], $p->[3], $p->[6], $p->[1], $p->[4],
                $p->[7], $p->[2], $p->[5], $p->[8],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[2], $p->[1], $p->[0], $p->[5], $p->[4],
                $p->[3], $p->[8], $p->[7], $p->[6],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[2], $p->[5], $p->[8], $p->[1], $p->[4],
                $p->[7], $p->[0], $p->[3], $p->[6],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[6], $p->[3], $p->[0], $p->[7], $p->[4],
                $p->[1], $p->[8], $p->[5], $p->[2],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[6], $p->[7], $p->[8], $p->[3], $p->[4],
                $p->[5], $p->[0], $p->[1], $p->[2],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[8], $p->[5], $p->[2], $p->[7], $p->[4],
                $p->[1], $p->[6], $p->[3], $p->[0],
            ]
        )
    }++;
    $transforms->{
        pattern_to_string(
            [
                $p->[8], $p->[7], $p->[6], $p->[5], $p->[4],
                $p->[3], $p->[2], $p->[1], $p->[0],
            ]
        )
    }++;

    return [ keys %{$transforms} ];
}

235 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 22

[ AoC problem link ] [ Discussion ].

Day 22 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $map;

sub pretty_print;
my $row   = 0;
my $lastc = 0;
while (@input) {
    my @line = split( //, shift @input );
    foreach my $c ( 0 .. $#line ) {
        $map->{$row}->{$c} = $line[$c];
    }
    $row++;
    $lastc = scalar @line;
}

# inspection show midpoint
my $pos = $testing ? [ 1, 1 ] : [ 12, 12 ];

# our coordinate system is row/cols: "up" is negative 1st coord
my $dir      = [ -1, 0 ];
my $limit    = 10_000;
my $moves    = 0;
my $infected = 0;
while ( $moves < $limit ) {

    # does node exist? if not create it
    my $state;
    if ( exists $map->{ $pos->[0] }->{ $pos->[1] } ) {
        $state = $map->{ $pos->[0] }->{ $pos->[1] };
    }
    else {
        $map->{ $pos->[0] }->{ $pos->[1] } = '.';
        $state = '.';
    }

    # inspect current node, turn, and act on node
    if ( $state eq '#' ) {
        $dir = turn_right($dir);
        $map->{ $pos->[0] }->{ $pos->[1] } = '.';
    }
    else {
        $dir = turn_left($dir);
        $map->{ $pos->[0] }->{ $pos->[1] } = '#';
        $infected++;
    }

    # move
    $pos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ];
    $moves++;
}
say $infected;
###############################################################################
sub turn_left {
    my ($in) = @_;
    my $out;

    if ( $in->[0] == -1 and $in->[1] == 0 ) {    #up
        $out = [ 0, -1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == -1 ) {    #left
        $out = [ 1, 0 ];
    }
    elsif ( $in->[0] == 1 and $in->[1] == 0 ) {     #down
        $out = [ 0, 1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == 1 ) {     #right
        $out = [ -1, 0 ];
    }
    else {
        die "can't parse direction: [ $in->[0], $in->[1] ]";
    }
    return $out;
}

sub turn_right {
    my ($in) = @_;
    my $out;

    if ( $in->[0] == -1 and $in->[1] == 0 ) {    #up
        $out = [ 0, 1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == -1 ) {    #left
        $out = [ -1, 0 ];
    }
    elsif ( $in->[0] == 1 and $in->[1] == 0 ) {     #down
        $out = [ 0, -1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == 1 ) {     #right
        $out = [ 1, 0 ];
    }
    else {
        die "can't parse direction: [ $in->[0], $in->[1] ]";
    }
    return $out;
}

sub pretty_print {
    foreach my $r ( sort { $a <=> $b } keys %{$map} ) {
        foreach my $c ( sort { $a <= $b } keys %{ $map->{$r} } ) {
            if ( exists $map->{$r}->{$c} ) {
                print $map->{$r}->{$c};
            }
            else {
                print '.';
            }

        }
        print "\n";
    }
    print "\n";
}

104 lines [ Plain text ] [ ^Top ]

Day 22 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $map;

sub pretty_print;
my $row   = 0;
my $lastc = 0;
while (@input) {
    my @line = split( //, shift @input );
    foreach my $c ( 0 .. $#line ) {
        $map->{$row}->{$c} = $line[$c];
    }
    $row++;
    $lastc = scalar @line;
}

# inspection show midpoint
my $pos = $testing ? [ 1, 1 ] : [ 12, 12 ];

# our coordinate system is row/cols: "up" is negative 1st coord
my $dir      = [ -1, 0 ];
my $limit    = 10000000;
my $moves    = 0;
my $infected = 0;
while ( $moves < $limit ) {

    # does node exist? if not create it
    my $state;
    if ( exists $map->{ $pos->[0] }->{ $pos->[1] } ) {
        $state = $map->{ $pos->[0] }->{ $pos->[1] };
    }
    else {
        $map->{ $pos->[0] }->{ $pos->[1] } = '.';
        $state = '.';
    }

    # inspect current node, turn, and act on node
    if ( $state eq '#' ) {
        $dir = turn_right($dir);
        $map->{ $pos->[0] }->{ $pos->[1] } = 'F';
    }
    elsif ( $state eq 'W' ) {

        # dir does not change
        $map->{ $pos->[0] }->{ $pos->[1] } = '#';
        $infected++;
    }
    elsif ( $state eq 'F' ) {
        $dir = my_reverse($dir);
        $map->{ $pos->[0] }->{ $pos->[1] } = '.';
    }
    else {    # clean
        $dir = turn_left($dir);
        $map->{ $pos->[0] }->{ $pos->[1] } = 'W';
    }

    # move
    $pos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ];
    $moves++;
}
say $infected;
###############################################################################
sub turn_left {
    my ($in) = @_;
    my $out;

    if ( $in->[0] == -1 and $in->[1] == 0 ) {    #up
        $out = [ 0, -1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == -1 ) {    #left
        $out = [ 1, 0 ];
    }
    elsif ( $in->[0] == 1 and $in->[1] == 0 ) {     #down
        $out = [ 0, 1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == 1 ) {     #right
        $out = [ -1, 0 ];
    }
    else {
        die "can't parse direction: [ $in->[0], $in->[1] ]";
    }
    return $out;
}

sub turn_right {
    my ($in) = @_;
    my $out;

    if ( $in->[0] == -1 and $in->[1] == 0 ) {    #up
        $out = [ 0, 1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == -1 ) {    #left
        $out = [ -1, 0 ];
    }
    elsif ( $in->[0] == 1 and $in->[1] == 0 ) {     #down
        $out = [ 0, -1 ];
    }
    elsif ( $in->[0] == 0 and $in->[1] == 1 ) {     #right
        $out = [ 1, 0 ];
    }
    else {
        die "can't parse direction: [ $in->[0], $in->[1] ]";
    }
    return $out;
}

sub my_reverse {
    my ($in) = @_;
    my $out;
    for my $i ( 0, 1 ) {
        $out->[$i] = $in->[$i] == 0 ? 0 : -1 * $in->[$i];
    }
    return $out;
}

sub pretty_print {
    foreach my $r ( sort { $a <=> $b } keys %{$map} ) {
        foreach my $c ( sort { $a <= $b } keys %{ $map->{$r} } ) {
            if ( exists $map->{$r}->{$c} ) {
                print $map->{$r}->{$c};
            }
            else {
                print '.';
            }

        }
        print "\n";
    }
    print "\n";
}

120 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 23

[ AoC problem link ] [ Discussion ].

Day 23 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 %registers;
my @ins;
my $line = 0;
while (@input) {
    my @atoms = split( /\s+/, shift @input );
    push @ins, \@atoms;
    $line++;
}

sub value_of;
my %action = (
    set => \&set_register,
    sub => \&decrease_register,
    mul => \&multiply_register,
    jnz => \&jump_not_zero,
);
map { $registers{$_} = 0 } ( 'a' .. 'h' );

#$registers{a} = 0;

my $pos = 0;
my $multiplies;
while ( $pos >= 0 and $pos <= $#ins ) {
    my ( $cmd, $arg1, $arg2 ) = @{ $ins[$pos] };
    my $ret = $action{$cmd}->( $arg1, $arg2 );
    $multiplies++ if $cmd eq 'mul';
    $pos = $pos + $ret;
}

say "1. number of multiplications: ", $multiplies;

###############################################################################
sub value_of {
    my ($x) = @_;
    my $val;
    if ( exists $registers{$x} ) {
        $val = $registers{$x};
    }
    else {
        $val = $x;
    }
    return $val;
}

sub set_register {
    my ( $x, $y ) = @_;
    $registers{$x} = value_of($y);
    return 1;
}

sub add_to_register {
    my ( $x, $y ) = @_;
    $registers{$x} += value_of($y);
    return 1;
}

sub decrease_register {
    my ( $x, $y ) = @_;
    $registers{$x} -= value_of($y);
    return 1;
}

sub multiply_register {
    my ( $x, $y ) = @_;
    my $factor = $registers{$x} // 0;
    my $res = $factor * value_of($y);
    $registers{$x} = $res;
    return 1;
}

sub jump_not_zero {
    my ( $x, $y ) = @_;
    my $flag = value_of($x);
    my $jump = 1;
    if ( $flag != 0 ) {
        $jump = value_of($y);
    }
    return $jump;
}


75 lines [ Plain text ] [ ^Top ]

Day 23 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use ntheory qw/is_prime/;
###
# credit: Reddit /u/dario_p1
# https://www.reddit.com/r/adventofcode/comments/7lms6p/2017_day_23_solutions/drnmlbk/

my $input = 67; # from the first line of the input
my $lower = $input * 100 + 100_000;
my $upper = $lower + 17_000;
my $h     = 0;

for ( my $i = $lower ; $i <= $upper ; $i += 17 ) {
    if ( !is_prime($i) ) {
        $h++;
    }
}

say "2. value of register 'h': ", $h;

14 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 24

[ AoC problem link ] [ Discussion ].

Day 24 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;

#### 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
# credit: reddit user /u/tobiasvl
# https://www.reddit.com/r/adventofcode/comments/7lte5z/2017_day_24_solutions/drpug3v/

my @connections;
while (@input) {
    my $el = shift @input;
    my @ar = split( '/', $el );
    push @connections, \@ar;
}

sub build {
    my ( $path, $components, $connection ) = @_;
    my $strongest = $path;
    my $longest   = $path;
    for my $c (@$components) {
        next unless ( $c->[0] == $connection or $c->[1] == $connection );
        my @npath = ( @$path, $c );
        my @excl = grep { !( $_ ~~ $c ) } @$components;
        my $next = $c->[0] == $connection ? $c->[1] : $c->[0];
        my ( $strong, $long ) = build( \@npath, \@excl, $next );
        if ( sum( map { sum @$_ } @$strong ) >
            ( sum( map { sum @$_ } @$strongest ) ) )
        {
            $strongest = $strong;
        }
        if ( scalar @$long > scalar @$longest ) {
            $longest = $long;
        }
        elsif ( scalar @$long == scalar @$longest ) {
            $longest = $long
              if ( sum( map { sum @$_ } @$long ) >
                sum( map { sum @$_ } @$longest ) );
        }
    }
    return ( $strongest, $longest );
}

my ( $p1, $p2 ) = build( [], \@connections, 0 );

say "1. strongest bridge has strength: ", sum( map { sum @$_ } @$p1 );
say "2.   longest bridge has strength: ", sum( map { sum @$_ } @$p2 );


44 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 25

[ AoC problem link ] [ Discussion ].

Day 25 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

### CODE
my $tape;

my %actions = (
    A  => \&stateA,
    B  => \&stateB,
    C  => \&stateC,
    D  => \&stateD,
    E  => \&stateE,
    F  => \&stateF,
    tA => \&testA,
    tB => \&testB,
);

my $limit = $testing ? 6 : 12794428;

my $steps = 0;
my $pos   = 0;
my $state = $testing ? 'tA' : 'A';

while ( $steps < $limit ) {
    ( $pos, $state ) = @{ $actions{$state}->($pos) };
    $steps++;
}

my $checksum = 0;
foreach my $h ( keys %$tape ) {
    $checksum++ if $tape->{$h} == 1;
}
say $checksum;
###############################################################################
sub value_of {
    my ($p) = @_;
    if ( exists $tape->{$p} ) {
        return $tape->{$p};
    }
    else {
        $tape->{$p} = 0;
        return 0;
    }
}

sub stateA {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'B' ];
    }
    else {
        $tape->{$p} = 0;
        $p = $p + 1;
        return [ $p, 'F' ];
    }
}

sub stateB {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 0;
        $p = $p - 1;
        return [ $p, 'C' ];
    }
    else {
        $tape->{$p} = 0;
        $p = $p - 1;
        return [ $p, 'D' ];
    }
}

sub stateC {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 1;
        $p = $p + 1;
        return [ $p, 'D' ];
    }
    else {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'E' ];
    }
}

sub stateD {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 0;
        $p = $p + 1;
        return [ $p, 'E' ];
    }
    else {
        $tape->{$p} = 0;
        $p = $p + 1;
        return [ $p, 'D' ];
    }
}

sub stateE {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 0;
        $p = $p - 1;
        return [ $p, 'A' ];
    }
    else {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'C' ];
    }
}

sub stateF {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 1;
        $p = $p + 1;
        return [ $p, 'A' ];
    }
    else {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'A' ];
    }
}

sub testA {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'tB' ];
    }
    else {
        $tape->{$p} = 0;
        $p = $p + 1;
        return [ $p, 'tB' ];
    }
}

sub testB {
    my ($p) = @_;
    my $v = value_of($p);
    if ( $v == 0 ) {
        $tape->{$p} = 1;
        $p = $p - 1;
        return [ $p, 'tA' ];
    }
    else {
        $tape->{$p} = 1;
        $p = $p + 1;
        return [ $p, 'tA' ];
    }
}

149 lines [ Plain text ] [ ^Top ]

Generated on Wed Dec 27 07:50:13 2017 UTC.