Pasted

#!/usr/bin/env perl6
 
use v6.c;
 
class Node
{
    has Int $.x;
    has Int $.y;
    has Int $.size;
    has Int $.used;
    has Int $.avail;
 
    method Str { "[$!x,$!y:$!size/$!used/$!avail]" }
    method gist { self.Str }
 
    method infix:<eq>(Node $a, Node $b) { $a.x == $b.x && $a.y == $b.y }
 
    method WHICH { "Node|$!x|$!y" }
 
    method is-empty { $!used == 0 }
 
    # Note that IRL, it may or may not fit if self.avail == $n.used (in TB)
    method fits(Node $n) { $!avail >= $n.used }
 
    method blocks(Node $n) { $!used > $n.avail }
 
    method adjacent-to(Node $n) { abs($!x-$n.x) + abs($!y-$n.y) == 1 }
 
    method add-data(Int $data)
    {
        die "No space on {self} for $data of data!" if $data > $!avail;
        $!used += $data;
        $!avail -= $data;
    }
 
    method move-data-to(Node $n)
    {
        die "Nodes {self} and $n are not adjacent!" unless self.adjacent-to($n);
        die "Data on {self} doesn't fit on $n" if self.blocks($n);
 
        my $ret = "Move data from {self} to $n";
 
        $n.add-data($!used);
        $!avail += $!used;
        $!used = 0;
 
        $ret ~= " ({self}; $n)";
        return $ret;
    }
}
 
sub MAIN(IO() $inputfile where *.f, Bool :v(:$verbose) = False)
{
    # Read nodes
    my @nodes;
    for $inputfile.lines -> $line {
        next unless $line ~~ / ^ '/dev/' /;
        my ($node, $size, $used, $avail, $use) = $line.words;
        my ($x, $y) = $node.comb(/\d+/)».Int;
        for $size, $used, $avail -> $s is rw {
            # Remove 'T' postfix.  Assumes all sizes are in TB.
            $s = $s.subst('T','').Int;
        }
        @nodes[$x;$y] = Node.new(:$x, :$y, :$size, :$used, :$avail);
    }
 
    # Part 1
    my $viable = 0;
    for @nodes[*;*] -> $n {
        next if $n.is-empty;
        $viable += @nodes[*;*].grep({ $_ ne $n && $_.fits($n) });
    }
    say "There are $viable viable pairs of nodes.";
 
    # Part 2
    # This algorithm does NOT work in all cases, but IF it gives an answer, it SHOULD be the shortest path,
    # if the following assumptions are true:
    #  - There is exactly one empty node
    #  - The empty node is involved in all moves, i.e. no data can be moved onto a node already in use
    #  - There are no blocking nodes (that can't be moved onto the empty node) in rows 0 and 1
    #  - All blocking nodes are in a single contiguous horizontal "wall" from x0,y to x1,y
    #  - All non-blocking nodes are of similar sizes, and can hold each others data
 
    my $grid-width = +@nodes[*;0];
    my $grid-height = +@nodes[0;*];
 
    # Find the empty node
    my @empty-nodes = @nodes[*;*].grep(*.is-empty);
    if (!@empty-nodes) {
        die "Unable to find an empty node!";
    }
    elsif (@empty-nodes > 1) {
        warn "Warning: more than one empty node found, using the first one";
    }
    my $empty = @empty-nodes[0];
 
    # Find all nodes that block the empty node - i.e. can't be moved into the empty node
    my @blocking-nodes = @nodes[*;*].grep(*.blocks($empty));
    
    # Assumption: this is a solid horizontal wall that we need to pass.
    my ($wall-x0, $wall-x1) = (@blocking-nodes».x.min, @blocking-nodes».x.max);
    my ($wall-y0, $wall-y1) = (@blocking-nodes».y.min, @blocking-nodes».y.max);
    warn "Blocking nodes not in a horizontal wall" if $wall-y1 > $wall-y0;
    warn "Blocking nodes not in an unbroken horizontal wall"
                if any(($wall-x0..$wall-x1).map({ @nodes[$_;$wall-y0] })) ∉ @blocking-nodes;
 
    # We need to pass left or right of the wall, take the shortest route
    my $target-x = $empty.x;
    if $wall-y0 < $empty.y {
        if $wall-x0 > $empty.x || $wall-x1 < $empty.x {
            $target-x = $empty.x;
        }
        elsif $wall-x1 < $grid-width-1 {
            $target-x = $wall-x1+1;
        }
        elsif $wall-x0 > 0 {
            $target-x = $wall-x0-1;
        }
        else {
            die "Unable to pass blocking wall at y = $wall-y0, x = $wall-x0 - $wall-x1";
        }
    }
 
    my @moves;
 
    # Move empty cell to x == target-x
    for $empty.x ... $target-x -> $x {
        next if $x == $empty.x;
        @moves.push: @nodes[$x;$empty.y].move-data-to($empty);
        $empty = @nodes[$x;$empty.y];
    }
 
    # Now move it to y == 0
    for $empty.y ... 0 -> $y {
        next if $y == $empty.y;
        @moves.push: @nodes[$empty.x;$y].move-data-to($empty);
        $empty = @nodes[$empty.x;$y];
 
        # If we're at the extreme right border, we need to take a step left when y == 1
        if $empty.x == $grid-width-1 && $empty.y == 1 {
            @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
            $empty = @nodes[$empty.x-1;1]
        }
    }
 
    # And move it to x == grid-width-2
    for $empty.x ... $grid-width-2 -> $x {
        next if $x == $empty.x;
        @moves.push: @nodes[$x;$empty.y].move-data-to($empty);
        $empty = @nodes[$x;$empty.y];
    }
 
    # Now we're in position to move the data from the upper right to the upper left corner.
    #  - Move data into empty cell
    #  - Move empty cell around data cell
    #  - Repeat until x == 0
    my $data = @nodes[$grid-width-1;0];
    while $data.x > 0 {
        @moves.push: $data.move-data-to($empty);
        ($data, $empty) = ($empty, $data);
        last if $data.x == 0;
        @moves.push: @nodes[$empty.x;1].move-data-to($empty);
        $empty = @nodes[$empty.x;1];
        @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
        $empty = @nodes[$empty.x-1;1];
        @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
        $empty = @nodes[$empty.x-1;1];
        @moves.push: @nodes[$empty.x;0].move-data-to($empty);
        $empty = @nodes[$empty.x;0];
    }
 
    say '';
    @moves».say if $verbose;
    say "It takes @moves.elems() moves to gain access to the required data.";
}