|
anGSt aBYss baWDy coMFy dENim eXPel faKIr maJOr piQUe seRVe tiTLe topAZ winCH
Final challenge:
CHant aBYss baWDy coMFy dENim eXPel faKIr maJOr piQUe seRVe tiTLe topAZ winGS
PLant aBYss baWDy coMFy dENim eXCel faKIr maJOr piQUe seRVe tiTHe topAZ winGS
DECLARE SUB place (n!)
DATA ant,ass,bay,coy,dim,eel,far,mar,pie,see,tie,top,win
DIM w3$(13)
FOR i = 1 TO 13
READ w3$(i): PRINT w3$(i)
NEXT
DIM SHARED sWord$(13, 30), sLet$(13, 30), wCt(13), had(26), h$(13), h2$(13)
w5$ = SPACE$(5)
FOR i = 1 TO 13
OPEN "\\words\\words5.txt" FOR BINARY AS #1
w$ = w3$(i)
DO
GET #1, , w5$
IF LEFT$(w5$, 1) = LEFT$(w$, 1) AND RIGHT$(w5$, 2) = RIGHT$(w$, 2) THEN
PRINT w5$, MID$(w5$, 2, 2)
wCt(i) = wCt(i) + 1
sWord$(i, wCt(i)) = w5$: sLet$(i, wCt(i)) = MID$(w5$, 2, 2)
END IF
IF LEFT$(w5$, 2) = LEFT$(w$, 2) AND RIGHT$(w5$, 1) = RIGHT$(w$, 1) THEN
PRINT w5$, MID$(w5$, 3, 2)
wCt(i) = wCt(i) + 1
sWord$(i, wCt(i)) = w5$: sLet$(i, wCt(i)) = MID$(w5$, 3, 2)
END IF
IF LEFT$(w5$, 3) = LEFT$(w$, 3) THEN
PRINT w5$, MID$(w5$, 4, 2)
wCt(i) = wCt(i) + 1
sWord$(i, wCt(i)) = w5$: sLet$(i, wCt(i)) = MID$(w5$, 4, 2)
END IF
LOOP UNTIL EOF(1)
CLOSE 1
PRINT
'DO: LOOP UNTIL INKEY$ > ""
NEXT
place 1
SUB place (n)
FOR i = 1 TO wCt(n)
l$ = sLet$(n, i)
n1 = INSTR("abcdefghijklmnopqrstuvwxyz", LEFT$(l$, 1))
n2 = INSTR("abcdefghijklmnopqrstuvwxyz", RIGHT$(l$, 1))
IF had(n1) = 0 AND had(n2) = 0 AND n1 <> n2 THEN
had(n1) = 1: had(n2) = 1
h$(n) = sWord$(n, i): h2$(n) = sLet$(n, i)
IF n = 13 THEN
FOR j = 1 TO 13
ix = INSTR(h$(j), h2$(j))
FOR k = 1 TO 5
IF k = ix OR k = ix + 1 THEN
PRINT UCASE$(MID$(h$(j), k, 1));
ELSE
PRINT MID$(h$(j), k, 1);
END IF
NEXT k
PRINT " ";
NEXT
PRINT
ELSE
place n + 1
END IF
had(n1) = 0: had(n2) = 0
END IF
NEXT
END SUB
Adapted from Giant Book of Mensa Mind Challenges,
edited by Todd Johnson, "Nearly Impossible Brain Bafflers" chapter,
page 177: puzzle #28.
|
