86 lines
3 KiB
Text
86 lines
3 KiB
Text
*process or(!) source attributes xref;
|
|
amb: Proc Options(main);
|
|
/*********************************************************************
|
|
* 25.08.2013 Walter Pachl
|
|
*********************************************************************/
|
|
Dcl w(4,10) Char(40) Var
|
|
Init('the','that','a','if',(6)(1)' ',
|
|
'frog','elephant','thing',(7)(1)' ',
|
|
'walked','treaded','grows','trots',(6)(1)' ',
|
|
'slowly','quickly',(8)(1)' ');
|
|
Dcl ns Char(40) Var;
|
|
Dcl (i,k,j,ii,jj,m,n) Bin Fixed(31);
|
|
n=hbound(w,1); /* number of sets */
|
|
m=hbound(w,2); /* max number of words in set */
|
|
Call show; /* show the input */
|
|
Do i=1 To n-1; /* loop over sets */
|
|
k=i+1; /* the following set */
|
|
Do ii=1 To m; /* loop over elements in set k*/
|
|
If words(w(i,ii))=i Then Do; /* a sentence part found */
|
|
Do jj=1 To m; /* loop over following words */
|
|
If right(w(i,ii),1)=left(w(k,jj),1) Then Do; /* fitting */
|
|
ns=w(i,ii)!!' '!!w(k,jj); /* build new sentence (part) */
|
|
If words(ns)=k Then /* 'complete' part */
|
|
Call add(k,ns); /* add to set k */
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
Do jj=1 To m; /* show the results */
|
|
If words(w(4,jj))=4 Then
|
|
put edit('--> ',w(4,jj))(Skip,a,a);
|
|
End;
|
|
|
|
add: Proc(ni,s);
|
|
/*********************************************************************
|
|
* add a sentence (part) to set ni
|
|
*********************************************************************/
|
|
Dcl (i,ni) Bin Fixed(31);
|
|
Dcl s Char(40) Var;
|
|
Do i=1 To m While(w(ni,i)>''); /* look for an empty slot */
|
|
End;
|
|
w(ni,i)=s; /* add the sentence (part) */
|
|
End;
|
|
|
|
words: Proc(s) Returns(Bin Fixed(31));
|
|
/*********************************************************************
|
|
* return the number of blank separated words in s
|
|
*********************************************************************/
|
|
Dcl s Char(40) Var;
|
|
Dcl nw Bin Fixed(31) Init(0);
|
|
Dcl i Bin Fixed(31) Init(1);
|
|
If s>'' Then Do;
|
|
nw=1;
|
|
Do i=1 To length(s);
|
|
If substr(s,i,1)=' ' Then
|
|
nw+=1;
|
|
End;
|
|
End;
|
|
Return(nw);
|
|
End;
|
|
|
|
show: Proc;
|
|
/*********************************************************************
|
|
* show the input sets
|
|
*********************************************************************/
|
|
Dcl (i,j,mm) Bin Fixed(31) Init(0);
|
|
Dcl l(4) Bin Fixed(31) Init((4)0);
|
|
Do i=1 To n;
|
|
Do j=1 To m;
|
|
If w(i,j)>'' Then Do;
|
|
mm=max(mm,j); /* max number of words in any set */
|
|
l(i)=max(l(i),length(w(i,j))); /* max word length in set i */
|
|
End;
|
|
End;
|
|
End;
|
|
Put Edit('Input:')(Skip,a);
|
|
Do j=1 To mm; /* output lines */
|
|
Put Skip;
|
|
Do i=1 To n;
|
|
Put Edit(w(i,j),' ')(a(l(i)),a);
|
|
End;
|
|
End;
|
|
Put Skip;
|
|
End;
|
|
|
|
End;
|