2017/28.pl

   1 #!/usr/bin/perl
   2
   3 use v5.30;
   4 use strict;
   5
   6 my $in = 'stpzcrnm';
   7 # my $in = 'flqrgnkx';
   8
   9 sub knot {
  10         my $line = shift;
  11         my @l = map { ord } split //, $line;
  12         push @l, 17, 31, 73, 47, 23;
  13
  14         my $pos = 0;
  15         my $skip = 0;
  16         # my @nodes = (0 .. 4);
  17         my @nodes = (0 .. 255);
  18         my $n = @nodes;
  19
  20         for (1 .. 64) {
  21                 for my $i (@l) {
  22                         my $end = $pos + $i;
  23                         my @to_rev;
  24                         # say "pos=$pos skip $skip i=$i ", join(',', @nodes);
  25                         if ($end > $n) {
  26                                 push @to_rev, splice @nodes, $pos;
  27                                 push @to_rev, splice @nodes, 0, $end - $n;
  28                                 @to_rev = reverse @to_rev;
  29                                 # say "to_rev = ", join(',', @to_rev);
  30                                 unshift @nodes, splice @to_rev, @to_rev-($end-$n);
  31                                 push @nodes, @to_rev;
  32                         } else {
  33                                 push @to_rev, splice @nodes, $pos, $i;
  34                                 splice @nodes, $pos, 0, reverse @to_rev;
  35                         }
  36                         $pos += $i + $skip++;
  37                         $pos -= $n while $pos >= $n;
  38                 }
  39         }
  40
  41         my $hash = '';
  42         while (my @s = splice (@nodes, 0, 16)) {
  43                 my $x = 0;
  44                 $x ^= $_ for @s;
  45                 $hash .= sprintf("%08b", $x);
  46         }
  47         return $hash;
  48 }
  49
  50 my @prev = (0) x 128;
  51 my %regions;
  52 my $nr = 1;
  53 for my $row (0 .. 127) {
  54         my $h = knot("$in-$row");
  55         my @line = split //, $h;
  56         my @nl = (0) x 128;
  57         for my $x (0 .. 127) {
  58                 next if $line[$x] == '0';
  59
  60                 if ($prev[$x]) {
  61                         $nl[$x] = $prev[$x];
  62                 } elsif ($x && $nl[$x-1]) {
  63                         $nl[$x] = $nl[$x-1];
  64                 } else {
  65                         $nl[$x] = $nr;
  66                         $regions{$nr} = 1;
  67                         $nr++;
  68                 }
  69                 if ($x && $nl[$x-1] && $nl[$x-1] != $nl[$x]) {
  70                         my $old = $nl[$x-1];
  71                         delete $regions{$old};
  72                         for (0 .. 127) {
  73                                 $nl[$_] = $nl[$x] if $nl[$_] == $old;
  74                                 $prev[$_] = $nl[$x] if $prev[$_] == $old;
  75                         }
  76                 }
  77         }
  78         @prev = @nl;
  79 }
  80
  81 say scalar keys %regions;
  82