The following program uses files WORDSn.TXT which are actually binary files, that is containing no line breaks between words, and uses the appropriate Basic language commands for handling such files.
There is a function diffCt which counts the differences between two words, which is used by the primary subroutine, ladder. The subroutine ladder is recursive, that is it calls itself. It is invoked with the word currently being worked from and the level past the top that this is. A global (SHARED) array of words is used as well as global (SHARED) variables for maxWd (the number of words in the dictionary), goal$ (the word sought at the end) and maxSteps (how many the user originally allowed to be taken).
The heart of the ladder subroutine is as follows:
Each word in the dictionary is read and the number of letter differences is counted in it from the preceding word in the ladder as well as from the goal word. If the word differs from the preceding word by exactly 1 letter and from the goal word by at most the number of steps allowed to remain (the maximum specified minus the number that would used up already if this word is used), the word is a possibility for continuing the ladder. In that case it continues by making sure that the new word differs from all preceding words in the list (up to but not including the last one), by at least 2 letters, as we don't wish to include solutions that are unnecessarily long. The word is then included in the list. If the word is the goal word the solution is printed, otherwise the ladder function is invoked again at the next higher level.
After checking out each word, the next word is checked. Each level of recursion has its own positioning p& within the dictionary file, and does not interfere with other levels as sequential processing of the file would do.
The following program passes the level (variable lev) rather than the number of maximum steps remaining, to facilitate building the array of words thus far. Ideally, the remaining allowable words would have been passed instead, adjusted to get the appropriate subscript for the array.
The dimensioning of the lad$ array allows only up to 10 steps (array subscripts run from 0 to 10).
DECLARE FUNCTION diffCt% (a$, b$)
DEFINT A-Z
DECLARE SUB ladder (w$, lev)
DIM SHARED lad$(10), maxWd, goal$, maxSteps
INPUT "start word:", w1$
l = LEN(w1$)
INPUT "end word:", goal$
IF LEN(goal$) <> l THEN PRINT "Words must be same length.": END
INPUT "max steps (8 wds inclusive -> 7 steps):", maxSteps
OPEN "words" + LTRIM$(STR$(l)) + ".txt" FOR BINARY AS #1
maxWd = LOF(1) / l
lad$(0) = w1$
OPEN w1$ + ".lad" FOR OUTPUT AS #10
ladder w1$, 0
CLOSE
FUNCTION diffCt (a$, b$)
ct = 0
FOR i = 1 TO LEN(a$)
IF MID$(a$, i, 1) <> MID$(b$, i, 1) THEN
ct = ct + 1
END IF
NEXT
diffCt = ct
END FUNCTION
SUB ladder (w$, lev)
l = LEN(w$)
w2$ = SPACE$(l)
p& = 1
FOR wNum = 1 TO maxWd
GET #1, p&, w2$
p& = p& + l
ct = diffCt(w$, w2$)
ct2 = diffCt(goal$, w2$)
IF ct = 1 AND ct2 <= maxSteps - 1 - lev THEN
sb = lev - 1
okToUse = 1
IF sb >= 0 THEN
FOR i = 0 TO sb
IF diffCt(w2$, lad$(sb)) < 2 THEN okToUse = 0: EXIT FOR
NEXT
END IF
IF okToUse THEN
lv = lev + 1 ' ***** lev changes HERE *****
lad$(lv) = w2$
IF w2$ = goal$ THEN
FOR i = 1 TO lv
IF w2$ = goal$ THEN PRINT " ";
PRINT lad$(i)
PRINT #10, lad$(i)
NEXT
PRINT "-------"; lv
PRINT #10, "-------"; lv
ELSE
ladder w2$, lv
END IF
END IF
END IF
NEXT
END SUB
--------------
Following Bruce's suggestion in the comments, the following program varies the letters one at a time, and checks if the result is a word, to try continuing from there: (it does run faster)
DECLARE FUNCTION isWord& (w$)
DECLARE FUNCTION diffCt% (a$, b$)
DEFINT A-Z
DECLARE SUB ladder (w$, lev)
DIM SHARED lad$(10), maxWd, goal$, maxSteps
INPUT "start word:", w1$
l = LEN(w1$)
INPUT "end word:", goal$
IF LEN(goal$) <> l THEN PRINT "Words must be same length.": END
INPUT "max steps (8 wds inclusive -> 7 steps):", maxSteps
OPEN "words" + LTRIM$(STR$(l)) + ".txt" FOR BINARY AS #1
lad$(0) = w1$
OPEN w1$ + ".lad" FOR OUTPUT AS #10
ladder w1$, 0
CLOSE
FUNCTION diffCt (a$, b$)
ct = 0
FOR i = 1 TO LEN(a$)
IF MID$(a$, i, 1) <> MID$(b$, i, 1) THEN
ct = ct + 1
END IF
NEXT
diffCt = ct
END FUNCTION
DEFLNG A-Z
FUNCTION isWord (w$)
n = LEN(w$)
w1$ = SPACE$(n)
l = LOF(1) / n
low = 1: high = l
DO
mid = INT((low + high) / 2)
GET #1, (mid - 1) * n + 1, w1$
IF w1$ = w$ THEN isWord = -1: EXIT FUNCTION
IF w1$ < w$ THEN low = mid + 1: ELSE high = mid - 1
LOOP UNTIL low > high
isWord = 0
END FUNCTION
DEFINT A-Z
SUB ladder (w$, lev)
l = LEN(w$)
FOR wPosn = 1 TO l
FOR letv = ASC("a") TO ASC("z")
w2$ = LEFT$(w$, wPosn - 1) + CHR$(letv) + MID$(w$, wPosn + 1)
ct2 = diffCt(goal$, w2$)
IF isWord(w2$) AND ct2 <= maxSteps - 1 - lev THEN
sb = lev - 1 ' : IF sb < 0 THEN sb = 0
okToUse = 1
IF sb >= 0 THEN
FOR i = 0 TO sb
IF diffCt(w2$, lad$(sb)) < 2 THEN okToUse = 0: EXIT FOR
NEXT
END IF
IF okToUse THEN
lv = lev + 1 ' ***** lev changes HERE *****
lad$(lv) = w2$
IF w2$ = goal$ THEN
FOR i = 1 TO lv
IF w2$ = goal$ THEN PRINT " ";
PRINT lad$(i)
PRINT #10, lad$(i)
NEXT
PRINT "-------"; lv
PRINT #10, "-------"; lv
ELSEIF lv > maxSteps THEN
ELSE
ladder w2$, lv
END IF
END IF
END IF
NEXT
NEXT
END SUB
|