Advertisement
mscha

AoC 2016 day 22

Dec 22nd, 2016
504
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 6 5.86 KB | None | 0 0
  1. #!/usr/bin/env perl6
  2.  
  3. use v6.c;
  4.  
  5. class Node
  6. {
  7.     has Int $.x;
  8.     has Int $.y;
  9.     has Int $.size;
  10.     has Int $.used;
  11.     has Int $.avail;
  12.  
  13.     method Str { "[$!x,$!y:$!size/$!used/$!avail]" }
  14.     method gist { self.Str }
  15.  
  16.     method infix:<eq>(Node $a, Node $b) { $a.x == $b.x && $a.y == $b.y }
  17.  
  18.     method WHICH { "Node|$!x|$!y" }
  19.  
  20.     method is-empty { $!used == 0 }
  21.  
  22.     # Note that IRL, it may or may not fit if self.avail == $n.used (in TB)
  23.     method fits(Node $n) { $!avail >= $n.used }
  24.  
  25.     method blocks(Node $n) { $!used > $n.avail }
  26.  
  27.     method adjacent-to(Node $n) { abs($!x-$n.x) + abs($!y-$n.y) == 1 }
  28.  
  29.     method add-data(Int $data)
  30.     {
  31.         die "No space on {self} for $data of data!" if $data > $!avail;
  32.         $!used += $data;
  33.         $!avail -= $data;
  34.     }
  35.  
  36.     method move-data-to(Node $n)
  37.     {
  38.         die "Nodes {self} and $n are not adjacent!" unless self.adjacent-to($n);
  39.         die "Data on {self} doesn't fit on $n" if self.blocks($n);
  40.  
  41.         my $ret = "Move data from {self} to $n";
  42.  
  43.         $n.add-data($!used);
  44.         $!avail += $!used;
  45.         $!used = 0;
  46.  
  47.         $ret ~= " ({self}; $n)";
  48.         return $ret;
  49.     }
  50. }
  51.  
  52. sub MAIN(IO() $inputfile where *.f, Bool :v(:$verbose) = False)
  53. {
  54.     # Read nodes
  55.     my @nodes;
  56.     for $inputfile.lines -> $line {
  57.         next unless $line ~~ / ^ '/dev/' /;
  58.         my ($node, $size, $used, $avail, $use) = $line.words;
  59.         my ($x, $y) = $node.comb(/\d+/)».Int;
  60.         for $size, $used, $avail -> $s is rw {
  61.             # Remove 'T' postfix.  Assumes all sizes are in TB.
  62.             $s = $s.subst('T','').Int;
  63.         }
  64.         @nodes[$x;$y] = Node.new(:$x, :$y, :$size, :$used, :$avail);
  65.     }
  66.  
  67.     # Part 1
  68.     my $viable = 0;
  69.     for @nodes[*;*] -> $n {
  70.         next if $n.is-empty;
  71.         $viable += @nodes[*;*].grep({ $_ ne $n && $_.fits($n) });
  72.     }
  73.     say "There are $viable viable pairs of nodes.";
  74.  
  75.     # Part 2
  76.     # This algorithm does NOT work in all cases, but IF it gives an answer, it SHOULD be the shortest path,
  77.     # if the following assumptions are true:
  78.     #  - There is exactly one empty node
  79.     #  - The empty node is involved in all moves, i.e. no data can be moved onto a node already in use
  80.     #  - There are no blocking nodes (that can't be moved onto the empty node) in rows 0 and 1
  81.     #  - All blocking nodes are in a single contiguous horizontal "wall" from x0,y to x1,y
  82.     #  - All non-blocking nodes are of similar sizes, and can hold each others data
  83.  
  84.     my $grid-width = +@nodes[*;0];
  85.     my $grid-height = +@nodes[0;*];
  86.  
  87.     # Find the empty node
  88.     my @empty-nodes = @nodes[*;*].grep(*.is-empty);
  89.     if (!@empty-nodes) {
  90.         die "Unable to find an empty node!";
  91.     }
  92.     elsif (@empty-nodes > 1) {
  93.         warn "Warning: more than one empty node found, using the first one";
  94.     }
  95.     my $empty = @empty-nodes[0];
  96.  
  97.     # Find all nodes that block the empty node - i.e. can't be moved into the empty node
  98.     my @blocking-nodes = @nodes[*;*].grep(*.blocks($empty));
  99.    
  100.     # Assumption: this is a solid horizontal wall that we need to pass.
  101.     my ($wall-x0, $wall-x1) = (@blocking-nodes».x.min, @blocking-nodes».x.max);
  102.     my ($wall-y0, $wall-y1) = (@blocking-nodes».y.min, @blocking-nodes».y.max);
  103.     warn "Blocking nodes not in a horizontal wall" if $wall-y1 > $wall-y0;
  104.     warn "Blocking nodes not in an unbroken horizontal wall"
  105.                 if any(($wall-x0..$wall-x1).map({ @nodes[$_;$wall-y0] }))@blocking-nodes;
  106.  
  107.     # We need to pass left or right of the wall, take the shortest route
  108.     my $target-x = $empty.x;
  109.     if $wall-y0 < $empty.y {
  110.         if $wall-x0 > $empty.x || $wall-x1 < $empty.x {
  111.             $target-x = $empty.x;
  112.         }
  113.         elsif $wall-x1 < $grid-width-1 {
  114.             $target-x = $wall-x1+1;
  115.         }
  116.         elsif $wall-x0 > 0 {
  117.             $target-x = $wall-x0-1;
  118.         }
  119.         else {
  120.             die "Unable to pass blocking wall at y = $wall-y0, x = $wall-x0 - $wall-x1";
  121.         }
  122.     }
  123.  
  124.     my @moves;
  125.  
  126.     # Move empty cell to x == target-x
  127.     for $empty.x ... $target-x -> $x {
  128.         next if $x == $empty.x;
  129.         @moves.push: @nodes[$x;$empty.y].move-data-to($empty);
  130.         $empty = @nodes[$x;$empty.y];
  131.     }
  132.  
  133.     # Now move it to y == 0
  134.     for $empty.y ... 0 -> $y {
  135.         next if $y == $empty.y;
  136.         @moves.push: @nodes[$empty.x;$y].move-data-to($empty);
  137.         $empty = @nodes[$empty.x;$y];
  138.  
  139.         # If we're at the extreme right border, we need to take a step left when y == 1
  140.         if $empty.x == $grid-width-1 && $empty.y == 1 {
  141.             @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
  142.             $empty = @nodes[$empty.x-1;1]
  143.         }
  144.     }
  145.  
  146.     # And move it to x == grid-width-2
  147.     for $empty.x ... $grid-width-2 -> $x {
  148.         next if $x == $empty.x;
  149.         @moves.push: @nodes[$x;$empty.y].move-data-to($empty);
  150.         $empty = @nodes[$x;$empty.y];
  151.     }
  152.  
  153.     # Now we're in position to move the data from the upper right to the upper left corner.
  154.     #  - Move data into empty cell
  155.     #  - Move empty cell around data cell
  156.     #  - Repeat until x == 0
  157.     my $data = @nodes[$grid-width-1;0];
  158.     while $data.x > 0 {
  159.         @moves.push: $data.move-data-to($empty);
  160.         ($data, $empty) = ($empty, $data);
  161.         last if $data.x == 0;
  162.         @moves.push: @nodes[$empty.x;1].move-data-to($empty);
  163.         $empty = @nodes[$empty.x;1];
  164.         @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
  165.         $empty = @nodes[$empty.x-1;1];
  166.         @moves.push: @nodes[$empty.x-1;1].move-data-to($empty);
  167.         $empty = @nodes[$empty.x-1;1];
  168.         @moves.push: @nodes[$empty.x;0].move-data-to($empty);
  169.         $empty = @nodes[$empty.x;0];
  170.     }
  171.  
  172.     say '';
  173.     @moves».say if $verbose;
  174.     say "It takes @moves.elems() moves to gain access to the required data.";
  175. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement