2023/44.pl

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