#!/usr/bin/perl5 -wT use strict; =head1 NAME juxta - Generate JuxtaPosition word game =head1 SYNOPSIS juxta wordfile thirdword Where "wordfile" is a file containing one word per line, and "thirdword" is the third or center word as in the example below. Suggested word lists are available from: http://www.bryson.demon.co.uk/wordlist.html The output of this script is all possible solutions where the first and third words--and the second and third words--overlap by at least two letters. =head1 DESCRIPTION JuxtaPosition The object of this compact word game is to solve clues to four words. The third word is found intact amidst the letters of the first two juxtaposed words. The fourth word uses the letters remaining when the third word is removed from the juxtaposition of words 1 and 2. Example - provided by Adrian Hoad-Reddick 1. teeth 2. nice 3. ethnic 4. te e (tee) =head1 AUTHOR Eric Hammond =head1 HISTORY 1997/09/15 Eric Hammond Removed compiler warning. Small logic optimization. 1997/08/26 Eric Hammond Original hack. Several speed/memory optimizations not implemented as it seems to work just fine on a Pentium/166 with 48MB ram running Linux. =cut my $prog = ($0 =~ m#.*[/\\]([^/\\]*)# && $1) || $0; my $VERSION = "1.04"; print STDERR "$prog v$VERSION by Eric Hammond \n\n"; # Command line arguments. my $usage = "usage: $prog wordfile thirdword\n"; my $file = shift || die $usage;; my $third = shift || die $usage; $| = 1; # All whole words (this gets large and uses lots of memory). my %words = (); # Candidates for first and second words. my @first = (); my @second = (); # Scan the word list. open ( FILE, "< $file" ) || die "$prog: Unable to open $file: $!\n"; my $word; while ( defined ($word = ) ) { $word =~ s#[\n\r]##g; $word = lc $word; # Only want words with letters (dump spaces, punctuation). next unless $word =~ m#^\w+$#; ++ $words{$word}; # Word 1 candidate # Third word must begin with at least two letters ending first word. # but both must have left over letters. if ( "$word $third" =~ m#^(.+)(..+) \2(..+)$# ) { push @first, $word; } # Word 2 candidate # Third word must end with at least two letters beginning second word. # but both must have left over letters. if ( "$third $word" =~ m#^(..+)(..+) \2(.+)$# ) { push @second, $word; } } close ( FILE ); # See if first and second words match third and create a valid fourth word. my $first; foreach $first ( @first ) { my $second; foreach $second ( @second ) { if ( "$first $third $second" =~ m#^(.+)(..+) \2(..+) \3(.+)$# && defined $words{$1.$4} ) { print "1. $first\n"; print "2. ", " " x length($first), "$second\n"; print "3. ", " " x length($1), "$third\n"; print "4. $1", " " x length($third), "$4 ($1$4)\n"; print "\n"; } } } exit 0;