more stuff found lying about

[wordchain] / chain.perl

diff --git a/chain.perl b/chain.perl
index 06a2d39076fa47a7bbb4f9f150a5093b90c27ffb..7e52860f23f36a0b9afe58227dbbb01ea65f7eae 100755 (executable)
--- a/chain.perl
+++ b/chain.perl
@@ -11,13 +11,22 @@ while (<>) {
   $WORD{$_} = [$_, 1, undef, undef, undef];
 }
 
-my $MAX = 0;
+my $MAX = 0; my @WINNERS;
 WORD: while (my ($word, $node) = each %WORD) {
   my $len = length $word;
-  my $parent = $len <= 1 ? undef : $WORD{substr $word, 0, $len - 1};
+  next WORD unless $len >= 2;
+  my $parent = $WORD{substr $word, 0, $len - 1};
+  next WORD unless defined $parent;
   $node->[UP] = $parent;
   my $nlen = $node->[LEN];
-  UP: while (defined $parent) {
+  UP: for (;;) {
+    unless (defined $parent) {
+      if ($nlen >= $MAX) {
+       if ($nlen > $MAX) { $MAX = $nlen; @WINNERS = (); }
+       push @WINNERS, $node;
+      }
+      last UP;
+    }
     my $plen = $parent->[LEN]; $nlen++;
     if ($plen > $nlen)
       { last UP; }
@@ -51,5 +60,4 @@ sub print_chain ($) {
   }
 }
 
-for my $node (values %WORD)
-  { if ($node->[LEN] == $MAX) { print_chain $node; print "\n"; } }
+for my $node (@WINNERS) { print_chain $node; print "\n"; }