2023/43.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.38;
   4 use experimental 'multidimensional';
   5
   6 my @bricks = map { [ /\d+/g ] } <>;
   7 my %seen;
   8 sub set_brick {
   9         my ($b) = @_;
  10
  11         for my $x ($b->[0] .. $b->[3]) {
  12         for my $y ($b->[1] .. $b->[4]) {
  13         for my $z ($b->[2] .. $b->[5]) {
  14                 $seen{$x,$y,$z} = 1;
  15         } } }
  16 }
  17
  18 sub clr_brick {
  19         my ($b) = @_;
  20
  21         for my $x ($b->[0] .. $b->[3]) {
  22         for my $y ($b->[1] .. $b->[4]) {
  23         for my $z ($b->[2] .. $b->[5]) {
  24                 undef $seen{$x,$y,$z};
  25         } } }
  26 }
  27
  28 sub can_fall {
  29         my ($b) = @_;
  30
  31         return undef if !$b->[5];
  32         my $z = $b->[5]-1;
  33
  34         for my $x ($b->[0] .. $b->[3]) {
  35         for my $y ($b->[1] .. $b->[4]) {
  36                 return undef if $seen{$x,$y,$b->[2]-1};
  37         } }
  38         return 1;
  39 }
  40
  41 set_brick($_) for @bricks;
  42
  43 while (1) {
  44         my $fallen;
  45         my $i = 0;
  46         for my $b (@bricks) {
  47                 $i++;
  48                 next if !can_fall($b);
  49                 # say "falling $i (@$b)";
  50                 clr_brick($b);
  51                 $b->[2]--; $b->[5]--;
  52                 set_brick($b);
  53                 # say "fallen  $i (@$b)";
  54                 $fallen++;
  55         }
  56         last if !$fallen;
  57 }
  58
  59 my $count = 0;
  60 my (%supported, %supports);
  61 for my $bi0 (0 .. $#bricks) {
  62         my $b0 = $bricks[$bi0];
  63         my $cnt = 0;
  64         BRICK:
  65         for my $bi1 (0 .. $#bricks) {
  66                 next if $bi0 == $bi1;
  67                 my $b1 = $bricks[$bi1];
  68                 # say "possibly supports $bi0 (@$b0) $bi1 (@$b1)";
  69                 next if $b1->[2] != $b0->[5]+1;
  70                 for my $x0 ($b0->[0] .. $b0->[3]) {
  71                 for my $x1 ($b1->[0] .. $b1->[3]) {
  72                         next if $x0 != $x1;
  73                         for my $y0 ($b0->[1] .. $b0->[4]) {
  74                         for my $y1 ($b1->[1] .. $b1->[4]) {
  75                                 next if $y0 != $y1;
  76                                 $supports{$bi0}->{$bi1}++;
  77                                 $supported{$bi1}->{$bi0}++;
  78                                 next BRICK;
  79                         } }
  80                 } }
  81         }
  82 }
  83 SBRICK:
  84 for my $bi0 (0 .. $#bricks) {
  85         for my $bi1 (keys %{ $supports{$bi0} }) {
  86                 next SBRICK if keys(%{ $supported{$bi1} }) == 1;
  87         }
  88         $count++;
  89 }
  90
  91 say $count;