This is another variation of the classic problem of changing one word into another.
Instead of changing one word into another one letter at a time for each step, this
variation alternates each step by anagramming one word into another.
For example: CAT to DOG can occur as such:
CAT
ACT (anagram)
ANT (letter change)
TAN (anagram)
TON (letter change)
NOT (anagram)
NOD (letter change)
DON (anagram)
DOG (letter change)
Either the letter change or the anagram may occur first, but must then alternate.
I offer four challenges. In the fewest steps,
1) transform EARTH to WATER,
2) convert WIND to FIRE,
3) cross from RIVER to SHORE, and
4) transmute LEAD to GOLD.
earth
hater
water
comes to mind immediately.
I asked my computer about
wind
and got
kind
dink
dine
nide
ride
dire
fire
taking 7 steps, a nide being a nest or brood, esp. of pheasants.
If you don't like hater, there are longer ones for earth ... water such as:
heart
peart
taper
tamer
mater
water
For river, to avoid rarer words we can accept 7 steps:
rifer
frier
fries
fires
hires
shire
shore
or accept the rarer words for 5 steps:
rives
vires
hires
shire
shore
For lead a good sequence of 6 is:
lade
lode
dole
dolt
told
gold
or this 7-step:
leas
sale
sole
oles
olds
sold
gold
The program:
DECLARE FUNCTION isAnag% (s1$, s2$)
DECLARE FUNCTION diffCt% (a$, b$)
DEFINT A-Z
DECLARE SUB ladder (w$, lev)
DIM SHARED lad$(10), maxWd, goal$, maxSteps, typ(10)
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
FUNCTION isAnag (s1$, s2$)
IF s1$ = s2$ THEN isAnag = 0: EXIT FUNCTION
h$ = s2$
FOR i = 1 TO LEN(s1$)
c$ = MID$(s1$, i, 1)
ix = INSTR(h$, c$)
IF ix THEN
h$ = LEFT$(h$, ix - 1) + MID$(h$, ix + 1)
ELSE
isAnag = 0: EXIT FUNCTION
END IF
NEXT
isAnag = 1
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
IF lev = 0 OR typ(lev) = 1 THEN
ct = diffCt(w$, w2$)
IF ct = 1 THEN
sb = lev - 1 ' : IF sb < 0 THEN sb = 0
okToUse = 1
IF sb >= 0 THEN
FOR i = 0 TO sb
IF w2$ = lad$(i) THEN okToUse = 0: EXIT FOR
NEXT
END IF
IF okToUse THEN
lv = lev + 1 ' ***** lev changes HERE *****
lad$(lv) = w2$
typ(lv) = 0
IF w2$ = goal$ THEN ' OR lv = 6 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
END IF
IF lev = 0 OR typ(lev) = 0 THEN
ct = isAnag(w$, w2$)
IF ct THEN
sb = lev - 1 ' : IF sb < 0 THEN sb = 0
okToUse = 1
IF sb >= 0 THEN
FOR i = 0 TO sb
IF w2$ = lad$(i) THEN okToUse = 0: EXIT FOR
NEXT
END IF
IF okToUse THEN
lv = lev + 1 ' ***** lev changes HERE *****
lad$(lv) = w2$
typ(lv) = 1
IF w2$ = goal$ THEN ' OR lv = 6 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
END IF
NEXT
END SUB
|
Posted by Charlie
on 2007-10-26 14:13:38 |