43 lines
1.2 KiB
Plaintext
43 lines
1.2 KiB
Plaintext
print "Rosetta Code - ABC problem (recursive solution)"
|
|
print
|
|
blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
|
|
data "A"
|
|
data "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"
|
|
data "XYZZY"
|
|
|
|
do
|
|
read text$
|
|
if text$="XYZZY" then exit do
|
|
print ">>> can_make_word("; chr$(34); text$; chr$(34); ")"
|
|
if canDo(text$,blocks$) then print "True" else print "False"
|
|
loop while 1
|
|
print "Program complete."
|
|
end
|
|
|
|
function canDo(text$,blocks$)
|
|
'endcase
|
|
if len(text$)=1 then canDo=(instr(blocks$,text$)<>0): exit function
|
|
'get next letter
|
|
ltr$=left$(text$,1)
|
|
'cut
|
|
if instr(blocks$,ltr$)=0 then canDo=0: exit function
|
|
'recursion
|
|
text$=mid$(text$,2) 'rest
|
|
'loop by all word in blocks. Need to make "newBlocks" - all but taken
|
|
'optimisation: take only fitting blocks
|
|
wrd$="*"
|
|
i=0
|
|
while wrd$<>""
|
|
i=i+1
|
|
wrd$=word$(blocks$, i)
|
|
if instr(wrd$, ltr$) then
|
|
'newblocks without wrd$
|
|
pos=instr(blocks$,wrd$)
|
|
newblocks$=left$(blocks$, pos-1)+mid$(blocks$, pos+3)
|
|
canDo=canDo(text$,newblocks$)
|
|
'first found cuts
|
|
if canDo then exit while
|
|
end if
|
|
wend
|
|
end function
|