/////////////////////////////////////////////////////////////////////////////////////////////// // // 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