#!/usr/local/bin/perl -w # $Header: /usr/people/rjk/words/RCS/ladder.pl,v 1.5 2001/02/07 04:23: +20 rjk Exp rjk $ use strict; use vars qw($VERSION); $VERSION = q$Revision: 1.5 $ =~ /Revision:\s*(\S*)/; use Getopt::Std; use vars qw($opt_w); if (not getopts('w:') or @ARGV < 3 or $ARGV[2] =~ /\D/) { die <<EOT; usage: $0 [-w <wordlist>] <word> <word> <max> [<bad word> ...] EOT } my(@word, $max, @bad); (@word[0, 1], $max, @bad) = @ARGV; if (length $word[0] != length $word[1]) { die "Target words must be the same length.\n"; } @bad = map { ($_, 0) } @bad; # for use in hash below my $wordlist = $opt_w || 'wordlist'; open(WORDS, $wordlist) or die "Can't open $wordlist: $!\n"; my @wordlist; while (<WORDS>) { # load word list into mem +ory chomp; push @wordlist, $_ if length $_ == length $word[0]; } close(WORDS); my @max = (int($max / 2) + ($max & 1), int($max / 2)); # split $max in half; # $max may be odd my @queue = ([[$word[0]], 'break'], [[$word[1]], 'break']); # set up both halves of t +he queue my @words = ({$word[0] => [], @bad}, {$word[1] => [], @bad}); # set up both halves of # the word path array my @solution; my $p = 0; # parity; which side of t +he # ladder is being exten +ded # find a solution, advancing one side of the ladder and then the other STEP: while (1) { my $cur = shift @{$queue[$p]}; if (not $cur) { # all paths are dead-ends +; last; # give up } if ($cur eq 'break') { # no more paths to extend push @{$queue[$p]}, 'break' if @{$queue[$p]}; $p ^= 1; # switch to other side of + ladder redo; } my $top = $cur->[-1]; my @step = find_step($top); # find all possible steps # from the current word my $step; foreach $step (@step) { if ($words[$p ^ 1]{$step}) { @solution = (@$cur, $step, reverse @{$words[$p ^ 1]{$step} +}); last STEP; } next if defined $words[$p]{$step}; # skip words already in p +ath # and bad words next if @{$cur} == $max[$p]; # skip if path is at max +length $words[$p]{$step} = [@$cur]; # add this word to path push @{$queue[$p]}, [@$cur, $step]; # put extended path on th +e queue } } if (@solution) { # found a solution! if ($solution[0] eq $word[1]) { # print it, in desired or +der @solution = reverse @solution; } print "@solution\n"; } exit 0; # find_step($word) # returns a list of all the words in the word list # that differ from $word by one character sub find_step { my $word = shift; my $re; $re = '^(?:'; my $i; for ($i = 0; $i < length $word; ++$i) { my $tmp = $word; substr($tmp, $i, 1) = '.'; $re .= $tmp . '|'; } chop($re); $re .= ')$'; $word =~ $re; # cache regex my @matches; for (@wordlist) { if (// and $_ ne $word) { push @matches, $_; } } return @matches; } __END__ =pod =head1 NAME B<ladder> -- find words which can be made from a string of letters =head1 SYNOPSIS B<ladder> [B<-w> I<wordlist>] I<start-word> I<end-word> I<max-length> [I<bad-word> ...] =head1 DESCRIPTION B<ladder> solves word ladders. A word ladder is a progression from one word to another, changing exactly one letter per step. Each intermediate step must also be a word. For example; dog cog cot cat. Given the start word, the end word, and the maximum allowed length, B<ladder> will output a ladder between the two words. B<ladder> produces no output if it is unable to find a ladder within the maximum length. The start and stop word must be the same length. A list of bad words may be specified after the other arguments. B<ladder> will avoid using any of those words in the solution. =head2 OPTIONS B<ladder> accepts the following options: =over 4 =item B<-w> I<wordlist> By default, B<ladder> looks for a word file named 'wordlist' in the same directory as the executable. Use the B<-w> option to specify the path to an alternate word list. =back =head1 FILES =over 4 =item F<wordlist> The list of words, found with the executable. For a comprehensive word list, the author recommends the ENABLE word list, with more than 172,000 words, which can be found at http://personal.riverusers.com/~thegrendel/software.html =back =head1 BUGS This implementation of B<ladder> has no known bugs. =head1 AUTHOR B<ladder> was written by Ronald J Kimball, I<rjk@linguist.dartmouth.edu>. =head1 COPYRIGHT and LICENSE This program is copyright 2001 by Ronald J Kimball. This program is free and open software. You may use, modify, or distribute this program (and any modified variants) in any way you wish, provided you do not restrict others from doing the same. =cut

In reply to Solve Word Ladders by chipmunk

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.