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

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

86
Task/Amb/PL-I/amb.pli Normal file
View file

@ -0,0 +1,86 @@
*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;