///////////////////////////////////////////////////////////////////////////////////////////////
//
//  FourWord problem: place these letters: 
//
//        a,b,e,l,n,o,p,p,s,t
//
//  into the blank spaces to create four-letter words down and accross.
//
// +---+---+---+---+
// |   | o |   |   |    
// +---+---+---+---+    
// |   |   | l | e |    
// +---+---+---+---+    
// |   |   | a | n |
// +---+---+---+---+
// | l |   |   |   |
// +---+---+---+---+
//
//////////////////////////////////////////////////////////////////////////////////////////////
//
// Comments: In order to solve the puzzle, obviously, we need a list of four-letter words. 
// So as the pre-requisite we have to create a database of all four letter words. This is
// rather quite simple. There are numerous lists of words available on the internet. We chose 
// the file from UK Advanced Cryptics (ukacdasc.txt), as downloaded from the site:
// 
//      http://www.puzzlers.org/secure/wordlists/dictinfo.php
//
// Then we converted the text file into an indexed database by executing the query:
//
//      CreateFourWordDB('ukacdasc.txt','ukacdasc4letters.dbs':WordDB4) 
//
// Indexed database may be somewhat an overkill for this particular puzzle, but we used it
// anyway just so we can demonstrate how to use it. For more information, see below comments
// in the code. Obviously, you only have to create the database once and use it for
// many other FourWord puzzles.
//
// Once we have created the database, (which only takes a few seconds), we can solve 
// the puzzle by issuing the query:
//
//      SolveFourWord('ukacdasc4letters.dbs')
//
// Solving of the puzzle consists of finding all words that satisfy the constraints
// as specified by the puzzle. This may take a few seconds (seven on Athlon XP 1600+), 
// after all the solutions are found, they are all displayed.
//
//////////////////////////////////////////////////////////////////////////////////////////////
//
//  Solution:
//
// +---+---+---+---+
// | p | o | p | s |    
// +---+---+---+---+    
// | a | b | l | e |    
// +---+---+---+---+    
// | l | o | a | n |
// +---+---+---+---+
// | l | e | n | t |
// +---+---+---+---+
//
///////////////////////////////////////////////////////////////////////////////////////////////

local Board = [0..15]->["a".."z"]

subr SolveFourWord(dbname:<S) iff
    // First find all words than satisfy the rows (horizontal words):

    // Create a list of words with "o" as the second letter
    SeekStringsByLetter1(dbname:WordDB4,"o",aFH0) &

    // Create a list of words with letters "l" and "e" as the third & fourth letter
    SeekStringsByLetter23(dbname:WordDB4,("l","e"),aFH1) &

    // Create a list of words with letters "a" and "n" as the third & fourth letter
    SeekStringsByLetter23(dbname:WordDB4,("a","n"),aFH2) &

    // Create a list of words with "l" as the first letter
    SeekStringsByLetter0(dbname:WordDB4,"l",aFH3) &

    // Dealing with arrays is much more efficient than dealing with lists, so
    // convert the four "horizontal" lists of words into an array of arrays of strings.

    arrH :> [0..]->[0..]->S &
    arrH = [aFH0:[0..]->S, aFH1:[0..]->S, aFH2:[0..]->S, aFH3:[0..]->S] &

    // Now find all words than satisfy the columns (vertical words):

    // Create a list of words with "l" as the fourth letter
    SeekStringsByLetter3(dbname:WordDB4,"l",aFV0) &

    // Create a list of words with "o" as the first letter
    SeekStringsByLetter0(dbname:WordDB4,"o",aFV1) &

    // Create a list of words with letters "l" and "a" as the second & third letter
    SeekStringsByLetter12(dbname:WordDB4,("l","a"),aFV2) &

    // Create a list of words with letters "e" and "n" as the second & third letter
    SeekStringsByLetter12(dbname:WordDB4,("e","n"),aFV3) &

    // Convert the four "vertical" lists of words into an array of arrays of strings.

    arrV :> [0..]->[0..]->S &
    arrV = [aFV0:[0..]->S, aFV1:[0..]->S, aFV2:[0..]->S, aFV3:[0..]->S] &

    // Now we are ready to find the solution(s). We collect all the solution
    // in a list

    all x in listOfSolutions  
        x::Board & SolveFourLetterEx(x,arrH,arrV) 
    end & 

    PrintSolution(listOfSolutions)

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Solve the FourWord puzzle using the problem description at the top of this file.
// Solving consists of initilaizing the known letters, specifying the
// additional compulsory letters and finally applying all horizontal
// and vertical words.
//
///////////////////////////////////////////////////////////////////////////////////////////////

local pred SolveFourLetterEx(board::Board,arrH:<[0..]->[0..]->S,arrV:<[0..]->[0..]->S) iff
    // first initialize the known letters based on the picture at the top of this file

    board(1)  = "o" & 
    board(6)  = "l" & 
    board(7)  = "e" & 
    board(10) = "a" & 
    board(11) = "n" &
    board(12) = "l" &

    // now specify the additional letters we must use:

    board(xa) = "a" & xa <> 10 &    // somewhere there is an "a", other than the one at board(10)
    board(_)  = "b" &               // somewhere there is a "b"
    board(_)  = "e" &               // somewhere there is an "e"
    board(_)  = "l" &               // somewhere there is an "l"
    board(xn) = "n" & xn <> 11 &    // somewhere there is an "n", other than the one at board(11)
    board(_)  = "o" &               // somewhere there is an "o"
    board(x1) = "p" & board(x2) = "p" & x1 <> x2 & //there are two "p"s.
    board(_)  = "s" &               // somewhere there is an "s"
    board(_)  = "t" &               // somewhere there is a "t"

    // Now place all available words into individual rows and columns.
    // The oder is not important, but may affect the execution time.
    // Generally, try to constrain the solution as much as you can as soon
    // as you can. This means place the words with most letters first and
    // interleave placing the horizontal and vertical words.

    StoreHorizontalWord1(board,0,arrH(0)) &     // row 0
    StoreVerticalWord1(board,0,arrV(0)) &       // column 0
    StoreHorizontalWord1(board,1,arrH(1)) &     // row 1
    StoreVerticalWord1(board,1,arrV(1)) &       // columns 1
    StoreHorizontalWord1(board,2,arrH(2)) &     // row 2    
    StoreVerticalWord1(board,2,arrV(2)) &       // column 2 
    StoreHorizontalWord1(board,3,arrH(3)) &     // row 3    
    StoreVerticalWord1(board,3,arrV(3))         // column 4 

///////////////////////////////////////////////////////////////////////////////
local pred StoreHorizontalWord1(board::[0..15]->I,row:<I,aWords:<[0..]->S) iff
    wordix :: I & wordix < Len(aWords) & wordix >= 0 &    
    word = aWords(wordix) & 
    col = row*4 &
    board(col+0) = word(0) &
    board(col+1) = word(1) &
    board(col+2) = word(2) &
    board(col+3) = word(3) 

local pred StoreVerticalWord1(board::[0..15]->I,col:<I,aWords:<[0..]->S) iff
    wordix :: I & wordix < Len(aWords) & wordix >= 0 &    
    word = aWords(wordix) & 
    board(col)    = word(0) &
    board(col+4)  = word(1) &
    board(col+8)  = word(2) &
    board(col+12) = word(3) 

///////////////////////////////////////////////////////////////////////////////
local proc Print4Letter1(x:<[0..15]->I,i:<I) iff
    if i < 15 then
        Print('\n ', x(i):S, x(i+1):S, x(i+2):S, x(i+3):S) &
        Print4Letter1(x,i+4)
    else
        Print('\n------')
    end

local proc PrintSolution(l:<list Board) iff
    if l <> Nil then
        l =  h,t & Print4Letter1(h,0) & PrintSolution(t)
    end

///////////////////////////////////////////////////////////////////////////////
//
// Create a database file containing all four letter words.
//
///////////////////////////////////////////////////////////////////////////////
//
// Given a text file containing words (each line considered a word), create 
// a database file containing all four letter words. Additionally, create
// index files for each letter at position 0,1,2,3, letters at positions
// (1,2), (1,3), (2,3). Generally, we create indeces on all fields we expect
// to do searching. For example, (see the picture at the top), we will search
// all words with first letter "o" and "l", so we need to index the letter
// at position 0. Also note that the letter "o" occurs at the second position
// as well, so we need to index words by second letter as well.
// We anticipate that othe FourWord puzzles may search words by letters in 
// positions 2 and 3 as well, so we build the indeces for these cases as well. 
// (Although they are not used in this example).
//
//
///////////////////////////////////////////////////////////////////////////////

WordRecord4 = word:S,l0:I,l1:I,l2:I,l3:I,l12:(I,I),l13:(I,I),l23:(I,I)
WordDB4 = file WordRecord4[word,l0,l1,l2,l3,l12,l13,l23]

subr CreateFourWordDB(fin:.Ascii,fout:.WordDB4) iff 
    DbRewind(fout) & DbTruncate(fout) &
    ReadInFile4(fin,fout) 

local subr ReadInFile4(fin:.Ascii, fout:.WordDB4) iff
    if DbAccess(fin,str) then 
        if Len(str) = 4 then
            Print(str,'\n') & 
            record :.WordRecord4 & 
            record := (str, str(0),str(1),str(2),str(3),(str(1),str(2)),(str(1),str(3)),(str(2),str(3))) &
            DbPut(fout,record) 
        end  
        & DbSkip(fin,1) & ReadInFile4(fin,fout)
    end
    
///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing the letter "letter" as the first 
// character
//
///////////////////////////////////////////////////////////////////////////////////////////////
subr SeekStringsByLetter0(f:.WordDB4,letter:<I,lout:>list S) iff
    DbSeek(f.l0,letter) & 

    if DbAccess(f,y) then
        SeekStringsByLetter0Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil 
    end

local subr SeekStringsByLetter0Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l0) &    
    if DbAccess(f,y) then
        SeekStringsByLetter0Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing the letter "letter" as the second 
// character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter1(f:.WordDB4,letter:<I,lout:>list S) iff
    DbSeek(f.l1,letter) & 
    if DbAccess(f,y) then
        SeekStringsByLetter1Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil 
    end

local subr SeekStringsByLetter1Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l1) &    
    if DbAccess(f,y) then
        SeekStringsByLetter1Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing the letter "letter" as the third 
// character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter2(f:.WordDB4,letter:<I,lout:>list S) iff
    DbSeek(f.l2,letter) & 
    if DbAccess(f,y) then
        SeekStringsByLetter2Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil 
    end

local subr SeekStringsByLetter2Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l2) &    
    if DbAccess(f,y) then
        SeekStringsByLetter2Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing the letter "letter" as the fourth 
// character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter3(f:.WordDB4,letter:<I,lout:>list S) iff
    DbSeek(f.l3,letter) & 
    if DbAccess(f,y) then
        SeekStringsByLetter3Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil
    end

local subr SeekStringsByLetter3Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l3) &    
    if DbAccess(f,y) then
        SeekStringsByLetter3Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing two letters "letter12" as the  
// second and third character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter12(f:.WordDB4,letter12:<(I,I),lout:>list S) iff
    DbSeek(f.l12,letter12) & 
    if DbAccess(f,y) then
        SeekStringsByLetter12Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil
    end

local subr SeekStringsByLetter12Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l12) &    
    if DbAccess(f,y) then
        SeekStringsByLetter12Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing two letters "letter13" as the  
// second and fourth character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter13(f:.WordDB4,letter13:<(I,I),lout:>list S) iff
    DbSeek(f.l13,letter13) & 
    if DbAccess(f,y) then
        SeekStringsByLetter13Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil 
    end

local subr SeekStringsByLetter13Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l13) &    
    if DbAccess(f,y) then
        SeekStringsByLetter13Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

///////////////////////////////////////////////////////////////////////////////////////////////
//
// Search the database and create a list of words containing two letters "letter23" as the  
// third and fourth character
//
///////////////////////////////////////////////////////////////////////////////////////////////
local subr SeekStringsByLetter23(f:.WordDB4,letter23:<(I,I),lout:>list S) iff
    DbSeek(f.l23,letter23) & 

    if DbAccess(f,y) then
        SeekStringsByLetter23Ex(f,(y.word,Nil),lout) 
    else
        lout = Nil 
    end

local subr SeekStringsByLetter23Ex(f:.WordDB4,lin:<list S,lout:>list S) iff
    DbSeekNextEq(f.l23) &    
    if DbAccess(f,y) then
        SeekStringsByLetter23Ex(f,(y.word,lin),lout)
    else
        lout = lin 
    end

This page was created by F1toHTML