2023/49.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.38;
   4 use experimental 'for_list';
   5
   6 =for comment
   7
   8 convert the input to .dot format:
   9
  10 strict graph g {
  11 ggk -- { tkd };
  12 vcd -- { nhn };
  13 xhj -- { mft rtg hvp sgl };
  14 hgx -- { dxq stc cfn };
  15 ...
  16 }
  17
  18 Then run
  19
  20 neato -Tsvg 49in.dot
  21
  22 and find the components and their edges.
  23
  24 =cut
  25
  26 my %g;
  27 while (<>) {
  28         my ($n1, @ns) = /\w+/g;
  29         for my $n (@ns) {
  30                 $g{$n}{$n1} = 1;
  31                 $g{$n1}{$n} = 1;
  32         }
  33 }
  34
  35 sub walk {
  36         my ($node, $seen) = @_;
  37         my @q = $node;
  38         my $visited;
  39         while (@q) {
  40                 my ($n, $d) = shift @q;
  41                 next if $seen->{$n}++;
  42                 $visited++;
  43                 for my $n1 (keys %{ $g{$n} }) {
  44                         push @q, $n1;
  45                 }
  46         }
  47         return $visited;
  48 }
  49
  50 sub comps {
  51         my %seen;
  52         my $m = 1;
  53         my $comps;
  54         while (%seen != keys %g) {
  55                 my $prev = 0;
  56                 for my $n (keys %g) {
  57                         next if $seen{$n};
  58                         $m *= walk($n, \%seen);
  59                         $comps++;
  60                 }
  61         }
  62         say "$comps mul=$m" if $comps > 1;
  63         return $comps;
  64 }
  65
  66 for my ($n1, $n2) (qw(rrz pzq jtr mtq ddj znv)) {
  67         delete $g{$n1}{$n2};
  68         delete $g{$n2}{$n1};
  69 }
  70
  71 comps();