```//////////////////////////////////////////////////////////////////////////////////////////////
//
//  FourWord problem: place predefined letters in a partially filled
//  4x4 grid, so the grid forms words in all rows and colums.
//
//  For example, place the following 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 |   |   |   |
// +---+---+---+---+
//
// will result in
//
// +---+---+---+---+
// | p | o | p | s |
// +---+---+---+---+
// | a | b | l | e |
// +---+---+---+---+
// | l | o | a | n |
// +---+---+---+---+
// | l | e | n | t |
// +---+---+---+---+
//
//
//////////////////////////////////////////////////////////////////////////////////////////////
//
// In order to solve the puzzle, we need a list of four-letter words. The words
// themselves are located in another module "FourLetterWords".
//
// This program uses a GUI (Graphical User Interface) via an external module FourWordExt.dll
//
// To run the program, execute the query
//
//      FourWordGUI()
//
//////////////////////////////////////////////////////////////////////////////////////////////

use 'FourLetterWords'   // List of all four letter words

subr FourWordGUI() iff
FourWordCreateWindow('F1 FourWord Puzzle Solver',h) &
FourWordGUISolve(h)

local AllLines = [0..]->S
local Arrs = ah:[0..3]->AllLines, av:[0..3]->AllLines

local subr FourWordGUISolve(h:<I) iff
arr :. Arrs &
FourWordGetUserValues(h,a1,a2) &        // Get the user suplied letters
CreateUsedLettersList(a1,0,Nil,l1) &    // l1 = list of initialize letters
CreateUsedLettersList(a2,0,l1,l2) &     // l2 = list of all 16 letters

// We have list of 16 letters that must be placed in the grid.
// Sort the list, this will help later on to avoid duplicate (identical)
// solutions.

RtlSortAscending(l2,l3) &

// Create list/array of all words for each horizontal row.
all x in lh0 GetWord([a1(0), a1(1), a1(2), a1(3) ],a2,x) end & ah0 = lh0:AllLines &
all x in lh1 GetWord([a1(4), a1(5), a1(6), a1(7) ],a2,x) end & ah1 = lh1:AllLines &
all x in lh2 GetWord([a1(8), a1(9), a1(10),a1(11)],a2,x) end & ah2 = lh2:AllLines &
all x in lh3 GetWord([a1(12),a1(13),a1(14),a1(15)],a2,x) end & ah3 = lh3:AllLines &

// Create list/array of all words for each vertical column.
all x in lv0 GetWord([a1(0), a1(4), a1(8), a1(12)],a2,x) end & av0 = lv0:AllLines &
all x in lv1 GetWord([a1(1), a1(5), a1(9), a1(13)],a2,x) end & av1 = lv1:AllLines &
all x in lv2 GetWord([a1(2), a1(6), a1(10),a1(14)],a2,x) end & av2 = lv2:AllLines &
all x in lv3 GetWord([a1(3), a1(7), a1(11),a1(15)],a2,x) end & av3 = lv3:AllLines &

// Now construct an array of all arrays, as it is easier to
// pass one argument than 8 individual arrays.

arr := ([ah0,ah1,ah2,ah3],[av0,av1,av2,av3]) &

// Now that we have the lists (arrays) of words, we can solve the problem

all x in l
RtlGetCutPoint(cp) &
FourWordSolve(x,a1,l3,arr) & ShowResult(h,x) &
if ~FourWordQueryNext() then
RtlSetCutPoint(cp)  // user does not want more solutions
end
end & FourWordDone() &
FourWordGUISolve(h)         // solve another set of letters

///////////////////////////////////////////////////////////////////////////////
//
// Collect all (non-zero) letters into one list.
//
///////////////////////////////////////////////////////////////////////////////
local proc CreateUsedLettersList(a:<[0..]->I,i:<I,lin :< list["A".."Z"], lout :> list ["A".."Z"]) iff
if i < Len(a) then
if a(i) <> 0 then
CreateUsedLettersList(a,i+1,(a(i),lin),lout)
else
CreateUsedLettersList(a,i+1,lin,lout)
end
else
lout = lin
end

///////////////////////////////////////////////////////////////////////////////
// Create applicable words for one row or column.
// Go through all words, weeding out those that are not applicable
//
// Input arguments:
//      a1: array of four letters for one row or column. May be partially
//          initialized.
//      a2: array of allowable letters for uninitialized positions in a1.
//          (user provided "spare" letters)
//
// Output argument:
//      outword: word that is applicable based on information from a1,a2
//
///////////////////////////////////////////////////////////////////////////////
local pred GetWord(a1:<[0..3]->I,a2:<[0..]->I,outword:>S) iff
x::[0..3]->["A".."Z"] &
i::I[0..] & i < Len(AllFourLetterWords) &   // this many words total
x = AllFourLetterWords(i):[0..3]->["A".."Z"] &
if a1(0) <> 0 then x(0) = a1(0) else x(0) in a2 end &
if a1(1) <> 0 then x(1) = a1(1) else x(1) in a2 end &
if a1(2) <> 0 then x(2) = a1(2) else x(2) in a2 end &
if a1(3) <> 0 then x(3) = a1(3) else x(3) in a2 end &
y :> [0..3]->I & y = x &
outword = y:S

///////////////////////////////////////////////////////////////////////////////
//
//  Find one solution the the FourWord puzzle
//
///////////////////////////////////////////////////////////////////////////////
local pred FourWordSolve(s::[0..15]->["A".."Z"], a1:<[0..15]->I, l3:<list ["A".."Z"],arrs:<Arrs) iff
ix::[0..]->>I & Len(ix,Len(l3)) &

// Place known letters with known positions in the grid (at the known positions).
Assign1(s,a1,0) &

// Assure all user provided letters are used somewhere in the grid
Assign2(s,ix,l3,0,0) &

// 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 by interleaving the horizontal and vertical words.

StoreHorizontalWord1(s,0,arrs.ah(0)) &     // row 0
StoreVerticalWord1(s,0,arrs.av(0)) &       // column 0
StoreHorizontalWord1(s,1,arrs.ah(1)) &     // row 1
StoreVerticalWord1(s,1,arrs.av(1)) &       // columns 1
StoreHorizontalWord1(s,2,arrs.ah(2)) &     // row 2
StoreVerticalWord1(s,2,arrs.av(2)) &       // column 2
StoreHorizontalWord1(s,3,arrs.ah(3)) &     // row 3
StoreVerticalWord1(s,3,arrs.av(3))         // column 3

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

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

///////////////////////////////////////////////////////////////////////////////
//
// Place the letters with know positions in the grid at those positions.
//
///////////////////////////////////////////////////////////////////////////////
local pred Assign1(grid::[0..15]->["A".."Z"],a1:<[0..15]->I,col:<I) iff
if col < 16 then
if a1(col) <> 0 then
grid(col) = a1(col) & Assign1(grid,a1,col+1)
end
end

///////////////////////////////////////////////////////////////////////////////
//
// Assign all letters somewhere in the grid:
//
//      grid(i) = letter
//
// where "i" is a grid index.
// There may be several identical letters to be placed. This could lead
// to multiple identical solutions, due to the number of permutations in
// positions these identical letters can have. In order to avoid identical
// solutions, we keep the list of letters in sorted order. Then if the
// "letter" is the same as the previuosly place letter, we simply demand that
//
//      grid(i) = letter &
//      grid(j) = letter & j > i
//
///////////////////////////////////////////////////////////////////////////////
local pred Assign2(grid::[0..15]->["A".."Z"], ix::[0..]->>I,a3:<list ["A".."Z"],prev:<I,i:<I) iff
if a3 = h,t then
grid(ix(i)) = h &
if h = prev then
if i > 0 then
ix(i) > ix(i-1)
end
end &
Assign2(grid,ix,t,h,i+1)
end

///////////////////////////////////////////////////////////////////////////////
//
//  Show the calculated result. Just let GUI do it.
//
///////////////////////////////////////////////////////////////////////////////
local proc ShowResult(h:<I,s:<[0..15]->["A".."Z"]) iff
FourWordShowValues(h,s)

///////////////////////////////////////////////////////////////////////////////
//
// External routines used by this program.
//
///////////////////////////////////////////////////////////////////////////////
// Initialize the external code
local subr FourWordCreateWindow(title:<S,w:>I) iff external 'FourWordExt':'FourWordCreateWindow'

// Query the external code for some initial FourWord values
// a1 = [0..15]->I : initialized values, 0 == uninintialized
// a2 = [0..]->I : letters to be placed
local subr FourWordGetUserValues(w:<I,a1:>[0..15]->I,a2:>[0..]->I) iff external 'FourWordExt':'FourWordGetUserValues'

// Present the external code with one FourWord solution
local proc FourWordShowValues(w:<I,a:<[0..15]->["A".."Z"]) iff external 'FourWordExt':'FourWordShowValues'

// Notify the external code we are finished (there will be no more solutions)
local proc FourWordDone() iff external 'FourWordExt':'FourWordDone'

// Query the external code if another solution desired
local proc FourWordQueryNext() iff external 'FourWordExt':'FourWordQueryNext'

```

This page was created by F1toHTML