chiark - git - mdw - wordchain/blob - chain.perl

   1 #! /usr/bin/perl -w
   2
   3 use autodie;
   4 use strict;
   5
   6 use constant { WORD => 0, LEN => 1, UP => 2, DOWN => 3, RIGHT => 4 };
   7
   8 my %WORD;
   9 while (<>) {
  10   chomp;
  11   $WORD{$_} = [$_, 1, undef, undef, undef];
  12 }
  13
  14 my $MAX = 0;
  15 WORD: while (my ($word, $node) = each %WORD) {
  16   my $len = length $word;
  17   my $parent = $len <= 1 ? undef : $WORD{substr $word, 0, $len - 1};
  18   $node->[UP] = $parent;
  19   my $nlen = $node->[LEN];
  20   UP: while (defined $parent) {
  21     my $plen = $parent->[LEN]; $nlen++;
  22     if ($plen > $nlen)
  23       { last UP; }
  24     elsif ($plen == $nlen)
  25       { $node->[RIGHT] = $parent->[DOWN]; $parent->[DOWN] = $node; last UP; }
  26     else {
  27       $parent->[DOWN] = $node; $node->[RIGHT] = undef;
  28       $parent->[LEN] = $nlen;
  29       $node = $parent; $parent = $node->[UP];
  30     }
  31   }
  32   if ($nlen > $MAX) { $MAX = $nlen; }
  33 }
  34
  35 sub print_chain ($);
  36 sub print_chain ($) {
  37   my ($node) = @_;
  38
  39   if (!defined $node->[RIGHT]) {
  40     print $node->[WORD];
  41     if (defined $node->[DOWN]) { print " "; print_chain $node->[DOWN]; }
  42   } else {
  43     print "{ ";
  44     ALT: for (;;) {
  45       print $node->[WORD];
  46       if (defined $node->[DOWN]) { print " "; print_chain $node->[DOWN]; }
  47       $node = $node->[RIGHT]; last ALT unless defined $node;
  48       print " | ";
  49     }
  50     print " }";
  51   }
  52 }
  53
  54 for my $node (values %WORD)
  55   { if ($node->[LEN] == $MAX) { print_chain $node; print "\n"; } }