122 lines
3.6 KiB
Plaintext
122 lines
3.6 KiB
Plaintext
*process source attributes xref or(!) options nest;
|
|
abc: Proc Options(main);
|
|
/* REXX --------------------------------------------------------------
|
|
* 10.01.2013 Walter Pachl counts the number of possible ways
|
|
* translated from Rexx version 2
|
|
*-------------------------------------------------------------------*/
|
|
|
|
Dcl (ADDR,HBOUND,INDEX,LEFT,LENGTH,MAX,SUBSTR,TRANSLATE) builtin;
|
|
Dcl sysprint Print;
|
|
Dcl (i,j,k,m,mm,wi,wj,wlen,ways,lw) Bin Fixed(15);
|
|
Dcl blocks(20) Char(2)
|
|
Init('BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW',
|
|
'HU','VI','AN','OB','ER','FS','LY','PC','ZM');
|
|
Dcl blk Char(2);
|
|
Dcl words(8) Char(7) Var
|
|
Init('$','A','baRk','bOOk','trEat','coMMon','squaD','conFuse');
|
|
Dcl word Char(7) Var;
|
|
Dcl c Char(1);
|
|
Dcl (show,cannot) Bit(1) Init('0'b);
|
|
Dcl poss(100,0:100) Pic'99'; poss=0;
|
|
Dcl s(20,100) char(100) Var;
|
|
Dcl str Char(100);
|
|
Dcl 1 *(30) Based(addr(str)),
|
|
2 strp Pic'99',
|
|
2 * Char(1);
|
|
Dcl ns(20) Bin Fixed(15) Init((20)0);
|
|
Dcl ol(100) Char(100) Var;
|
|
Dcl os Char(100) Var;
|
|
wlen=0;
|
|
Dcl lower Char(26) Init('abcdefghijklmnopqrstuvwxyz');
|
|
Dcl upper Char(26) Init('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
|
|
Do wi=1 To hbound(words);
|
|
wlen=max(wlen,length(words(wi)));
|
|
End;
|
|
Do wi=1 To hbound(words);
|
|
word = translate(words(wi),upper,lower);
|
|
ways=0;
|
|
lw=length(word);
|
|
cannot='0'b;
|
|
poss=0;
|
|
ns=0;
|
|
ol='';
|
|
iloop:
|
|
Do i=1 To lw; /* loop over the characters */
|
|
c=substr(word,i,1); /* the current character */
|
|
Do j=1 To hbound(blocks); /* loop over blocks */
|
|
blk=blocks(j);
|
|
If index(blk,c)>0 Then Do; /* block can be used in this pos( */
|
|
poss(i,0)+=1; /* number of possible blocks for pos i */
|
|
poss(i,poss(i,0))=j;
|
|
End;
|
|
End;
|
|
If poss(i,0)=0 Then Do;
|
|
Leave iloop;
|
|
End;
|
|
End;
|
|
If i>lw Then Do; /* no prohibitive character */
|
|
ns=0;
|
|
Do j=1 To poss(1,0); /* build possible strings for char 1 */
|
|
ns(1)+=1;;
|
|
s(1,j)=poss(1,j);
|
|
End;
|
|
Do m=2 To lw; /* build possible strings for chars 1 to i */
|
|
mm=m-1;
|
|
Do j=1 To ns(mm);
|
|
Do k=1 To poss(m,0);
|
|
ns(m)+=1;
|
|
s(m,ns(m))=s(mm,j)!!' '!!poss(m,k);
|
|
End;
|
|
End;
|
|
End;
|
|
Do m=1 To ns(lw);
|
|
If valid(s(lw,m)) Then Do;
|
|
ways+=1;
|
|
str=s(lw,m);
|
|
Do k=1 To lw;
|
|
ol(ways)=ol(ways)!!blocks(strp(k))!!' ';
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
/*--------------------------------------------------------------------
|
|
* now show the result
|
|
*-------------------------------------------------------------------*/
|
|
os=left(''''!!word!!'''',wlen+2);
|
|
Select;
|
|
When(ways=0)
|
|
os=os!!' cannot be spelt.';
|
|
When(ways=1)
|
|
os=os!!' can be spelt.';
|
|
Otherwise
|
|
os=os!!' can be spelt in'!!ways!!' ways.';
|
|
End;
|
|
Put Skip List(os);
|
|
If show Then Do;
|
|
Do wj=1 To ways;
|
|
Put Edit(' '!!ol(wj))(Skip,a);
|
|
End;
|
|
End;
|
|
End;
|
|
Return;
|
|
|
|
valid: Procedure(list) Returns(bit(1));
|
|
/*--------------------------------------------------------------------
|
|
* Check if the same block is used more than once -> 0
|
|
* Else: the combination is valid
|
|
*-------------------------------------------------------------------*/
|
|
Dcl list Char(*) Var;
|
|
Dcl i Bin Fixed(15);
|
|
Dcl used(20) Bit(1);
|
|
str=list;
|
|
used='0'b;
|
|
Do i=1 To lw;
|
|
If used(strp(i)) Then
|
|
Return('0'b);
|
|
used(strp(i))='1'b;
|
|
End;
|
|
Return('1'b);
|
|
End;
|
|
|
|
End;
|