Day 25: examining the input

diff --git a/2023/49.pl b/2023/49.pl
new file mode 100755 (executable)
index 0000000..5c11b3e
--- /dev/null
+++ b/2023/49.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+
+use v5.38;
+use experimental 'for_list';
+
+=for comment
+
+convert the input to .dot format:
+
+strict graph g {
+ggk -- { tkd };
+vcd -- { nhn };
+xhj -- { mft rtg hvp sgl };
+hgx -- { dxq stc cfn };
+...
+}
+
+Then run
+
+neato -Tsvg 49in.dot
+
+and find the components and their edges.
+
+=cut
+
+my %g;
+while (<>) {
+       my ($n1, @ns) = /\w+/g;
+       for my $n (@ns) {
+               $g{$n}{$n1} = 1;
+               $g{$n1}{$n} = 1;
+       }
+}
+
+sub walk {
+       my ($node, $seen) = @_;
+       my @q = $node;
+       my $visited;
+       while (@q) {
+               my ($n, $d) = shift @q;
+               next if $seen->{$n}++;
+               $visited++;
+               for my $n1 (keys %{ $g{$n} }) {
+                       push @q, $n1;
+               }
+       }
+       return $visited;
+}
+
+sub comps {
+       my %seen;
+       my $m = 1;
+       my $comps;
+       while (%seen != keys %g) {
+               my $prev = 0;
+               for my $n (keys %g) {
+                       next if $seen{$n};
+                       $m *= walk($n, \%seen);
+                       $comps++;
+               }
+       }
+       say "$comps mul=$m" if $comps > 1;
+       return $comps;
+}
+
+for my ($n1, $n2) (qw(rrz pzq jtr mtq ddj znv)) {
+       delete $g{$n1}{$n2};
+       delete $g{$n2}{$n1};
+}
+
+comps();