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

62
Task/Pascal-matrix-generation/PL-I/pascal-matrix-generation-1.pli Normal file
View file

@ -0,0 +1,62 @@
PASCAL_MATRIX: PROCEDURE OPTIONS (MAIN); /* derived from Fortran version 18 Decenber 2021 */
pascal_lower: procedure(a);
declare a(*,*) fixed binary;
declare (n, i, j) fixed binary;
n = hbound(a,1);
a = 0;
a(*, 1) = 1;
do i = 2 to n;
do j = 2 to i;
a(i, j) = a(i - 1, j) + a(i - 1, j - 1);
end;
end;
end pascal_lower;
pascal_upper: procedure(a);
declare a(*,*) fixed binary;
declare (n, i, j) fixed binary;
n = hbound(a,1);
a = 0;
a(1, *) = 1;
do i = 2 to n;
do j = 2 to i;
a(j, i) = a(j, i - 1) + a(j - 1, i - 1);
end;
end;
end pascal_upper;
pascal_symmetric: procedure(a);
declare a(*,*) fixed binary;
declare (n, i, j) fixed binary;
n = hbound(a,1);
a = 0;
a(*, 1) = 1;
a(1, *) = 1;
do i = 2 to n;
do j = 2 to n;
a(i, j) = a(i - 1, j) + a(i, j - 1);
end;
end;
end pascal_symmetric;
declare n fixed binary;
put ('Size of matrix?');
get (n);
begin;
declare a(n, n) fixed binary;
put skip list ('Lower Pascal Matrix');
call pascal_lower(a);
put edit (a) (skip, (n) f(3) );
put skip list ('Upper Pascal Matrix');
call pascal_upper(a);
put edit (a) (skip, (n) f(3) );
put skip list ('Symmetric Pascal Matrix');
call pascal_symmetric(a);
put edit (a) (skip, (n) f(3) );
end;
end PASCAL_MATRIX;

64
Task/Pascal-matrix-generation/PL-I/pascal-matrix-generation-2.pli Normal file
View file

@ -0,0 +1,64 @@
PASCAL_MATRIX: PROCEDURE OPTIONS (MAIN); /* derived from Fortran version 18 Decenber 2021 */
define structure 1 array, 2 b(5,5) fixed binary;
declare A type (array);
pascal_lower: procedure() returns (type(array));
declare A type (array);
declare (n, i, j) fixed binary;
n = hbound(A.b,1);
A.b = 0;
A.b(*, 1) = 1;
do i = 2 to n;
do j = 2 to i;
A.b(i, j) = A.b(i - 1, j) + A.b(i - 1, j - 1);
end;
end;
return (A);
end pascal_lower;
pascal_upper: procedure() returns (type(array));
declare A type (array);
declare (n, i, j) fixed binary;
n = hbound(A.b,1);
A.b = 0;
A.b(1, *) = 1;
do i = 2 to n;
do j = 2 to i;
A.b(j, i) = A.b(j, i - 1) + A.b(j - 1, i - 1);
end;
end;
return (A);
end pascal_upper;
pascal_symmetric: procedure() returns (type(array));
declare A type (array);
declare (n, i, j) fixed binary;
n = hbound(A.b,1);
A.b = 0;
A.b(*, 1) = 1;
A.b(1, *) = 1;
do i = 2 to n;
do j = 2 to n;
A.b(i, j) = A.b(i - 1, j) + A.b(i, j - 1);
end;
end;
return (A);
end pascal_symmetric;
declare C type (array);
declare n fixed binary initial ((hbound(C.b,1)));
put skip list ('Lower Pascal Matrix');
C = pascal_lower();
put edit (C.b) (skip, (n) f(3) );
put skip list ('Upper Pascal Matrix');
C = pascal_upper();
put edit (C.b) (skip, (n) f(3) );
put skip list ('Symmetric Pascal Matrix');
C = pascal_symmetric();
put edit (C.b) (skip, (n) f(3) );
end PASCAL_MATRIX;

87
Task/Pascal-matrix-generation/PL-I/pascal-matrix-generation-3.pli Normal file
View file

@ -0,0 +1,87 @@
*process source attributes xref or(!);
pat: Proc Options(main);
Dcl (HBOUND,MAX,RIGHT) Builtin;
Dcl SYSPRINT Print;
Dcl N Bin Fixed(31) Init(5);
Dcl pd Char(500) Var;
Dcl fact(0:10) Bin Fixed(31);
Dcl pt(0:500) Bin Fixed(31);
Call mk_fact(fact);
Call Pascal(n,'U',pt); Call show('Pascal upper triangular matrix');
Call Pascal(n,'L',pt); Call show('Pascal lower triangular matrix');
Call Pascal(n,'S',pt); Call show('Pascal symmetric matrix' );
Pascal: proc(n,which,dd);
Dcl n Bin Fixed(31);
Dcl which Char(1);
Dcl (i,j,k) Bin Fixed(31);
Dcl dd(0:500) Bin Fixed(31);
k=0;
dd(0)=0;
do i=0 To n-1;
Do j=0 To n-1;
k+=1;
Select(which);
When('U') dd(k)=comb((j), (i));
When('L') dd(k)=comb((i), (j));
When('S') dd(k)=comb((i+j),(i));
Otherwise;
End;
dd(0)=max(dd(0),dd(k));
End;
End;
End;
mk_fact: Proc(f);
Dcl f(0:*) Bin Fixed(31);
Dcl i Bin Fixed(31);
f(0)=1;
Do i=1 To hbound(f);
f(i)=f(i-1)*i;
End;
End;
comb: proc(x,y) Returns(pic'z9');
Dcl (x,y) Bin Fixed(31);
Dcl (j,z) Bin Fixed(31);
Dcl res Pic'Z9';
Select;
When(x=y) res=1;
When(y>x) res=0;
Otherwise Do;
If x-y<y then
y=x-y;
z=1;
do j=x-y+1 to x;
z=z*j;
End;
res=z/fact(y);
End;
End;
Return(res);
End;
show: Proc(head);
Dcl head Char(*);
Dcl (n,r,c,pl) Bin Fixed(31) Init(0);
Dcl row Char(50) Var;
Dcl p Pic'z9';
If pt(0)<10 Then pl=1;
Else pl=2;
Dcl sep(5) Char(1) Init((4)(1)',',']');
Put Edit(' ',head)(Skip,a);
do r=1 To 5;
if r=1 then row='[[';
else row=' [';
do c=1 To 5;
n+=1;
p=pt(n);
row=row!!right(p,pl)!!sep(c);
End;
Put Edit(row)(Skip,a);
End;
Put Edit(']')(A);
End;
End;