88 lines
1.7 KiB
Plaintext
88 lines
1.7 KiB
Plaintext
*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;
|