For information, see Column B.

#! /bin/sh
/bin/cat <<'%%%'
Content-type: text/plain
#! /usr/sbin/perl
# switchback.pl: Program to determine whether a given word is a "switchback."
#
# Version 1.0, copyright 1997 by Jed Hartman.
# Last modification: 10 July 1997.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation, in whole or in part, for any purpose and without fee is
# hereby granted, provided that: (a) the above copyright notice appear in
# all copies; (b) both the copyright notice and this permission notice
# appear in supporting documentation; and (c) no fee is charged for further
# redistribution of the software. This software is provided "as is" without
# express or implied warranty.
#
# Thanks to Jef Poskanzer for the permission-to-use notice.
#
#
# Notes:
#
# Takes a word as input. Creates a list of all strings which consist of reversing
# the given word and changing exactly one letter (to another letter). Then checks
# every string in the created list against a given file containing a list of valid
# words. The result is a list of all words (in the given word file) which can be
# obtained by spelling the original word backward *and* changing exactly one letter.
#
# If you have comments or suggestions, write to me at logos@kith.org. I'm a
# novice perl hacker and would be delighted to receive style comments.
$alphabet = "abcdefghijklmnopqrstuvwxyz";
$wordfilename = "/usr/dict/words";
# Some UNIX systems use "/usr/share/dict/words" instead.
$stop = 0;
while ($stop == 0)
{
  $wordcount = 0;
  @foundwords = ();
  @wordlist = ();
  print "Enter the word to check, or xxx to stop: ";
  $word = <>;
  chop($word);
  if ($word eq "xxx")
  {
    $stop = 1;
    print "\nGoodbye.\n";
    last;
  }
  $rev = reverse($word);
  $rev =~ tr/A-Z/a-z/;
  $wordlength = length($rev);
  for ($cur_let_index = 0; $cur_let_index < $wordlength; $cur_let_index++)
  {
    $cur_let = substr($rev, $cur_let_index, 1);
    for ($i = 0; $i < 26; $i++)
    {
      $new_let = substr($alphabet, $i, 1);
      if ($cur_let eq $new_let)
      {
         next;
      }
      substr($rev, $cur_let_index, 1) = $new_let;
      $wordcount++;
      $wordlist[$wordcount] = $rev;
      substr($rev, $cur_let_index, 1) = $cur_let;
    }
  }
  # Now @wordlist contains a list of 25 * length($word) words, each a reversal-
  # with-one-letter-changed from $word. So go through each line of the dictionary
  # file and compare with each of those words...
  @foundwords = (do lookup(@wordlist));
  foreach $word (@foundwords)
  {
    print "$word\n";
  }
}
# The 'lookup' function takes a list of word candidates and returns a list of
# those candidates which are found in the given word file.
#
# Assumption is that the word-list file contains one word per line, each line
# (including final line) terminated by a return. Words need not be in any
# particular order, though if we assume alphabetical, routine could be smarter.
#
# There's probably a nicer way to do this in Perl, but I didn't see it offhand.
sub lookup
{
  @found = ();
  $foundwordcount = 0;
  @words = @_;  # passed parameter list
  open(WORDFILE, "$wordfilename");
  while ($nextword = ) # get the next line from the word file
  {
    chop ($nextword);
    foreach $to_find (@words) # iterate over all candidate words
    {
      if ($to_find eq $nextword)
      {
        $found[$foundwordcount++] = $nextword;  # add to list of actual words
      }
    }
  }
  close(WORDFILE);
  return @found;
}
%%%