advent of code 2017 Perl6

day1.pl6

my @seq = '112212'.univals.List;
(@seq Z @seq.rotate(1)).grep({[==] $_})».first.sum.say;
(@seq Z @seq.rotate(+@seq div 2)).grep({[==] $_})».first.sum.say;

day2.pl6

my $input = q:to/END/;
5 9 2 8
9 4 7 3
3 8 6 5
END


grammar spreadsheet {
  token TOP { [<line> \s]* }
  token line { [<val> \h?]* }
  token val { \d+ }
};

class spreadsheet-actions {
    method TOP ($/) {
        make [+] $<line>».made;
    }
    method line ($/) {
        my $res = [R-] $<val>».made.minmax.bounds;
        make $res;
    }
    method val ($/) { 
        make +$/; 
    }
}

class part2 is spreadsheet-actions {
    method line  ($/) {
        my @vals = $<val>».made;
        @vals = @vals.sort;
        for @vals -> $a {
            for @vals {
                last if $a == $_;
                if ($a %% $_) {
                    make $a / $_;
                    return;
                }
            }
        }
    }
}

my $actions = part2.new;
say spreadsheet.parse($input, :$actions).made;

day3.pl6

my $input = 361527;
my $x = 0;
my $y = 0;
my $i = 1;
my $dir = 1;
my %values;
my $r = 1;
%values{($x,$y).Str} = $r;
while $r <= $input { # while $i < $input {
  $i++;
  given $dir {
    when 1 { $x++; }
    when 2 { $y--; }
    when 3 { $x--; }
    when 4 { $y++; }
  }
  if $x > 0 && $x == $y + 1 {
    $dir = 2;
  }
  if $x > 0 && $x == -$y {
    $dir = 3;
  }
  if $x < 0 && $x == $y {
    $dir = 4;
  }
  if $x < 0 && $x == -$y {
    $dir = 1;
  }
  quietly {
    $r = [+] (%values{($x - 1,$y - 1).Str}, %values{($x,$y - 1).Str}, %values{($x + 1,$y - 1).Str},
        %values{($x - 1,$y).Str}, %values{($x + 1,$y).Str},
        %values{($x - 1,$y + 1).Str}, %values{($x,$y + 1).Str}, %values{($x + 1,$y + 1).Str});
  }
  %values{($x,$y).Str} = $r;
}

# say $x.abs + $y.abs;
say $r;

day4.pl6

my $input = q:to/END/;
5 9 2 8
9 4 7 3 4
3 8 6 5
END

say +$input.lines.grep(!*.words.repeated);
say +$input.lines.grep(!*.words.map({~.comb.sort}).repeated);

day5.pl6

my $input = q:to/END/;
0
3
0
1
-3
END

my @directions = $input.lines.map(*.Int).Array;
my $pos = 0;
my $steps = 0;
my $max = @directions;
while 0 <= $pos < $max {
    my $next = @directions[$pos];
    if $next > 2 {
        @directions[$pos] = $next - 1;
    } else {
        @directions[$pos] = $next + 1;
    }
    $pos += $next;
    $steps++;
}

$steps.say;

day7.pl6

my $input = '0 2 7 0';

my sub distribute(Int:D $value, Int:D $len --> List:D) {
    # optimization (avoids % and div)
    if $value <= $len { return (flat (1 xx $value), (0 xx ($len - $value))).List; }
    my $rem = $value % $len;
    my $div = $value div $len;
    if (!$rem) { return $div xx $len; }
    (flat (($div + 1) xx $rem), ($div xx ($len - $rem))).List
}

my @vals = +<<$input.words;
my $len = +@vals;
my %states = BagHash.new;
my $steps = 0;
my $vs = ~@vals; # local because I am using it twice
while !%states{$vs}  {
    $steps++;
    %states{$vs} = $steps;
    my $maxpair = @vals.maxpairs[0];
    # maxpairs apparently mutates the underlying list; must create a local :/
    my @dist = distribute($maxpair.value, $len).rotate(-$maxpair.key - 1);
    # OTOH I don't need to do an index now because of how maxpairs works ...
    $maxpair.value = 0;
    @vals = @vals >>+<< @dist; # to >>+<< or Z+ ??? meh
    $vs = ~@vals;
}

$steps.say;
($steps - %states{$vs} + 1).say;

day8.pl6

my $input = q:to/END/;
pbga (66)
xhth (57)
ebii (61)
havc (66)
ktlj (57)
fwft (72) -> ktlj, cntj, xhth
qoyq (66)
padx (45) -> pbga, havc, qoyq
tknk (41) -> ugml, padx, fwft
jptl (61)
ugml (68) -> gyxo, ebii, jptl
gyxo (61)
cntj (57)
END

class tower {
    has Str $.name;
    has Int $.weight;
    has Str @.discs;

    has tower @.elems;
    has tower $.parent;

    method set-parent(tower:D $p) { 
        $!parent = $p;
        $p.elems.push(self);
    }
    
    method rebalance() {
        return $!weight unless @!elems;
        my @children = @!elems».rebalance();
        my $fix = 0;
        unless [==] @children {
            my @mapped = (@children Z @!elems).sort: *.first;
            $fix = ([R-] @mapped.head(2)».first) + ([-] @mapped.tail(2)».first);
            my $tower = $fix > 0 ?? @mapped[0][1] !! @mapped[*-1][1];
            my $res = $fix + $tower.weight;
            say $res ~ ' on ' ~ $tower.name;
        }
        return $!weight + $fix + [+] @children;
    }
    
    method gist { @!elems ?? "$!name " ~ @!elems.gist ~ '' !! $!name }
}

grammar tower-lang {
    rule TOP { <tower>* }
    rule tower { <disc> '(' <weight> ')' [ '->' <sub-towers> ]? }
    rule sub-towers { <disc>+ % ',' }
    token disc { \w+ }
    token weight { \d+ }
}

class tower-actions {
    method TOP ($/) { 
        my %towers  = $<tower>».made;
        for %towers.kv -> $k,$v {
            next unless $v.discs;
            for $v.discs -> $name {
                next unless $name;
                my $c = %towers{$name};
                $c.set-parent($v);
            }
        }
        make %towers.values.grep: !*.parent;
    }
    method tower      ($/) { make $<disc>.made => tower.new(:name($<disc>.made), :weight($<weight>.made), :discs($<sub-towers>.made)); }
    method disc       ($/) { make ~$/; }
    method weight     ($/) { make +$/; }
    method sub-towers ($/) { make $<disc>».made; }
}

my $actions = tower-actions.new;
my @towers = tower-lang.parse($input, :$actions).made;

my $root = @towers.first; # problem only has 1 root
$root.say;
$root.rebalance();