aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

46
Task/ABC-Problem/REXX/abc-problem-1.rexx
View file

@ -1,24 +1,24 @@
/*REXX pgm checks if a word list can be spelt from a pool of toy blocks.*/
list = 'A bark bOOk treat common squaD conFuse' /*words can be any case.*/
blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'
do k=1 for words(list) /*traipse through list of words. */
call spell word(list,k) /*show if word be spelt (or not).*/
end /*k*/ /* [↑] tests each word in list. */
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SPELL subroutine────────────────────*/
spell: procedure expose blocks; parse arg ox . 1 x . /*get word to spell*/
z=blocks; upper x z; oz=z; p.=0; L=length(x) /*uppercase the blocks. */
/* [↓] try to spell it.*/
do try=1 for L; z=oz /*use a fresh copy of Z.*/
do n=1 for L; y=substr(x,n,1) /*attempt another letter*/
p.n=pos(y,z,1+p.n); if p.n==0 then iterate try /*¬ found? Try again.*/
z=overlay(' ',z,p.n) /*mutate block──► onesy.*/
do k=1 for words(blocks) /*scrub block pool (¬1s)*/
if length(word(z,k))==1 then z=delword(z,k,1) /*1 char? Delete.*/
end /*k*/ /* [↑] elide any onesy.*/
if n==L then leave try /*the last letter spelt?*/
end /*n*/ /* [↑] end of an attempt*/
end /*try*/ /* [↑] end TRY permute.*/
/*REXX program determines if words can be spelt from a pool of toy blocks. */
list= 'A bark bOOk treat common squaD conFuse' /*words can be in any case. */
blocks= 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'
do k=1 for words(list) /*traipse through a list of seven words*/
call spell word(list,k) /*display if word can be spelt (or not)*/
end /*k*/ /* [↑] tests each word in the list. */
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
spell: procedure expose blocks; arg x; p.=0 /*uppercase word to be spelt. */
parse upper var blocks theBlocks; L=length(x) /*uppercase the block letters.*/
/* [↓] try to spell the word.*/
do try=1 for L; z=theBlocks /*use a fresh copy of Z blocks*/
do n=1 for L; y=substr(x,n,1) /*attempt another block letter*/
p.n=pos(y,z,1+p.n); if p.n==0 then iterate try /*not found? Try again.*/
z=overlay(' ',z,p.n) /*mutate block ───► a onesy.*/
do k=1 for words(blocks) /*scrub block pool (not 1s). */
if length(word(z,k))==1 then z=delword(z,k,1) /*single char? Delete.*/
end /*k*/ /* [↑] elide any onesy block.*/
if n==L then leave try /*was the last letter spelt? */
end /*n*/ /* [↑] end of a block attempt*/
end /*try*/ /* [↑] end of "TRY" permute. */
say right(ox,30) right(word("can't can", (n==L)+1), 6) 'be spelt.'
return n==L /*also, return the flag.*/
say right(arg(1),30) right(word("can't can", (n==L)+1), 6) 'be spelt.'
return