├── LINK ├── ALLFNS.aplf ├── B1.apla ├── B2.apla ├── B3.apla ├── BIGINV.apla ├── BIGPRIMES.apla ├── CCONJ.aplf ├── CDIFF.aplf ├── CINV.aplf ├── CMAG.aplf ├── CMATPROD.aplf ├── CNORM.aplf ├── CNRMLZ.aplf ├── CPOWER.aplf ├── CPROD.aplf ├── CPRODRED.aplf ├── CQUOT.aplf ├── CSUM.aplf ├── DAQ.aplf ├── DARV.aplf ├── DAZV.aplf ├── DECCARRY.aplf ├── DECDIFF.aplf ├── DECPROD.aplf ├── DECQUOT.aplf ├── DECSUM.aplf ├── DERR.aplf ├── DESCRIBE.aplf ├── DESIGN1.apla ├── DESIGN2.apla ├── DESIGN3.apla ├── DESIGN4.apla ├── DESIGN5.apla ├── E25.apla ├── EPSILON.apla ├── EXPAND.aplf ├── EXPANDV.aplf ├── F1.apla ├── F2.apla ├── F3.apla ├── FIRSTPRIME.aplf ├── FRCLEAR.aplf ├── FRDET.aplf ├── FRDIFF.aplf ├── FRINIT.aplf ├── FRMATPROD.aplf ├── FRPOWER.aplf ├── FRPROD.aplf ├── FRSUM.aplf ├── FRTEST.aplf ├── FRXDEGREE.aplf ├── FRXDIFF.aplf ├── FRXEVAL.aplf ├── FRXLEAD.aplf ├── FRXPROD.aplf ├── FRXSUM.aplf ├── G24.apla ├── G6.apla ├── G60.apla ├── GAUSSFACTOR.aplf ├── GAUSSQUOT.aplf ├── GAUSSREM.aplf ├── GCDV.aplf ├── GCDVX.aplf ├── GP8.apla ├── GPALLORB.aplf ├── GPCYCIN.aplf ├── GPCYCOUT.aplf ├── GPINV.aplf ├── GPORBIT.aplf ├── GPPROD.aplf ├── GPSGN.aplf ├── GPSGP.aplf ├── GPSYMG.aplf ├── GPTEST.aplf ├── GRPA2A.apla ├── GTCHECK.aplf ├── GTCLEAR.aplf ├── GTINIT.aplf ├── GTLCON.aplf ├── GTPROD.aplf ├── GTRCON.aplf ├── GTSGP.aplf ├── GTTEST.aplf ├── H24TO6.apla ├── INV24.apla ├── INV6.apla ├── INV60.apla ├── LCMV.aplf ├── LISTFN.aplf ├── LUCASLEHMER.aplf ├── MAKEBIG.aplf ├── MPLUS.apla ├── MPZDET.aplf ├── MPZDIFF.aplf ├── MPZFORM.aplf ├── MPZGCD.aplf ├── MPZGCD0.aplf ├── MPZMAG.aplf ├── MPZMAG0.aplf ├── MPZNEG.aplf ├── MPZNRMLZ.aplf ├── MPZPOWER.aplf ├── MPZPOWER0.aplf ├── MPZPROD.aplf ├── MPZPROD0.aplf ├── MPZREM.aplf ├── MPZREM0.aplf ├── MPZSGN.aplf ├── MPZSUM.aplf ├── MPZSUM0.aplf ├── MPZUNF.aplf ├── MTIMES.apla ├── NOCOMS.aplf ├── NOTEST.apla ├── P20.apla ├── PA1.apla ├── PA2.apla ├── PHI.aplf ├── PLUS.apla ├── POWERR.aplf ├── PROBLEMS.apla ├── QDIFF.aplf ├── QINV.aplf ├── QMATPROD.aplf ├── QNEG.aplf ├── QNRMLZ.aplf ├── QPOWER.aplf ├── QPROD.aplf ├── QQUOT.aplf ├── QSUM.aplf ├── QTEST.aplf ├── QUAT.apla ├── QuadThings.apla ├── RACLEAR.aplf ├── RADIFF.aplf ├── RAINIT.aplf ├── RANEG.aplf ├── RANRMLZ.aplf ├── RAPOWER.aplf ├── RAPROD.aplf ├── RASUM.aplf ├── RDET.aplf ├── RLSYS.aplf ├── RMOD.apla ├── RROWREDUCE.aplf ├── RXDEGREE.aplf ├── RXDET.aplf ├── RXDIFF.aplf ├── RXEVAL.aplf ├── RXFACTOR.aplf ├── RXFCLEAR.aplf ├── RXFDIFF.aplf ├── RXFINIT.aplf ├── RXFINV.aplf ├── RXFPOWER.aplf ├── RXFPROD.aplf ├── RXFSUM.aplf ├── RXGCD.aplf ├── RXGCD0.aplf ├── RXINTERP.aplf ├── RXLEAD.aplf ├── RXMATPROD.aplf ├── RXPROD.aplf ├── RXPRODRED.aplf ├── RXQUOT.aplf ├── RXREDUCE.aplf ├── RXREM.aplf ├── RXROWREDUCE.aplf ├── RXSUM.aplf ├── SCHV.aplf ├── SEQREL.aplf ├── SETDIFF.aplf ├── SETEQ.aplf ├── SETINT.aplf ├── SETUN.aplf ├── SFEL.aplf ├── SIEVE.aplf ├── SSORT.aplf ├── SSUB.aplf ├── TIMES.apla ├── TRAV.aplf ├── XXPOWER.aplf ├── ZACLEAR.aplf ├── ZADIFF.aplf ├── ZAINIT.aplf ├── ZANEG.aplf ├── ZANRMLZ.aplf ├── ZAPOWER.aplf ├── ZAPROD.aplf ├── ZASUM.aplf ├── ZCHREM.aplf ├── ZDET.aplf ├── ZFACTOR.aplf ├── ZGCD.aplf ├── ZGCD0.aplf ├── ZLCM.aplf ├── ZLSYS.aplf ├── ZMATINV.aplf ├── ZNACLEAR.aplf ├── ZNADIFF.aplf ├── ZNAINIT.aplf ├── ZNANEG.aplf ├── ZNANRMLZ.aplf ├── ZNAPOWER.aplf ├── ZNAPROD.aplf ├── ZNASUM.aplf ├── ZNDET.aplf ├── ZNDIFF.aplf ├── ZNINV.aplf ├── ZNLSYS.aplf ├── ZNMATINV.aplf ├── ZNMATPROD.aplf ├── ZNNEG.aplf ├── ZNPOWER.aplf ├── ZNPROD.aplf ├── ZNROWREDUCE.aplf ├── ZNSUM.aplf ├── ZNXDEGREE.aplf ├── ZNXDET.aplf ├── ZNXDIFF.aplf ├── ZNXEVAL.aplf ├── ZNXFACTOR.aplf ├── ZNXFCLEAR.aplf ├── ZNXFDIFF.aplf ├── ZNXFINIT.aplf ├── ZNXFINV.aplf ├── ZNXFPOWER.aplf ├── ZNXFPROD.aplf ├── ZNXFSUM.aplf ├── ZNXGCD.aplf ├── ZNXGCD0.aplf ├── ZNXIRRED.aplf ├── ZNXLEAD.aplf ├── ZNXMATINV.aplf ├── ZNXMATPROD.aplf ├── ZNXMONIC.aplf ├── ZNXPROD.aplf ├── ZNXPRODRED.aplf ├── ZNXQUOT.aplf ├── ZNXREDUCE.aplf ├── ZNXREM.aplf ├── ZNXROWREDUCE.aplf ├── ZNXSUM.aplf ├── ZPRIMES.aplf ├── ZQUOT.aplf ├── ZREDUCE.aplf ├── ZREM.aplf ├── ZROWREDUCE.aplf ├── ZXDEGREE.aplf ├── ZXDIFF.aplf ├── ZXEVAL.aplf ├── ZXFCLEAR.aplf ├── ZXFDIFF.aplf ├── ZXFINIT.aplf ├── ZXFPOWER.aplf ├── ZXFPROD.aplf ├── ZXFSUM.aplf ├── ZXINTERP.aplf ├── ZXLEAD.aplf ├── ZXMATPROD.aplf ├── ZXPROD.aplf └── ZXSUM.aplf ├── README.md ├── SUMMARY.md ├── archive ├── MP.txt ├── mpaspac.apl ├── mpaspac.atf └── mpaspac.txt ├── classlib0.atf ├── examples.apl ├── global.apl ├── group.apl ├── mp.apl ├── polynomial.apl ├── prng ├── add.apl ├── binary.apl └── linear.apl ├── q.apl ├── set.apl ├── symgroup.apl ├── translate.txt ├── utils.apl ├── z.apl └── zx.apl /LINK/ALLFNS.aplf: -------------------------------------------------------------------------------- 1 | ALLFNS PN;NL;I;AA;⎕IO;ML;PAGE;M;J;X;Y;P 2 | ⍝ PRINTS A LISTING OF THE PROCEDURES IN THE ACTIVE WORKSPACE, 3 | ⍝ EXCEPT FOR ITSELF AND LISTFN. THE FIRST PAGE IS A LIST 4 | ⍝ OF THE NAMES OF THE PROCEDURES. IT IS ASSUMED THAT THE 5 | ⍝ THE TERMINAL PRINTS 66 LINES PER PAGE. THE ARGUMENT PN IS 6 | ⍝ THE FIRST PAGE NUMBER OF THE LISTING TO BE PRINTED. 7 | ⍝ NORMALLY PN IS 1. 8 | P←1 9 | NL←⎕NL 3 10 | ⎕IO←1 11 | M←(⍴NL)[2] 12 | I←M+1 13 | LOOP1:→(0≥I←I-1)/LIST 14 | NL←NL[⍋⎕AV⍳NL[;I];] 15 | →LOOP1 16 | LIST:ML←((1↑⍴NL),15)↑NL 17 | ML←(ML∨.≠'ALLFNS ')⌿ML 18 | ML←(ML∨.≠'LISTFN ')⌿ML 19 | PAGE←52 0⍴'' 20 | LOOP2:→(0≥1↑⍴ML)/OK 21 | PAGE←PAGE,52 15↑ML 22 | ML←52 0↓ML 23 | →LOOP2 24 | OK:→(P0)/⍳⍴B←,B 14 | LOOP:C[J;]←C[J;]CPROD A[J←(2|B[I])/I;] 15 | →(0=⍴I←(B[I]≥2)/I)/END 16 | A[I;]←A[I;]CPROD A[I;] 17 | B[I]←⌊B[I]÷2 18 | →LOOP 19 | END:C←RHO⍴C 20 | -------------------------------------------------------------------------------- /LINK/CPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A CPROD B;R 2 | ⍝ COMPUTES THE PRODUCT OF TWO COMPLEX ARRAYS. 3 | →NOTEST/BEGIN 4 | A←CNRMLZ A 5 | B←CNRMLZ B 6 | EXPANDV 7 | BEGIN:C←(R⍴-/A×B),(R←(¯1↓⍴A),1)⍴+/A×⌽B 8 | C←C×(|C)≥EPSILON×⌈/,|C 9 | -------------------------------------------------------------------------------- /LINK/CPRODRED.aplf: -------------------------------------------------------------------------------- 1 | C←CPRODRED A;⎕IO;RHO;D;E;CC;L;NOTEST 2 | ⍝ COMPUTES THE PRODUCT REDUCTION ALONG THE LAST 3 | ⍝ AXIS OF AN ARRAY OF COMPLEX NUMBERS. 4 | NOTEST←0 5 | A←CNRMLZ A 6 | →(1=⍴⍴C←A)/0 7 | ⎕IO←1 8 | L←×/RHO←¯2↓⍴C 9 | C←(L,¯2↑⍴C)⍴C 10 | →(0=(⍴C)[2])/ZERO 11 | NOTEST←1 12 | LOOP:→(1=D←(⍴C)[2])/ONE 13 | CC←((L,E,2)↑C)CPROD(L,(-E←⌊D÷2),2)↑C 14 | C←CC,[2]C[;(E+1)×⍳D≠2×E;] 15 | →LOOP 16 | ZERO:C←(RHO,2)⍴1 0 17 | →0 18 | ONE:C←(RHO,2)⍴C 19 | -------------------------------------------------------------------------------- /LINK/CQUOT.aplf: -------------------------------------------------------------------------------- 1 | C←A CQUOT B;N;R 2 | ⍝ COMPUTES THE QUOTIENT OF TWO COMPLEX ARRAYS. 3 | →NOTEST/BEGIN 4 | A←CNRMLZ A 5 | B←CNRMLZ B 6 | EXPANDV 7 | BEGIN:DERR∧/,0≠N←(R←(¯1↓⍴B),1)⍴+/B×B 8 | C←((R⍴+/A×B)÷N),(R⍴-/B×⌽A)÷N 9 | C←C×(|C)≥EPSILON×⌈/,|C 10 | -------------------------------------------------------------------------------- /LINK/CSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A CSUM B 2 | ⍝ COMPUTES THE SUM OF TWO COMPLEX ARRAYS. 3 | →NOTEST/BEGIN 4 | A←CNRMLZ A 5 | B←CNRMLZ B 6 | EXPANDV 7 | BEGIN:C←C×(|C)≥EPSILON×⌈/,|C←A+B 8 | -------------------------------------------------------------------------------- /LINK/DAQ.aplf: -------------------------------------------------------------------------------- 1 | X←DAQ A;NA;RA;M;K;R 2 | ⍝ PRODUCES THE CHARACTER ARRAY FOR DISPLAYING AN 3 | ⍝ ARRAY OF RATIONAL NUMBERS. 4 | X←'' 5 | →(0=NA←×/⍴A)/0 6 | RA←⍴A←QNRMLZ A 7 | M←1⌈¯1↓¯2↑RA 8 | K←¯1↑⍴X←⍕(NA,1)⍴A 9 | R←(¯1++/X=' ')×NA⍴0 1 10 | X←R⌽X 11 | X←((×/¯1↓RA),2×K)⍴X 12 | X[;K+⎕IO]←'/' 13 | X←X,' ' 14 | X←((¯2↓RA),Mׯ1↑⍴X)⍴X 15 | -------------------------------------------------------------------------------- /LINK/DARV.aplf: -------------------------------------------------------------------------------- 1 | X←P DARV A;NA;RA;M;K 2 | ⍝ PRODUCES THE CHARACTER ARRAY DISPLAYING AN ARRAY 3 | ⍝ OF REAL VECTORS WITH P DECIMAL PLACES. 4 | X←'' 5 | →(0=NA←×/RA←⍴A)/0 6 | M←1⌈¯1↓¯2↑RA 7 | K←¯1↑⍴X←P⍕(NA,1)⍴A 8 | X←((×/¯1↓RA),Kׯ1↑RA)⍴X 9 | X←(0 2+⍴X)↑X 10 | X←((¯2↓RA),Mׯ1↑⍴X)⍴X 11 | -------------------------------------------------------------------------------- /LINK/DAZV.aplf: -------------------------------------------------------------------------------- 1 | X←DAZV A 2 | ⍝ PRODUCES THE CHARACTER ARRAY DISPLAYING AN ARRAY 3 | ⍝ OF INTEGER VECTORS OR REAL VECTORS ROUNDED TO THE 4 | ⍝ NEAREST INTEGER. 5 | X←'' 6 | →(0=×/⍴A)/0 7 | X←0 DARV A 8 | -------------------------------------------------------------------------------- /LINK/DECCARRY.aplf: -------------------------------------------------------------------------------- 1 | Z←DECCARRY X;SGN 2 | ⍝ EXERCISE 2.5.2 3 | Z←,X 4 | SGN←1 5 | LOOP:Z←(+/∧\Z=0)↓Z 6 | →(0≠⍴Z)/NONEMPTY 7 | →Z←,0 8 | NONEMPTY:→(0<1↑Z)/POS 9 | SGN←-SGN 10 | Z←-Z 11 | POS:→(∧/(0≤Z),Z<10)/DONE 12 | Z←(0,10|Z)+(Z ZQUOT 10),0 13 | →LOOP 14 | DONE:Z←SGN×Z 15 | -------------------------------------------------------------------------------- /LINK/DECDIFF.aplf: -------------------------------------------------------------------------------- 1 | Z←X DECDIFF Y 2 | ⍝ EXERCISE 2.5.3 3 | Z←X DECSUM-Y 4 | -------------------------------------------------------------------------------- /LINK/DECPROD.aplf: -------------------------------------------------------------------------------- 1 | Z←X DECPROD Y;⎕IO;U;V 2 | ⍝ EXERCISE 2.5.2 3 | ⎕IO←0 4 | U←(Y←,Y)∘.×X←,X 5 | V←(-⍳⍴Y)⌽((⍴U)+0,¯1+⍴Y)↑U 6 | Z←DECCARRY+⌿V 7 | -------------------------------------------------------------------------------- /LINK/DECQUOT.aplf: -------------------------------------------------------------------------------- 1 | Z←X DECQUOT Y;SGNX;SGNY;L;U 2 | ⍝ EXERCISE 2.5.3 3 | SGNX←×1↑X←DECCARRY X 4 | SGNY←×1↑Y←DECCARRY Y 5 | →(SGNY≠0)/NONZERO 6 | →(SGNX≠0)/DE 7 | Z←,1 8 | →0 9 | DE:'DOMAIN ERROR' 10 | →0 11 | NONZERO:X←|X 12 | Y←|Y 13 | Z←,0 14 | LOOP:→(0>L←(⍴X)-⍴Y)/DONE 15 | →(∧/0=U←((-L)↓X)-Y)/SUBTRACT 16 | →(0⍴RB)/EXB 20 | ⍝ EXPAND A 21 | →0,⍴A←RB⍴A 22 | ⍝ EXPAND B 23 | EXB:B←RA⍴B 24 | -------------------------------------------------------------------------------- /LINK/EXPANDV.aplf: -------------------------------------------------------------------------------- 1 | EXPANDV;RA;NA;RB;NB 2 | ⍝ TESTS IF TWO ARRAYS OF VECTORS ARE CONFORMABLE FOR 3 | ⍝ SCALAR OPERATIONS AND IF SO, EXPANDS ONE, IF 4 | ⍝ NECESSARY, SO THAT THEY HAVE THE SAME SHAPE ALONG ALL 5 | ⍝ BUT THE LAST AXIS. IF THEY ARE NOT CONFORMABLE, ALL 6 | ⍝ PROCESSING IS STOPPED. 7 | ⍝ SCALARS ARE REPLACED BY VECTORS OF LENGTH 1. 8 | →(1≤⍴⍴A)/CHECKB 9 | A←,A 10 | CHECKB:→(1≤⍴⍴B)/NEXT 11 | B←,B 12 | ⍝ IF A OR B HAS ONE ENTRY, THE ARE CONFORMABLE. 13 | NEXT:→(∨/1=(NA←×/RA←¯1↓⍴A),NB←×/RB←¯1↓⍴B)/EXP 14 | →((⍴RA)≠⍴RB)/RNKERR 15 | →(∨/RA≠RB)/LENERR 16 | →0 17 | RNKERR:'VECTOR RANK ERROR' 18 | → 19 | LENERR:'VECTOR LENGTH ERROR' 20 | → 21 | EXP:→((NA≠1)∨(NA=1)∧(NB=1)∧(⍴RA)>⍴RB)/EXPB 22 | A←(RB,¯1↑⍴A)⍴A 23 | →0 24 | EXPB:B←(RA,¯1↑⍴B)⍴B 25 | -------------------------------------------------------------------------------- /LINK/F1.apla: -------------------------------------------------------------------------------- 1 | 0 14 24 40 34 56 14 0 34 56 24 40 40 24 56 34 0 14 56 34 40 24 14 0 2 | -------------------------------------------------------------------------------- /LINK/F2.apla: -------------------------------------------------------------------------------- 1 | 0 40 49 31 13 8 53 15 39 0 56 16 51 16 57 30 7 24 42 26 6 45 5 26 2 | -------------------------------------------------------------------------------- /LINK/F3.apla: -------------------------------------------------------------------------------- 1 | 0 47 47 0 0 47 47 0 0 47 47 0 0 47 47 0 0 47 47 0 0 47 47 0 2 | -------------------------------------------------------------------------------- /LINK/FIRSTPRIME.aplf: -------------------------------------------------------------------------------- 1 | P←FIRSTPRIME N 2 | ⍝ EXERCISE 2.4.5 3 | →(N>2)/ODD 4 | P←2 5 | →0 6 | ODD:P←1+2×⌊N÷2 7 | LOOP:→(1=⍴ZFACTOR P)/0 8 | P←P+2 9 | →LOOP 10 | -------------------------------------------------------------------------------- /LINK/FRCLEAR.aplf: -------------------------------------------------------------------------------- 1 | FRCLEAR;I 2 | ⍝ EXPUNGES THE VARIABLES DESCRIBING THE CURRENT 3 | ⍝ FINITE RING. 4 | I←(⎕EX'FRPLUS'),(⎕EX'FRTIMES'),(⎕EX'FRNEG'),⎕EX'FRINV' 5 | -------------------------------------------------------------------------------- /LINK/FRDET.aplf: -------------------------------------------------------------------------------- 1 | D←FRDET A;⎕IO;M;N;K;SIGN;X;NX;S;T;SGN;CFR;U 2 | ⍝ COMPUTES THE DETERMINANT OF A MATRIX OVER THE FINITE RING, 3 | ⍝ WHICH MUST BE COMMUTATIVE. 4 | ⎕IO←0 5 | DERR∧/(FRTEST A),(2=⍴⍴A),=/⍴A 6 | DERR∧/,FRTIMES=⍉FRTIMES 7 | T←(2*N←1↑⍴A)⍴3-3 8 | CFR←⍴FRNEG 9 | M←A[K←0;] 10 | SIGN←1 11 | NX←+/2*X←(N,1)⍴⍳N 12 | LOOP:→(N≤K←K+1)/END 13 | T[NX]←⍳⍴NX 14 | NX←+/2*X←(K+1)SSUB N 15 | S←T[(⍉((K+1),⍴NX)⍴NX)-2*X] 16 | SIGN←-SIGN 17 | U←(,FRTIMES)[A[K;X]+M[S]×CFR] 18 | M←(¯1↓⍴U)⍴0 19 | X←0=⍳¯1↑⍴U 20 | SGN←SIGN 21 | LOOP2:→(SGN=¯1)/NEG 22 | M←(,FRPLUS)[((⍴M)⍴X/U)+M×CFR] 23 | →INCR 24 | NEG:M←(,FRPLUS)[FRNEG[(⍴M)⍴X/U]+M×CFR] 25 | INCR:SGN←-SGN 26 | →(~1↑X←¯1⌽X)/LOOP2 27 | →LOOP 28 | END:D←+/M 29 | -------------------------------------------------------------------------------- /LINK/FRDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A FRDIFF B;⎕IO 2 | ⍝ COMPUTES THE DIFFERENCE OF TWO ARRAYS OVER THE FINITE 3 | ⍝ RING. 4 | ⎕IO←0 5 | →NOTEST/BEGIN 6 | DERR(FRTEST A)∧FRTEST B 7 | EXPAND 8 | BEGIN:C←(,FRPLUS)[FRNEG[B]+A×1↑⍴FRPLUS] 9 | -------------------------------------------------------------------------------- /LINK/FRINIT.aplf: -------------------------------------------------------------------------------- 1 | A FRINIT B;⎕IO;C;U 2 | ⍝ INITIALIZES THE GLOBAL VARIABLES FOR THE CURRENT FINITE 3 | ⍝ RING. A IS THE ADDITION TABLE AND B IS THE 4 | ⍝ MULTIPLICATION TABLE. 5 | FRPLUS←A 6 | FRTIMES←B 7 | FRNEG←SFEL A=⎕IO←0 8 | U←FRINV/⍳⍴FRINV←(∨/⍉C)∧∨/C←B=1 9 | FRINV[U]←SFEL C[U;] 10 | -------------------------------------------------------------------------------- /LINK/FRMATPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A FRMATPROD B;M;RHO;RR;X;AX;BX;⎕IO;RA;RB 2 | ⍝ COMPUTES THE MATRIX PRODUCT OF TWO NONSCALAR ARRAYS 3 | ⍝ OVER THE FINITE RING. 4 | ⎕IO←0 5 | DERR(FRTEST A)∧(FRTEST B)∧(∧/0<(⍴⍴A),⍴⍴B)∧(¯1↑⍴A)=1↑⍴B 6 | RHO←(RA←¯1↓⍴A),RB←1↓⍴B 7 | RR←((⍴RA)+⍳⍴RB),⍳⍴RA 8 | C←RHO⍴0 9 | M←1↑⍴FRTIMES 10 | X←(1↑⍴B)↑1 11 | LOOP:AX←RR⍉(RB,RA)⍴X/A 12 | BX←RHO⍴X⌿B 13 | C←(,FRPLUS)[(,FRTIMES)[BX+AX×M]+C×M] 14 | →(~1↑X←¯1⌽X)/LOOP 15 | -------------------------------------------------------------------------------- /LINK/FRPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A FRPOWER B;RHO;I;J;⎕IO;M 2 | ⍝ COMPUTES THE B-TH POWER OF A IN THE FINITE RING 3 | ⍝ USING THE BINARY POWER ALGORITHM. 4 | ⎕IO←0 5 | DERR(FRTEST A)∧∧/,(B=⌊B),B≥0 6 | EXPAND 7 | RHO←⍴A 8 | C←(⍴A←,A)⍴1 9 | I←(B>0)/⍳⍴B←,B 10 | M←1↑⍴FRTIMES 11 | LOOP:C[J]←(,FRTIMES)[A[J]+M×C[J←(2|B[I])/I]] 12 | →(0=⍴I←(B[I]≥2)/I)/END 13 | A[I]←(,FRTIMES)[A[I]×M+1] 14 | B[I]←⌊B[I]÷2 15 | →LOOP 16 | END:C←RHO⍴C 17 | -------------------------------------------------------------------------------- /LINK/FRPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A FRPROD B;⎕IO 2 | ⍝ COMPUTES THE PRODUCT OF TWO ARRAYS OVER THE FINITE RING. 3 | ⎕IO←0 4 | →NOTEST/BEGIN 5 | DERR(FRTEST A)∧FRTEST B 6 | EXPAND 7 | BEGIN:C←(,FRTIMES)[B+A×1↑⍴FRTIMES] 8 | -------------------------------------------------------------------------------- /LINK/FRSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A FRSUM B;⎕IO 2 | ⍝ COMPUTES THE SUM OF TWO ARRAYS OVER THE FINITE RING. 3 | ⎕IO←0 4 | →NOTEST/BEGIN 5 | DERR(FRTEST A)∧FRTEST B 6 | EXPAND 7 | BEGIN:C←(,FRPLUS)[B+A×1↑⍴FRPLUS] 8 | -------------------------------------------------------------------------------- /LINK/FRTEST.aplf: -------------------------------------------------------------------------------- 1 | T←FRTEST A 2 | ⍝ CHECKS WHETHER A REPRESENTS AN ARRAY OVER THE CURRENT 3 | ⍝ FINITE RING. 4 | T←∧/(,A=⌊A),(,A<⍴FRNEG),,0≤A 5 | -------------------------------------------------------------------------------- /LINK/FRXDEGREE.aplf: -------------------------------------------------------------------------------- 1 | B←FRXDEGREE A 2 | ⍝ COMPUTES THE ARRAY OF DEGREES OF AN ARRAY OF POLYNOMIALS 3 | ⍝ OVER THE FINITE RING. 4 | DERR FRTEST A 5 | B←ZXDEGREE A 6 | -------------------------------------------------------------------------------- /LINK/FRXDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A FRXDIFF B 2 | ⍝ COMPUTES THE DIFFERENCE OF TWO ARRAYS OF POLYNOMIALS 3 | ⍝ OVER THE FINITE RING. 4 | C←A FRXSUM FRNEG[B] 5 | -------------------------------------------------------------------------------- /LINK/FRXEVAL.aplf: -------------------------------------------------------------------------------- 1 | Y←A FRXEVAL B;I;⎕IO;RHO;M 2 | ⍝ EVALUTES THE POLYNOMIALS IN A AT B IN THE 3 | ⍝ FINITE RING. COMMUTATIVITY OF THE RING IS NOT CHECKED. 4 | DERR(FRTEST A)∧FRTEST B←((⍴B),1)⍴B 5 | EXPANDV 6 | A←((×/RHO←¯1↓⍴A),¯1↑⍴A)⍴A 7 | Y←(⍴B←,B)⍴⎕IO←0 8 | M←1↑⍴FRPLUS 9 | I←(⍴A)[1] 10 | LOOP:→(0>I←I-1)/END 11 | Y←(,FRPLUS)[(,FRTIMES)[B+M×Y]+M×A[;I]] 12 | →LOOP 13 | END:Y←RHO⍴Y 14 | -------------------------------------------------------------------------------- /LINK/FRXLEAD.aplf: -------------------------------------------------------------------------------- 1 | C←FRXLEAD A;EPSILON 2 | ⍝ COMPUTES THE LEADING COEFFICIENTS OF AN ARRAY OF 3 | ⍝ POLYNOMIALS OVER THE CURRENT FINITE RING. 4 | DERR FRTEST A 5 | EPSILON←0 6 | C←RXLEAD A 7 | -------------------------------------------------------------------------------- /LINK/FRXPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A FRXPROD B;⎕IO;D;RHO;I 2 | ⍝ COMPUTES THE ENTRY-BY-ENTRY PRODUCT OF TWO ARRAYS 3 | ⍝ OF POLYNOMIALS OVER THE FINITE RING. 4 | EXPANDV 5 | ⎕IO←0 6 | D←((⍳¯1+⍴⍴A),0 ¯1+⍴⍴A)⍉B∘.×(¯1↑⍴A)⍴1 7 | D←(A∘.×(¯1↑⍴B)⍴1)FRPROD D 8 | D←D,((⍴A),¯1+¯1↑⍴A)⍴0 9 | D←((⍴A)⍴-⍳¯1↑⍴A)⌽D 10 | RHO←⍴D 11 | D←((×/¯2↓RHO),¯2↑RHO)⍴D 12 | C←(⍴D)[0 2]⍴0 13 | I←¯1 14 | LOOP:→((⍴D)[1]=I←I+1)/END 15 | C←C FRSUM D[;I;] 16 | →LOOP 17 | END:D←1⌈+/∨\⌽∨⌿0≠C 18 | C←((¯2↓RHO),D)⍴((1↑⍴C),D)↑C 19 | -------------------------------------------------------------------------------- /LINK/FRXSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A FRXSUM B;M;D 2 | ⍝ COMPUTES THE SUM OF TWO ARRAYS OF POLYNOMIALS OVER 3 | ⍝ THE FINITE RING. 4 | EXPANDV 5 | M←(⍴A)⌈⍴B 6 | C←(M↑A)FRSUM M↑B 7 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),¯1↑⍴C)⍴C≠0 8 | C←((¯1↓⍴C),D)↑C 9 | -------------------------------------------------------------------------------- /LINK/G24.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 3 | 1 0 4 5 2 3 7 6 10 11 8 9 18 19 20 21 22 23 12 13 14 15 16 17 4 | 2 3 0 1 5 4 12 13 14 15 16 17 6 7 8 9 10 11 19 18 22 23 20 21 5 | 3 2 5 4 0 1 13 12 16 17 14 15 19 18 22 23 20 21 6 7 8 9 10 11 6 | 4 5 1 0 3 2 18 19 20 21 22 23 7 6 10 11 8 9 13 12 16 17 14 15 7 | 5 4 3 2 1 0 19 18 22 23 20 21 13 12 16 17 14 15 7 6 10 11 8 9 8 | 6 7 8 9 10 11 0 1 2 3 4 5 14 15 12 13 17 16 20 21 18 19 23 22 9 | 7 6 10 11 8 9 1 0 4 5 2 3 20 21 18 19 23 22 14 15 12 13 17 16 10 | 8 9 6 7 11 10 14 15 12 13 17 16 0 1 2 3 4 5 21 20 23 22 18 19 11 | 9 8 11 10 6 7 15 14 17 16 12 13 21 20 23 22 18 19 0 1 2 3 4 5 12 | 10 11 7 6 9 8 20 21 18 19 23 22 1 0 4 5 2 3 15 14 17 16 12 13 13 | 11 10 9 8 7 6 21 20 23 22 18 19 15 14 17 16 12 13 1 0 4 5 2 3 14 | 12 13 14 15 16 17 2 3 0 1 5 4 8 9 6 7 11 10 22 23 19 18 21 20 15 | 13 12 16 17 14 15 3 2 5 4 0 1 22 23 19 18 21 20 8 9 6 7 11 10 16 | 14 15 12 13 17 16 8 9 6 7 11 10 2 3 0 1 5 4 23 22 21 20 19 18 17 | 15 14 17 16 12 13 9 8 11 10 6 7 23 22 21 20 19 18 2 3 0 1 5 4 18 | 16 17 13 12 15 14 22 23 19 18 21 20 3 2 5 4 0 1 9 8 11 10 6 7 19 | 17 16 15 14 13 12 23 22 21 20 19 18 9 8 11 10 6 7 3 2 5 4 0 1 20 | 18 19 20 21 22 23 4 5 1 0 3 2 10 11 7 6 9 8 16 17 13 12 15 14 21 | 19 18 22 23 20 21 5 4 3 2 1 0 16 17 13 12 15 14 10 11 7 6 9 8 22 | 20 21 18 19 23 22 10 11 7 6 9 8 4 5 1 0 3 2 17 16 15 14 13 12 23 | 21 20 23 22 18 19 11 10 9 8 7 6 17 16 15 14 13 12 4 5 1 0 3 2 24 | 22 23 19 18 21 20 16 17 13 12 15 14 5 4 3 2 1 0 11 10 9 8 7 6 25 | 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 26 | ] 27 | -------------------------------------------------------------------------------- /LINK/G6.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 1 2 3 4 5 3 | 1 0 4 5 2 3 4 | 2 3 0 1 5 4 5 | 3 2 5 4 0 1 6 | 4 5 1 0 3 2 7 | 5 4 3 2 1 0 8 | ] 9 | -------------------------------------------------------------------------------- /LINK/G60.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 3 | 1 0 4 6 2 9 3 11 13 5 15 7 17 8 19 10 24 12 25 14 26 27 29 30 16 18 20 21 35 22 23 36 37 40 41 28 31 32 45 46 33 34 48 50 51 38 39 53 42 54 43 44 57 47 49 58 59 52 55 56 4 | 2 3 5 8 7 0 12 14 1 10 18 20 21 16 4 23 26 25 9 28 22 6 11 33 31 32 13 34 30 42 19 38 17 15 36 39 27 49 24 44 47 43 46 52 35 55 29 54 45 50 37 56 41 51 40 48 53 59 57 58 5 | 3 2 7 12 5 10 8 20 16 0 23 14 25 1 28 18 31 21 32 4 13 34 42 19 26 9 22 6 39 11 33 27 49 47 43 30 38 17 55 29 15 36 45 37 56 24 44 51 46 40 52 35 59 54 50 57 58 41 48 53 6 | 4 6 9 13 11 1 17 19 0 15 25 26 27 24 2 30 20 18 5 35 29 3 7 40 36 37 8 41 23 48 14 45 12 10 31 46 21 54 16 51 53 50 39 57 28 58 22 49 38 43 32 59 34 44 33 42 47 56 52 55 7 | 5 8 0 1 14 2 21 4 3 18 9 22 6 26 7 33 13 32 10 30 11 12 20 15 38 17 16 36 19 46 28 24 25 23 27 44 34 50 31 35 54 52 29 41 39 48 42 40 55 37 49 53 43 56 47 45 51 58 59 57 8 | 6 4 11 17 9 15 13 26 24 1 30 19 18 0 35 25 36 27 37 2 8 41 48 14 20 5 29 3 46 7 40 21 54 53 50 23 45 12 58 22 10 31 38 32 59 16 51 44 39 33 57 28 56 49 43 52 55 34 42 47 9 | 7 12 10 16 20 3 25 28 2 23 32 13 34 31 5 19 22 9 0 39 42 8 14 47 27 49 1 43 33 45 4 55 21 18 38 29 6 40 26 56 51 37 44 59 30 57 11 50 24 52 17 58 36 35 15 46 54 53 41 48 10 | 8 5 14 21 0 18 1 22 26 2 33 4 32 3 30 9 38 6 17 7 16 36 46 28 13 10 11 12 44 20 15 34 50 54 52 19 24 25 48 42 23 27 55 49 53 31 35 56 29 47 41 39 58 40 37 59 57 43 45 51 11 | 9 13 1 0 19 4 27 2 6 25 5 29 3 20 11 40 8 37 15 23 7 17 26 10 45 12 24 31 14 39 35 16 18 30 21 51 41 43 36 28 49 57 22 34 46 42 48 33 58 32 54 47 50 59 53 38 44 55 56 52 12 | 10 16 3 2 28 7 34 5 12 32 0 42 8 22 20 47 1 49 23 33 14 25 13 18 55 21 31 38 4 44 39 26 9 19 6 56 43 52 27 30 50 59 11 36 29 46 45 15 57 17 40 54 37 58 51 24 35 48 53 41 13 | 11 17 15 24 26 6 18 35 4 30 37 8 41 36 9 14 29 5 1 46 48 13 19 53 21 54 0 50 40 38 2 58 27 25 45 22 3 33 20 59 44 32 51 56 23 52 7 43 16 57 12 55 31 28 10 39 49 47 34 42 14 | 12 7 20 25 10 23 16 13 31 3 19 28 9 2 39 32 27 34 49 5 1 43 45 4 22 0 42 8 29 14 47 6 40 51 37 33 55 21 57 11 18 38 24 17 58 26 56 35 44 15 59 30 53 50 52 41 48 36 46 54 15 | 13 9 19 27 1 25 0 29 20 4 40 2 37 6 23 5 45 3 12 11 24 31 39 35 8 15 7 17 51 26 10 41 43 49 57 14 16 18 42 48 30 21 58 54 47 36 28 59 22 53 34 46 55 33 32 56 52 50 38 44 16 | 14 21 18 26 22 8 32 30 5 33 17 16 36 38 0 28 11 10 2 44 46 1 4 54 34 50 3 52 15 55 7 48 6 9 24 42 12 47 13 53 56 49 35 58 19 59 20 37 31 41 25 57 27 39 23 29 40 51 43 45 17 | 15 24 6 4 35 11 41 9 17 37 1 48 13 29 26 53 0 54 30 40 19 18 8 25 58 27 36 45 2 51 46 20 5 14 3 59 50 57 21 23 43 56 7 31 22 39 38 10 52 12 33 49 32 55 44 16 28 42 47 34 18 | 16 10 28 34 3 32 2 42 22 7 47 5 49 12 33 0 55 8 21 20 31 38 44 39 1 23 14 25 56 13 18 43 52 50 59 4 26 9 46 45 19 6 57 40 54 27 30 58 11 51 36 29 48 15 17 53 41 37 24 35 19 | 17 11 26 18 15 30 24 8 36 6 14 35 5 4 46 37 21 41 54 9 0 50 38 2 29 1 48 13 22 19 53 3 33 44 32 40 58 27 52 7 25 45 16 12 55 20 59 28 51 10 56 23 47 43 57 34 42 31 39 49 20 | 18 26 8 5 30 14 36 0 21 17 2 46 1 11 22 54 3 50 33 15 4 32 16 9 48 6 38 24 7 35 44 13 10 28 12 53 52 41 34 19 37 58 20 27 42 29 55 23 59 25 47 40 49 57 56 31 39 45 51 43 21 | 19 27 25 20 29 13 37 23 9 40 12 24 31 45 1 35 7 15 4 51 39 0 2 49 41 43 6 57 10 58 11 42 3 5 16 48 17 53 8 47 59 54 28 55 14 56 26 32 36 34 18 52 21 46 30 22 33 44 50 38 22 | 20 25 23 31 13 12 9 39 7 19 49 1 43 27 10 4 42 0 3 29 45 16 28 51 6 40 2 37 47 24 5 57 34 32 55 11 8 15 22 58 35 17 56 53 33 41 14 52 26 59 21 48 38 30 18 44 50 54 36 46 23 | 21 14 22 32 18 33 26 16 38 8 28 30 10 5 44 17 34 36 50 0 3 52 55 7 11 2 46 1 42 4 54 12 47 56 49 15 48 6 59 20 9 24 31 25 57 13 53 39 35 23 58 19 51 37 41 43 45 27 29 40 24 | 22 32 33 38 16 21 10 44 14 28 50 3 52 34 18 7 46 2 8 42 55 26 30 56 12 47 5 49 54 31 0 59 36 17 48 20 1 23 11 57 39 25 53 51 15 43 4 41 13 58 6 45 24 19 9 35 37 40 27 29 25 | 23 31 12 7 39 20 43 10 25 49 3 45 16 42 13 51 2 40 19 47 28 9 1 32 57 34 27 55 5 56 29 22 0 4 8 58 37 59 6 33 52 53 14 38 11 44 24 18 41 21 15 50 17 48 35 26 30 46 54 36 26 | 24 15 35 41 6 37 4 48 29 11 53 9 54 17 40 1 58 13 27 26 36 45 51 46 0 30 19 18 59 8 25 50 57 43 56 2 20 5 39 38 14 3 52 33 49 21 23 55 7 44 31 22 42 10 12 47 34 32 16 28 27 | 25 20 13 9 23 19 31 1 27 12 4 39 0 7 29 49 6 43 40 10 2 37 24 5 42 3 45 16 11 28 51 8 15 35 17 47 57 34 41 14 32 55 26 21 48 22 58 30 56 18 53 33 54 52 59 36 46 38 44 50 28 | 26 18 30 36 8 17 5 46 11 14 54 0 50 21 15 2 48 1 6 22 38 24 35 44 3 33 4 32 53 16 9 52 41 37 58 7 13 10 29 55 28 12 59 47 40 34 19 57 20 56 27 42 45 23 25 51 43 49 31 39 29 | 27 19 29 37 25 40 20 24 45 13 35 23 15 9 51 12 41 31 43 1 6 57 58 11 7 4 39 0 48 2 49 17 53 59 54 10 42 3 56 26 5 16 36 18 52 8 47 46 28 30 55 14 44 32 34 50 38 21 22 33 30 | 28 34 32 22 42 16 49 33 10 47 21 31 38 55 3 39 14 23 7 56 44 2 5 50 43 52 12 59 18 57 20 46 8 0 26 45 25 51 1 54 58 40 30 48 4 53 13 17 27 36 9 41 6 29 19 11 15 35 37 24 31 | 29 37 40 45 24 27 15 51 19 35 43 6 57 41 25 11 39 4 13 48 58 20 23 59 17 53 9 54 49 36 1 56 31 12 42 26 0 30 7 52 46 18 47 44 10 50 2 34 8 55 3 38 16 14 5 28 32 33 21 22 32 | 30 36 17 11 46 26 50 15 18 54 6 38 24 48 8 44 4 33 14 53 35 5 0 37 52 41 21 58 9 59 22 29 1 2 13 55 32 56 3 40 57 47 19 45 7 51 16 25 34 27 10 43 12 42 28 20 23 39 49 31 33 | 31 23 39 43 12 49 7 45 42 20 51 10 40 25 47 3 57 16 34 13 27 55 56 29 2 19 28 9 58 1 32 37 59 52 53 5 22 0 44 24 4 8 41 15 50 6 33 48 14 35 38 11 46 18 21 54 36 17 26 30 34 | 32 22 16 10 33 28 38 3 34 21 7 44 2 14 42 50 12 52 47 18 5 49 31 0 46 8 55 26 20 30 56 1 23 39 25 54 59 36 43 4 17 48 13 6 45 11 57 19 53 9 51 15 40 41 58 27 29 24 35 37 35 | 33 38 21 14 44 22 52 18 32 50 8 55 26 46 16 56 5 47 28 54 30 10 3 17 59 36 34 48 0 53 42 11 2 7 1 57 49 58 12 15 41 51 4 24 20 35 31 9 43 6 23 37 25 45 39 13 19 29 40 27 36 | 34 28 42 49 32 47 22 31 55 16 39 33 23 10 56 21 43 38 52 3 12 59 57 20 14 7 44 2 45 5 50 25 51 58 40 18 46 8 53 13 0 26 27 9 41 1 54 29 30 19 48 4 35 17 36 37 24 6 11 15 37 | 35 41 37 29 48 24 54 40 15 53 27 36 45 58 6 46 19 30 11 59 51 4 9 43 50 57 17 56 25 52 26 39 13 1 20 38 18 44 0 49 55 33 23 42 2 47 8 12 21 31 5 34 3 22 14 7 10 28 32 16 38 | 36 30 46 50 17 54 11 38 48 26 44 15 33 18 53 6 52 24 41 8 21 58 59 22 4 14 35 5 55 0 37 32 56 57 47 9 29 1 51 16 2 13 34 10 43 3 40 42 19 28 45 7 39 25 27 49 31 12 20 23 39 | 37 29 24 15 40 35 45 6 41 27 11 51 4 19 48 43 17 57 53 25 9 54 36 1 39 13 58 20 26 23 59 0 30 46 18 49 56 31 50 2 12 42 8 3 38 7 52 14 47 5 44 10 33 34 55 21 22 16 28 32 40 | 38 33 44 52 21 50 14 55 46 22 56 18 47 32 54 8 59 26 36 16 34 48 53 42 5 28 30 10 57 3 17 49 58 41 51 0 11 2 35 31 7 1 43 23 37 12 15 45 4 39 24 20 29 9 6 40 27 25 13 19 41 | 39 43 49 42 45 31 40 47 23 51 34 27 55 57 12 29 28 19 20 58 56 7 10 52 37 59 25 53 32 41 13 44 16 3 22 24 9 35 2 50 48 15 33 46 5 54 1 21 6 38 0 36 8 11 4 14 18 30 17 26 42 | 40 45 27 19 51 29 57 25 37 43 13 58 20 39 24 59 9 53 35 49 23 15 6 12 56 31 41 42 1 47 48 7 4 11 0 52 54 55 17 10 34 44 2 16 26 28 36 5 50 3 30 32 18 38 46 8 14 22 33 21 43 | 41 35 48 54 37 53 29 36 58 24 46 40 30 15 59 27 50 45 57 6 17 56 52 26 19 11 51 4 38 9 43 18 44 55 33 25 39 13 47 8 1 20 21 5 34 0 49 22 23 14 42 2 28 12 31 32 16 3 7 10 44 | 42 49 47 55 31 34 23 56 28 39 52 12 59 43 32 20 44 7 16 45 57 22 33 58 25 51 10 40 50 27 3 53 38 21 46 13 2 19 14 41 29 9 54 35 18 37 5 36 1 48 8 24 26 4 0 30 17 15 6 11 45 | 43 39 45 40 49 51 42 27 57 31 29 47 19 23 58 34 37 55 59 12 25 53 41 13 28 20 56 7 24 10 52 9 35 48 15 32 44 16 54 1 3 22 6 0 36 2 50 11 33 4 46 5 30 21 38 17 26 8 14 18 46 | 44 52 50 46 55 38 47 54 33 56 36 34 48 59 21 42 30 28 22 57 53 14 18 41 49 58 32 51 17 43 16 35 26 8 11 31 10 39 5 37 45 23 15 29 0 40 3 6 12 24 2 27 1 20 7 4 9 19 25 13 47 | 45 40 51 57 27 43 19 58 39 29 59 25 53 37 49 13 56 20 31 24 41 42 47 48 9 35 23 15 52 6 12 54 55 34 44 1 7 4 28 36 11 0 50 30 32 17 10 38 2 46 16 26 22 5 3 33 21 18 8 14 48 | 46 50 54 48 38 36 33 53 30 44 41 21 58 52 17 22 35 14 26 55 59 11 15 57 32 56 18 47 37 34 8 51 24 6 29 16 5 28 4 43 42 10 40 39 9 49 0 27 3 45 1 31 13 7 2 19 25 23 12 20 49 | 47 55 34 28 56 42 59 32 49 52 16 57 22 44 31 58 10 51 39 50 33 23 12 21 53 38 43 46 3 54 45 14 7 20 2 41 40 48 25 18 36 35 5 26 13 30 27 0 37 8 19 17 9 24 29 1 4 11 15 6 50 | 48 54 53 58 36 41 30 59 35 46 57 17 56 50 37 26 51 11 24 38 52 29 40 55 18 44 15 33 43 21 6 47 45 27 39 8 4 14 19 34 22 5 49 28 25 32 9 31 0 42 13 16 20 2 1 23 12 10 3 7 51 | 49 42 31 23 47 39 55 12 43 34 20 56 7 28 45 52 25 59 51 32 10 40 27 3 44 16 57 22 13 33 58 2 19 29 9 50 53 38 37 5 21 46 1 8 24 14 41 4 54 0 35 18 15 36 48 6 11 26 30 17 52 | 50 46 38 33 54 44 48 21 52 36 22 53 14 30 55 41 32 58 56 17 18 47 34 8 35 26 59 11 16 15 57 5 28 42 10 37 51 24 49 0 6 29 3 1 31 4 43 7 40 2 39 9 23 27 45 12 20 13 19 25 53 | 51 57 43 39 58 45 53 49 40 59 31 41 42 56 27 48 23 35 29 52 47 19 25 34 54 55 37 44 12 50 24 28 20 13 7 36 15 46 9 32 38 30 10 22 1 33 6 3 17 16 4 21 0 26 11 2 5 14 18 8 54 | 52 44 55 47 50 56 46 34 59 38 42 54 28 33 57 36 49 48 58 21 32 51 43 16 30 22 53 14 31 18 41 10 39 45 23 17 35 26 40 3 8 11 12 2 27 5 37 20 15 7 29 0 19 6 24 25 13 1 4 9 55 | 53 58 41 35 59 48 56 37 54 57 24 52 29 51 36 55 15 44 46 43 40 30 17 27 47 45 50 39 6 49 38 19 11 26 4 34 33 42 18 25 31 28 9 20 8 23 21 1 32 13 14 12 5 16 22 0 2 7 10 3 56 | 54 48 36 30 53 46 58 17 50 41 26 59 11 35 38 57 18 56 44 37 15 33 21 6 51 24 52 29 8 40 55 4 14 22 5 43 47 45 32 9 27 39 0 13 16 19 34 2 49 1 28 25 10 31 42 3 7 20 23 12 57 | 55 47 56 59 34 52 28 57 44 42 58 32 51 49 50 16 53 22 38 31 43 46 54 45 10 39 33 23 41 12 21 40 48 36 35 3 14 7 30 27 20 2 37 19 17 25 18 24 5 29 26 13 11 0 8 15 6 9 1 4 58 | 56 59 52 44 57 55 51 50 47 58 38 43 46 53 34 45 33 39 42 41 54 28 32 36 40 48 49 35 21 37 31 30 22 16 14 27 23 29 10 17 24 19 18 11 3 15 12 8 25 26 7 6 2 13 20 5 0 4 9 1 59 | 57 51 58 53 43 59 39 41 56 45 48 49 35 40 52 31 54 42 55 27 37 44 50 24 23 29 47 19 36 25 34 15 46 38 30 12 28 20 33 6 13 7 17 4 21 9 32 26 10 11 22 1 14 3 16 18 8 0 2 5 60 | 58 53 59 56 41 57 35 52 51 48 55 37 44 54 43 24 47 29 45 36 50 39 49 38 15 46 40 30 34 17 27 33 42 31 28 6 19 11 23 21 26 4 32 14 12 18 25 16 9 22 20 8 7 1 13 10 3 5 0 2 61 | 59 56 57 51 52 58 44 43 53 55 45 50 39 47 41 38 40 46 48 34 49 35 37 31 33 42 54 28 27 32 36 23 29 24 19 21 30 22 15 12 16 14 25 7 6 10 17 13 18 20 11 3 4 8 26 9 1 2 5 0 62 | ] 63 | -------------------------------------------------------------------------------- /LINK/GAUSSFACTOR.aplf: -------------------------------------------------------------------------------- 1 | C←GAUSSFACTOR A;⎕IO;P;I;J;U;Q;NOTEST 2 | ⍝ PRODUCES A LIST OF GAUSSIAN PRIMES WHOSE PRODUCT 3 | ⍝ IS AN ASSOCIATE OF THE NONZERO GAUSSIAN INTEGER A. 4 | ⍝ NO RATIONAL PRIME IN THE NORM OF A MAY BE 5 | ⍝ LARGER THAN 10000. 6 | DERR∧/(,A=⌊A),(1≥⍴⍴A),(∨/,A≠0),(×/⍴A)∊1 2 7 | C←0 2⍴0 8 | ⎕IO←1 9 | →(0=⍴P←SSORT ZFACTOR A+.×A←2↑A)/0 10 | DERR 10000>¯1↑P 11 | Q←((2=P[1]),2)⍴1 1 12 | Q←Q,[1]((3=4|P)/P),[1.5]0 13 | NOTEST←1 14 | →(0=⍴P←(1=4|P)/P)/LOOP 15 | I←SFEL U=⌊U←(0⌈P∘.-(⍳⌊(¯1↑P)*0.5)*2)*0.5 16 | Q←Q,[1]⍉(I,I),[0.5]J,-J←⌊(P-I×I)*0.5 17 | LOOP:→(0=⍴Q←(∧/0=Q GAUSSREM(⍴Q)⍴A)⌿Q)/END 18 | C←C,[1]Q 19 | A←⌊A CQUOT CPRODRED Q 20 | →LOOP 21 | END:C←C[⍋C[;2];] 22 | C←C[⍋+/C*2;] 23 | -------------------------------------------------------------------------------- /LINK/GAUSSQUOT.aplf: -------------------------------------------------------------------------------- 1 | C←A GAUSSQUOT B;EPSILON 2 | ⍝ COMPUTES ONE QUOTIENT OF A BY B IN THE 3 | ⍝ EUCLIDEAN DOMAIN OF GAUSSIAN INTEGERS. 4 | EPSILON←0 5 | C←⌊0.5+A CQUOT B 6 | -------------------------------------------------------------------------------- /LINK/GAUSSREM.aplf: -------------------------------------------------------------------------------- 1 | C←A GAUSSREM B;EPSILON 2 | ⍝ COMPUTES ONE REMAINDER OF B DIVIDED BY A IN THE 3 | ⍝ EUCLIDEAN DOMAIN OF GAUSSIAN INTEGERS. 4 | EPSILON←0 5 | C←B CDIFF A CPROD B GAUSSQUOT A 6 | -------------------------------------------------------------------------------- /LINK/GCDV.aplf: -------------------------------------------------------------------------------- 1 | D←GCDV A;M 2 | ⍝ EXERCISE 2.2.22 3 | →(0<⍴A←(A≠0)/A←,A)/LOOP 4 | →D←0 5 | LOOP:A←(A≠0)/A←M,(M←⌊/A)|A←|A 6 | →(1<⍴A)/LOOP 7 | D←(⍳0)⍴A 8 | -------------------------------------------------------------------------------- /LINK/GCDVX.aplf: -------------------------------------------------------------------------------- 1 | D←GCDVX A;I;M;Q;X;S 2 | ⍝ EXERCISE 2.2.23 3 | →(0<⍴A←,A)/NONEMPTY 4 | r←⍳0 5 | →D←0 6 | NONEMPTY:r←(2⍴⍴A)⍴1,(⍴A)⍴0 7 | S←(A<0)/⍳⍴A 8 | r[S;]←-r[S;] 9 | A[S]←-A[S] 10 | LOOP:A←(X←A≠0)/A 11 | r←X⌿r 12 | →(1≥⍴A)/DONE 13 | I←A⍳M←⌊/A 14 | Q←A ZQUOT M 15 | A←M,M|A 16 | r←r[I;],[⎕IO]r-Q∘.×r[I;] 17 | →LOOP 18 | DONE:D←(⍳0)⍴A 19 | r←,r 20 | -------------------------------------------------------------------------------- /LINK/GP8.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 1 2 3 3 | 0 3 2 1 4 | 1 2 3 0 5 | 1 0 3 2 6 | 2 3 0 1 7 | 3 2 1 0 8 | 2 1 0 3 9 | 3 0 1 2 10 | ] 11 | -------------------------------------------------------------------------------- /LINK/GPALLORB.aplf: -------------------------------------------------------------------------------- 1 | B←GPALLORB A;N;x;I;NOTEST;C 2 | ⍝ COMPUTES A SUMMARY OF THE ORBITS OF THE PERMUTATION 3 | ⍝ GROUP GENERATED BY THE ROWS OF THE MATRIX A. 4 | ⍝ THE FIRST ROW OF B GIVES THE LENGTHS OF THE ORBITS. 5 | ⍝ THE SECOND ROW OF B GIVES REPRESENTATIVES. 6 | ⍝ q[I] IS THE FIRST POINT IN THE ORBIT CONTAINING I. 7 | DERR(GPTEST A)∧2=⍴⍴A 8 | q←(N←¯1↑⍴A)⍴¯1 9 | B←2 0⍴0 10 | NOTEST←1 11 | LOOP:→((N+⎕IO)≤I←q⍳¯1)/0 12 | q[C←A GPORBIT I]←I 13 | B←B,I,⍴C 14 | →LOOP 15 | -------------------------------------------------------------------------------- /LINK/GPCYCIN.aplf: -------------------------------------------------------------------------------- 1 | X←N GPCYCIN C;Y;I;D;U 2 | ⍝ CONSTRUCTS THE VECTOR FORM OF THE PERMUTATION OF ⍳N 3 | ⍝ GIVEN AS A PRODUCT OF CYCLES IN THE CHARACTER VECTOR C. 4 | ⍝ THE CYCLES DO NOT NEED TO BE DISJOINT. ORIGIN DEPENDENT. 5 | DERR(1=⍴N)∧N=⌊N←,N 6 | X←⍳N 7 | C←(C≠' ')/C←,C 8 | ⍝ GET THE NEXT CYCLE. 9 | LOOP:→(0=⍴C)/0 10 | D←(I←(C⍳')')+1-⎕IO)↑C 11 | C←I↓C 12 | DERR('('=1↑D)∧')'=¯1↑D 13 | D←¯1↓1↓D 14 | D[(D=',')/⍳⍴D]←' ' 15 | DERR∧/D∊'0123456789 ' 16 | DERR(⍴U)=⍴SSORT U←,⍎D 17 | DERR∧/UD)∧(⍴C)⍴(⍳N)∘.<⍳N 7 | -------------------------------------------------------------------------------- /LINK/GPSGP.aplf: -------------------------------------------------------------------------------- 1 | H←GPSGP X;N;HP;V;VP 2 | ⍝ COMPUTES THE PERMUTATION GROUP GENERATED BY THE 3 | ⍝ ROWS OF THE MATRIX X. VALID FOR DEGREES AT MOST 12. 4 | ⍝ WORKSPACE FULL ERRORS ARE LIKELY FOR DEGREES OVER 7. 5 | DERR(GPTEST X)∧(2=⍴⍴X)∧12≥¯1↑⍴X 6 | N←¯1↑⍴X 7 | H←(N⍴N+1)⊤HP←SSORT(N+1)⊥(⍳N),V←X←⍉X 8 | LOOP:HP←HP,VP←SSORT(~VP∊HP)/VP←,(N+1)⊥X[V;] 9 | H←H,V←(N⍴N+1)⊤VP 10 | →(0≠⍴VP)/LOOP 11 | H←⍉H 12 | -------------------------------------------------------------------------------- /LINK/GPSYMG.aplf: -------------------------------------------------------------------------------- 1 | T←GPSYMG N;V 2 | ⍝ LISTS THE ELEMENTS OF THE SYMMETRIC GROUP ON ⍳N. 3 | DERR∧/(0≤N←''⍴N),(N=⌊N),1=⍴N←,N 4 | →(N>0)/GENERAL 5 | T←1 0⍴0 6 | →0 7 | GENERAL:T←((!N),N-1)⍴GPSYMG N-1 8 | V←,⍉((!N-1),N)⍴(⍳N)-⎕IO 9 | T←V⌽((-V)⌽T),N+⎕IO-1 10 | -------------------------------------------------------------------------------- /LINK/GPTEST.aplf: -------------------------------------------------------------------------------- 1 | T←GPTEST A;M;N;Z 2 | ⍝ CHECKS THAT A IS AN ARRAY OF PERMUTATIONS. 3 | →(~T←∧/(1≤⍴⍴A),,A=⌊A)/0 4 | →(~T←(∧/,A≥⎕IO)∧∧/A<⎕IO+N←¯1↑⍴A)/0 5 | Z←(×/⍴A)⍴0 6 | Z[(,A)+,⍉(N,M)⍴N×(⍳M←×/¯1↓⍴A)-⎕IO]←1 7 | T←∧/Z 8 | -------------------------------------------------------------------------------- /LINK/GRPA2A.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 'APL2ASCII ' 3 | 'ASCII2APL ' 4 | 'DEFINEFNS ' 5 | 'DUMPWS ' 6 | 'GRPA2A ' 7 | 'INSERTFNS ' 8 | 'KEEPUS ' 9 | 'LOADWS ' 10 | 'TFREAD ' 11 | 'TFWRITE ' 12 | '⍙APLNAME ' 13 | '⍙APLVER ' 14 | '⍙A2AVER ' 15 | '⍙ALPHS ' 16 | '⍙ASCII ' 17 | '⍙DEDUBL ' 18 | '⍙DLB ' 19 | '⍙DLTB ' 20 | '⍙DTB ' 21 | '⍙DUMPSUB ' 22 | '⍙EDRANK ' 23 | '⍙EJCASE ' 24 | '⍙FMTVAL ' 25 | '⍙FMTVAR ' 26 | '⍙FNNAME ' 27 | '⍙GENSYM ' 28 | '⍙GETVAL ' 29 | '⍙IFNEST ' 30 | '⍙LJUST ' 31 | '⍙LOADSUB ' 32 | '⍙MATIOTA ' 33 | '⍙MTOV ' 34 | '⍙MUTE ' 35 | '⍙OUT ' 36 | '⍙OVER ' 37 | '⍙PGWID ' 38 | '⍙QUADCASE ' 39 | '⍙QVARS ' 40 | '⍙RJUST ' 41 | '⍙TCNL ' 42 | '⍙TCLF ' 43 | '⍙TELPRINT ' 44 | '⍙TOLOWER ' 45 | '⍙TTABM ' 46 | '⍙TTABX ' 47 | '⍙UNWRAPLNS' 48 | '⍙USLTOAPL ' 49 | '⍙USLTOASC ' 50 | '⍙VTOM ' 51 | '⍙WITHTTM ' 52 | '⍙WITHTTX ' 53 | '⍙WRAPLNS ' 54 | '⍙WSID ' 55 | '⍙XNUMS ' 56 | '∆FV ' 57 | '⍙OPSYS ' 58 | '⍙TFTRANS ' 59 | ] 60 | -------------------------------------------------------------------------------- /LINK/GTCHECK.aplf: -------------------------------------------------------------------------------- 1 | T←GTCHECK G;⎕IO;E;N;M;I;GTABLE;GTIO;GTINV 2 | ⍝ CHECKS WHETHER G IS A GROUP TABLE WITH IDENTITY 3 | ⍝ EQUAL TO THE INDEX ORIGIN. 4 | ⍝ IS G A SQUARE INTEGER MATRIX? 5 | →(∨/(2≠⍴⍴G),(≠/⍴G),,G≠⌊G)/NO 6 | ⍝ THE ORIGIN SHOULD BE SET EQUAL TO ⌊/,G 7 | →(∧/0 1≠E←⌊/,G)/NO 8 | GTIO←⎕IO←E 9 | ⍝ CHECK CLOSURE. 10 | →(∨/,G>M←¯1+⎕IO+N←1↑⍴G)/NO 11 | ⍝ ANY BINARY OPERATION ON ⍳1 IS A GROUP. 12 | →(N=1)/YES 13 | ⍝ CHECK FOR TWO-SIDED IDENTITY. 14 | →(∨/(G[⎕IO;]≠⍳N),G[;⎕IO]≠⍳N)/NO 15 | ⍝ COPY G INTO GTABLE FOR USE IN GTSGP AND 16 | ⍝ SET G TO 1 TO SAVE SPACE. 17 | GTINIT G 18 | G←1 19 | ⍝ TRY TO FIND A GENERATING SET U WITH N≥2*⍴U. 20 | U←⍳0 21 | X←⎕IO=⍳N 22 | LOOP1:→(M+/∨\''''=(B←∨/Z←A=':')⌿A 5 | Z←N↑((N⌊9)⍴2),(0⌈90⌊N+9)⍴1 6 | Z←((' ',[1]'[',Z⌽(3 0⍕(N,1)⍴⍳N),']'),B⌽' ',A),[1]' ' 7 | Z[1,N+2;5]←'∇' 8 | -------------------------------------------------------------------------------- /LINK/LUCASLEHMER.aplf: -------------------------------------------------------------------------------- 1 | T←LUCASLEHMER P;N;S;I 2 | ⍝ EXERCISE 2.5.4 3 | →(1=⍴ZFACTOR P)/PRIME 4 | 'DOMAIN ERROR' 5 | →0 6 | PRIME:N←(,¯1)MPZSUM0(,2)MPZPOWER0 P 7 | S←,4 8 | I←1 9 | LOOP:→(P≤I←I+1)/DONE 10 | S←N MPZREM0(,¯2)MPZSUM0 S MPZPROD0 S 11 | →LOOP 12 | DONE:T←(1=⍴S)∧0=1↑S 13 | -------------------------------------------------------------------------------- /LINK/MAKEBIG.aplf: -------------------------------------------------------------------------------- 1 | NUM MAKEBIG MAXP;⎕IO;N;I;J;C;n 2 | ⍝ CONSTRUCTS THE ARRAYS BIGPRIMES AND BIGINV, 3 | ⍝ WHICH ARE USED IN MPZDET AND WHICH ARE 4 | ⍝ SYSTEM DEPENDENT. BIGPRIMES WILL CONSIST OF 5 | ⍝ THE NUM LARGEST PRIMES NOT EXCEEDING MAXP, 6 | ⍝ WHICH SHOULD BE AN INTEGER WHOSE SQUARE IS 7 | ⍝ REPRESENTABLE EXACTLY ON THE SYSTEM. 8 | ⎕IO←1 9 | N←0 10 | BIGPRIMES←NUM⍴0 11 | MAXP←MAXP+1 12 | LOOP1:→(3>MAXP←MAXP-1)/ERROR 13 | →(1≠⍴ZFACTOR MAXP)/LOOP1 14 | BIGPRIMES[N←N+1]←MAXP 15 | →(NUM>N)/LOOP1 16 | BIGPRIMES←⌽BIGPRIMES 17 | BIGINV←NUM⍴0 18 | I←0 19 | LOOP2:→(NUMSC←×1↑C)/NEG 10 | →((⍴C)>⍴A)/DIVIDE 11 | →(0>SC)/DIVIDE 12 | →((⍴C)<⍴A)/0 13 | →((⍴A)=I←(A≠C)⍳1)/DIVIDE 14 | →(A[I]>C[I])/0 15 | DIVIDE:N←⌊10⍟Q←(1000000⊥|(M←3⌊⍴C)↑C)÷1000000⊥(L←3⌊⍴A)↑A 16 | →(12>T←N+6×((⍴C)-M)-(⍴A)-L)/SMALL 17 | Q←⌊Q×10*T-N+6×R←¯2+⌊T÷6 18 | Q←(SA×SC×,(3⍴1000000)⊤Q),R⍴0 19 | →ADJUST 20 | SMALL:Q←⌊SA×SC×Q×10*T-N 21 | Q←(×Q)×((1+⌊10⍟|Q)⍴1000000)⊤|Q 22 | ADJUST:q←q MPZSUM0 Q 23 | C←C MPZSUM0(-SA)×Q MPZPROD0 A 24 | →LOOP 25 | NEG:C←C MPZSUM0 A 26 | q←q MPZSUM0-SA 27 | -------------------------------------------------------------------------------- /LINK/MPZSGN.aplf: -------------------------------------------------------------------------------- 1 | T←MPZSGN A 2 | ⍝ COMPUTES THE SIGNUM OF A MULTIPLE PRECISION INTEGER 3 | ⍝ GIVEN BY A CHARACTER VECTOR OF DIGITS TO THE BASE 10. 4 | DERR∧/(1≥⍴⍴A),,A∊'0123456789+¯' 5 | →('¯'≠1↑A←,A)/NONNEG 6 | T←¯1 7 | →0 8 | NONNEG:→(∧/A∊'0+')/ZERO 9 | T←1 10 | →0 11 | ZERO:T←0 12 | -------------------------------------------------------------------------------- /LINK/MPZSUM.aplf: -------------------------------------------------------------------------------- 1 | Z←X MPZSUM Y 2 | ⍝ COMPUTES THE SUM OF TWO MULTIPLE PRECISION INTEGERS 3 | ⍝ IN CHARACTER FORM. 4 | Z←MPZFORM(MPZUNF X)MPZSUM0 MPZUNF Y 5 | -------------------------------------------------------------------------------- /LINK/MPZSUM0.aplf: -------------------------------------------------------------------------------- 1 | C←A MPZSUM0 B;M 2 | ⍝ ADDS VECTORS OF DIGITS TO BASE 1E6. 3 | M←-(⍴A←,A)⌈⍴B←,B 4 | C←MPZNRMLZ(M↑A)+M↑B 5 | -------------------------------------------------------------------------------- /LINK/MPZUNF.aplf: -------------------------------------------------------------------------------- 1 | A←MPZUNF X;⎕IO;M;SIGN 2 | ⍝ CONVERTS THE CHARACTER VECTOR OF A MULTIPLE PRECISION 3 | ⍝ INTEGER INTO A VECTOR OF DIGITS TO THE BASE 1E6. 4 | ⎕IO←0 5 | M←∨/'+¯'=1↑X←,X 6 | SIGN←1↑M↑X 7 | DERR∧/(X←M↓X)∊'0123456789' 8 | A←,⍎((7×M)⍴0 1 1 1 1 1 1)\(¯6×M←⌈(⍴X)÷6)↑X 9 | A←(¯1*SIGN='¯')×A 10 | -------------------------------------------------------------------------------- /LINK/MTIMES.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 0 0 0 0 0 3 | 0 1 2 3 4 5 4 | 0 2 4 0 2 4 5 | 0 3 0 3 0 3 6 | 0 4 2 0 4 2 7 | 0 5 4 3 2 1 8 | 0 6 12 0 6 12 9 | 0 7 14 3 10 17 10 | 0 8 16 0 8 16 11 | 0 9 12 3 6 15 12 | 0 10 14 0 10 14 13 | 0 11 16 3 8 13 14 | 0 12 6 0 12 6 15 | 0 13 8 3 16 11 16 | 0 14 10 0 14 10 17 | 0 15 6 3 12 9 18 | 0 16 8 0 16 8 19 | 0 17 10 3 14 7 20 | ] 21 | -------------------------------------------------------------------------------- /LINK/NOCOMS.aplf: -------------------------------------------------------------------------------- 1 | NOCOMS;⎕IO;NL;I;X;A 2 | ⍝ DELETES ALL COMMENTS FROM ALL FUNCTIONS 3 | ⍝ EXCEPT ITSELF. 4 | ⎕IO←1 5 | NL←⎕NL 3 6 | I←0 7 | LOOP:→((1↑⍴NL)0)/POS 4 | Y←1 5 | →0 6 | POS:Y←Y×Y←X POWERR⌊N÷2 7 | →(0=2|N)/0 8 | Y←X×Y 9 | -------------------------------------------------------------------------------- /LINK/PROBLEMS.apla: -------------------------------------------------------------------------------- 1 | ( 2 | '(C) ⎕FC 1 6 .,*0_¯ ' 3 | '(C) ⎕PR 1 1 ' 4 | ) 5 | -------------------------------------------------------------------------------- /LINK/QDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A QDIFF B 2 | ⍝ COMPUTES THE DIFFERENCE OF TWO RATIONAL ARRAYS. 3 | C←A QSUM QNEG B 4 | -------------------------------------------------------------------------------- /LINK/QINV.aplf: -------------------------------------------------------------------------------- 1 | B←QINV A;D 2 | ⍝ COMPUTES THE RECIPROCAL OF A RATIONAL ARRAY. 3 | →NOTEST/BEGIN 4 | A←QNRMLZ A 5 | DERR∧/0≠,1 0/A 6 | BEGIN:B←(⌽A)×D,D←×1 0/A 7 | -------------------------------------------------------------------------------- /LINK/QMATPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A QMATPROD B;⎕IO;X;AX;BX;RR;NOTEST;RA;RB 2 | ⍝ COMPUTES THE MATRIX PRODUCT OF TWO NONSCALAR ARRAYS 3 | ⍝ OF RATIONAL NUMBERS. 4 | ⎕IO←1 5 | NOTEST←0 6 | A←QNRMLZ A 7 | B←QNRMLZ B 8 | DERR∧/2≤(⍴⍴A),⍴⍴B 9 | DERR(⍴A)[¯1+⍴⍴A]=1↑⍴B 10 | C←((RA←¯2↓⍴A),(RB←¯1↓1↓⍴B),2)⍴0 1 11 | X←1=⍳1↑⍴B 12 | RR←((⍴RA)+⍳⍴RB),(⍳⍴RA),⍴⍴C 13 | NOTEST←1 14 | LOOP:AX←RR⍉(RB,RA,2)⍴X/[¯1+⍴⍴A]A 15 | BX←(⍴C)⍴X⌿B 16 | C←C QSUM AX QPROD BX 17 | →(~1↑X←¯1⌽X)/LOOP 18 | -------------------------------------------------------------------------------- /LINK/QNEG.aplf: -------------------------------------------------------------------------------- 1 | B←QNEG A 2 | ⍝ COMPUTES THE NEGATIVE OF A RATIONAL ARRAY. 3 | →NOTEST/BEGIN 4 | A←QNRMLZ A 5 | BEGIN:B←A×(⍴A)⍴¯1 1 6 | -------------------------------------------------------------------------------- /LINK/QNRMLZ.aplf: -------------------------------------------------------------------------------- 1 | B←QNRMLZ A;D;RHO 2 | ⍝ COMPUTES THE STANDARD REPRESENTATION OF AN ARRAY OF 3 | ⍝ RATIONAL NUMBERS EXPRESSED AS QUOTIENTS OF INTEGERS. 4 | ⍝ FOR SCALARS AND ARRAYS OF VECTORS OF LENGTH 1 A 5 | ⍝ DENOMINATOR OF 1 IS ADDED. 6 | →NOTEST/BEGIN 7 | DERR QTEST A 8 | BEGIN:→((0=⍴⍴B)∨1=¯1↑⍴B←A)/ADDDEN 9 | RHO←¯1↓⍴A 10 | D←(((RHO,1)↑A)ZGCD0 D)××D←(RHO,¯1)↑A 11 | B←⌊A÷D,D 12 | →0 13 | ADDDEN:B←A,1 14 | -------------------------------------------------------------------------------- /LINK/QPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A QPOWER B;RHO;RC;I;J;NOTEST 2 | ⍝ COMPUTES THE B-TH POWER OF THE RATIONAL 3 | ⍝ ARRAY A USING THE BINARY POWER ALGORITHM. 4 | NOTEST←0 5 | A←QNRMLZ A 6 | DERR∧/(,B=⌊B),,B≥0 7 | B←((⍴B),1)⍴B 8 | EXPANDV 9 | RC←(×/¯1↓RHO←⍴A),2 10 | A←RC⍴A 11 | C←RC⍴1 1 12 | I←(B>0)/⍳⍴B←,B 13 | NOTEST←1 14 | LOOP:C[J;]←C[J;]QPROD A[J←(2|B[I])/I;] 15 | →(0=⍴I←(B[I]≥2)/I)/END 16 | A[I;]←A[I;]QPROD A[I;] 17 | B[I]←⌊B[I]÷2 18 | →LOOP 19 | END:C←RHO⍴C 20 | -------------------------------------------------------------------------------- /LINK/QPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A QPROD B;NT 2 | ⍝ COMPUTES THE PRODUCT OF TWO RATIONAL ARRAYS. 3 | →NOTEST/BEGIN 4 | A←QNRMLZ A 5 | B←QNRMLZ B 6 | EXPANDV 7 | BEGIN:NT←NOTEST 8 | NOTEST←1 9 | C←QNRMLZ A×B 10 | NOTEST←NT 11 | -------------------------------------------------------------------------------- /LINK/QQUOT.aplf: -------------------------------------------------------------------------------- 1 | C←A QQUOT B 2 | ⍝ COMPUTES THE QUOTIENT OF TWO RATIONAL ARRAYS. 3 | C←A QPROD QINV B 4 | -------------------------------------------------------------------------------- /LINK/QSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A QSUM B;RA;RB;AN;AD;BN;BD;NT 2 | ⍝ COMPUTES THE SUM OF TWO RATIONAL ARRAYS. 3 | →NOTEST/BEGIN 4 | A←QNRMLZ A 5 | B←QNRMLZ B 6 | EXPANDV 7 | BEGIN:RA←¯1↓⍴A 8 | RB←¯1↓⍴B 9 | AN←(RA,1)↑A 10 | AD←(RA,¯1)↑A 11 | BN←(RB,1)↑B 12 | BD←(RB,¯1)↑B 13 | NT←NOTEST 14 | NOTEST←1 15 | C←QNRMLZ((AN×BD)+AD×BN),AD×BD 16 | NOTEST←NT 17 | -------------------------------------------------------------------------------- /LINK/QTEST.aplf: -------------------------------------------------------------------------------- 1 | T←QTEST A 2 | ⍝ CHECKS WHETHER A REPRESENTS AN ARRAY 3 | ⍝ OF RATIONAL NUMBERS. 4 | →(~T←(∧/,A=⌊A)∧(0=⍴⍴A)∨(0<⍴⍴A)∧∨/1 2=¯1↑⍴A)/0 5 | →((0=⍴⍴A)∨1=¯1↑⍴A)/0 6 | T←∧/0≠,0 1/A 7 | -------------------------------------------------------------------------------- /LINK/QUAT.apla: -------------------------------------------------------------------------------- 1 | [ 2 | [ 3 | 1 0 0 0 4 | 0 1 0 0 5 | 0 0 1 0 6 | 0 0 0 1 7 | ] 8 | [ 9 | 0 1 0 0 10 | ¯1 0 0 0 11 | 0 0 0 1 12 | 0 0 ¯1 0 13 | ] 14 | [ 15 | 0 0 1 0 16 | 0 0 0 ¯1 17 | ¯1 0 0 0 18 | 0 1 0 0 19 | ] 20 | [ 21 | 0 0 0 1 22 | 0 0 1 0 23 | 0 ¯1 0 0 24 | ¯1 0 0 0 25 | ] 26 | ] 27 | -------------------------------------------------------------------------------- /LINK/QuadThings.apla: -------------------------------------------------------------------------------- 1 | ( 2 | 'N⎕PP 0 10 ' 3 | 'N⎕IO 0 1 ' 4 | 'N⎕CT 0 1E¯13 ' 5 | 'C⎕FC 1 6 .,*0_¯ ' 6 | 'N⎕RL 0 16807 ' 7 | 'C⎕PR 1 1 ' 8 | 'C⎕LX 1 0 ' 9 | ) 10 | -------------------------------------------------------------------------------- /LINK/RACLEAR.aplf: -------------------------------------------------------------------------------- 1 | RACLEAR;I 2 | ⍝ EXPUNGES THE ARRAY OF STRUCTURE CONSTANTS FOR 3 | ⍝ THE CURRENT R-ALGEBRA. 4 | I←⎕EX'RSC' 5 | -------------------------------------------------------------------------------- /LINK/RADIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A RADIFF B 2 | ⍝ COMPUTES DIFFERENCES IN THE CURRENT R-ALGEBRA. 3 | C←A RASUM-B 4 | -------------------------------------------------------------------------------- /LINK/RAINIT.aplf: -------------------------------------------------------------------------------- 1 | RAINIT A 2 | ⍝ INITIALIZED THE ARRAY OF STRUCTURE CONSTANTS 3 | ⍝ FOR THE CURRENT R-ALGEBRA. 4 | DERR∧/(3=⍴⍴A),(1↓⍴A)=¯1↓⍴A 5 | RSC←A 6 | -------------------------------------------------------------------------------- /LINK/RANEG.aplf: -------------------------------------------------------------------------------- 1 | C←RANEG A 2 | ⍝ COMPUTES NEGATIVES IN THE CURRENT R-ALGEBRA. 3 | C←RANRMLZ-A 4 | -------------------------------------------------------------------------------- /LINK/RANRMLZ.aplf: -------------------------------------------------------------------------------- 1 | C←RANRMLZ A;⎕IO 2 | ⍝ RETURNS THE STANDARD REPRESENTATION OF AN ARRAY 3 | ⍝ OVER THE THE CURRENT R-ALGEBRA. SCALARS AND 4 | ⍝ VECTORS OF LENGTH 1 ARE PADDED WITH ZEROS. 5 | ⎕IO←1 6 | DERR(0=⍴⍴A)∨(1=¯1↑⍴A)∨(1↑⍴RSC)=¯1↑⍴A 7 | C←((⍴A),⍳0=⍴⍴A)⍴A 8 | →((1↑⍴RSC)=¯1↑⍴C)/0 9 | C←((¯1↓⍴C),1↑⍴RSC)↑C 10 | -------------------------------------------------------------------------------- /LINK/RAPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A RAPOWER B;R;RHO;I;J;M 2 | ⍝ COMPUTES THE B-TH POWER OF A IN THE CURRENT 3 | ⍝ R-ALGEBRA. 4 | DERR∧/(,B=⌊B),,B≥0 5 | A←RANRMLZ A 6 | B←((⍴B),1)⍴B 7 | EXPANDV 8 | R←×/¯1↓RHO←⍴A 9 | A←(R,M←¯1↑⍴A)⍴A 10 | C←(⍴A)⍴M↑1 11 | I←(B>0)/⍳⍴B←,B 12 | LOOP:C[J;]←C[J;]RAPROD A[J←(2|B[I])/I;] 13 | →(0=⍴I←(B[I]≥2)/I)/END 14 | A[I;]←A[I;]RAPROD A[I;] 15 | B[I]←⌊B[I]÷2 16 | →LOOP 17 | END:C←RHO⍴C 18 | -------------------------------------------------------------------------------- /LINK/RAPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A RAPROD B;⎕IO;R;RHO;M 2 | ⍝ COMPUTES PRODUCTS IN THE CURRENT R-ALGEBRA. 3 | A←RANRMLZ A 4 | B←RANRMLZ B 5 | EXPANDV 6 | R←×/¯1↓RHO←⍴A 7 | ⎕IO←0 8 | M←¯1↑⍴RSC 9 | A←(R,M×M)⍴2 0 1⍉(M,R,M)⍴A 10 | B←(R,M×M)⍴1 0 2⍉(M,R,M)⍴B 11 | C←A×B 12 | C←RHO⍴C+.×((M×M),M)⍴RSC 13 | -------------------------------------------------------------------------------- /LINK/RASUM.aplf: -------------------------------------------------------------------------------- 1 | C←A RASUM B 2 | ⍝ COMPUTE SUMS IN THE CURRENT R-ALGEBRA. 3 | A←RANRMLZ A 4 | B←RANRMLZ B 5 | EXPANDV 6 | C←A+B 7 | -------------------------------------------------------------------------------- /LINK/RDET.aplf: -------------------------------------------------------------------------------- 1 | D←RDET A;⎕IO;K;M;I;J;X;Y 2 | ⍝ COMPUTES AN APPROXIMATION TO THE DETERMINANT OF 3 | ⍝ THE REAL MATRIX A. 4 | DERR(2=⍴⍴A)∧=/⍴A 5 | D←⎕IO←1 6 | LOOP:→(0=K←1↑⍴A)/0 7 | A←A×(|A)≥EPSILON×M←⌈/,|A 8 | →(M=0)/ZERO 9 | I←(⌈/|A)⍳M 10 | J←(|A[I;])⍳M 11 | D←D×A[I;J]ׯ1*I+J 12 | X←A[I;]÷A[I;J] 13 | A←(I≠⍳K)⌿A 14 | A←(J≠⍳K)/A-A[;J]∘.×X 15 | →LOOP 16 | ZERO:D←0 17 | -------------------------------------------------------------------------------- /LINK/RLSYS.aplf: -------------------------------------------------------------------------------- 1 | C←A RLSYS B;T;X;r;v 2 | ⍝ SOLVES LINEAR SYSTEMS OVER R. PRODUCES AN ARRAY C 3 | ⍝ SUCH THAT A+.×C IS B AND A MATRIX w WHOSE 4 | ⍝ ROWS SPAN THE SOLUTION SPACE OF THE CORRESPONDING 5 | ⍝ HOMOGENEOUS SYSTEM. 6 | DERR∧/(2=⍴⍴A),(1≤⍴⍴B),(1↑⍴A)=1↑⍴B 7 | A←RROWREDUCE A 8 | B←B×(|B)≥EPSILON×⌈/(,|A),,|B←r+.×B 9 | DERR∧/,0=((⍴v),(¯1+⍴⍴B)⍴0)↓B 10 | X←(~T←(¯1↑⍴A)SCHV v)/⍳¯1↑⍴A 11 | w←((⍴X),⍴T)⍴0 12 | w[;X]←X∘.=X 13 | w[;v]←⍉-A[⍳⍴v;X] 14 | C←T⍀((⍴v),1↓⍴B)↑B 15 | -------------------------------------------------------------------------------- /LINK/RMOD.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 0 0 0 3 | 0 1 2 3 4 | 0 0 1 1 5 | 0 1 3 2 6 | 0 1 0 1 7 | 0 0 2 2 8 | 0 1 1 0 9 | 0 0 3 3 10 | ] 11 | -------------------------------------------------------------------------------- /LINK/RROWREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←RROWREDUCE A;IO;I;J;K;L;M;F;X 2 | ⍝ ROW REDUCES THE REAL MATRIX B. PRODUCES r, AN 3 | ⍝ INVERTIBLE REAL MATRIX SUCH THAT B IS r+.×A. 4 | ⍝ THE VECTOR v LISTS THE COLUMNS CONTAINING THE 5 | ⍝ CORNER ENTRIES OF B. 6 | DERR 2=⍴⍴B←A×(|A)≥EPSILON×⌈/,|A 7 | IO←⎕IO 8 | ⎕IO←1 9 | L←¯1↑⍴B 10 | r←(K,K)⍴1,(K←1↑⍴B)⍴0 11 | v←⍳I←J←0 12 | LOOP:→((J≥K)∨L¯1)/DEG 12 | X←(M=DEG)/⍳⍴DEG 13 | J←X[(|V[X;M+1])⍳⌈/|V[X;M+1]] 14 | →(J=1)/OK 15 | A[1,J;;]←A[J,1;;] 16 | D←-D 17 | OK:→(∧/,0=W←1 0↓A[;1;])/ENDLP 18 | Q←(-1 0+⍴U)↑U←W RXQUOT A[1;1;] 19 | R←TRAV((2↑⍴A),¯1↑⍴Q)⍴Q 20 | S←(⍴A)⍴A[1;;] 21 | A←A RXDIFF R RXPROD S 22 | →BACK 23 | ENDLP:D←D RXPROD A[1;1;] 24 | A←1 1 0↓A 25 | →LOOP 26 | ZERO:D←,0 27 | →0 28 | END:D←D RXPROD A[1;1;] 29 | -------------------------------------------------------------------------------- /LINK/RXDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A RXDIFF B 2 | ⍝ COMPUTES THE DIFFERENCE OF TWO ARRAYS OF REAL POLYNOMIALS. 3 | C←A RXSUM-B 4 | -------------------------------------------------------------------------------- /LINK/RXEVAL.aplf: -------------------------------------------------------------------------------- 1 | Y←A RXEVAL B;⎕IO 2 | ⍝ EVALUATES THE REAL POLYNOMIALS IN A AT B. 3 | ⎕IO←0 4 | B←((⍴B),1)⍴B 5 | EXPANDV 6 | B←(¯1↓⍴B)⍴B 7 | Y←+/A×B∘.*⍳¯1↑⍴A 8 | Y←Y×(|Y)≥EPSILON×⌈/,|Y 9 | -------------------------------------------------------------------------------- /LINK/RXFACTOR.aplf: -------------------------------------------------------------------------------- 1 | G←RXFACTOR F;⎕IO;D;TOL;N;GCD;DF;r;s;H;S;ADDH;CENT;DEL;DER;DH;DR;MAX;NEWR;a;A;CLOSE;CNT;I;ND;SQ;S2;U;VAL;X 2 | ⍝ ATTEMPTS TO PRODUCE A LIST OF MONIC REAL 3 | ⍝ IRREDUCIBLE POLYNOMIALS WHOSE PRODUCT IS THE 4 | ⍝ MONIC ASSOCIATE OF A GIVEN POLYNOMIAL. 5 | ⎕IO←0 6 | DERR∧/(1=⍴⍴F),,0I←I-1)/DONE 24 | VAL←((⍴VAL)⍴H[I],0)+(-/CENT×VAL),[0.5]+/CENT×⌽VAL 25 | DER←((⍴DER)⍴DH[I],0)+(-/CENT×DER),[0.5]+/CENT×⌽DER 26 | →EVAL 27 | DONE:X←~TOL≥DR←(ND←+/DER×DER)*0.5 28 | DEL←(X⌿DER×(⍴DER)⍴1 ¯1)÷ND,[0.5]ND←X/ND 29 | DEL←(-/VAL×DEL),[0.5]+/DEL×⌽VAL←X⌿VAL 30 | →CLOSE/NEWTON 31 | MAX←(S2←S×1.415)+(+/X⌿CENT×CENT)*0.5 32 | MAX←(MAX∘.*⍳⍴ADDH)+.×ADDH 33 | NEWR←MAX×S×S÷X/DR 34 | X←(~X)∨X\(NEWR+S2)≥(+/DEL×DEL)*0.5 35 | CENT←(4 1×⍴CENT)⍴0 2 1 2⍉(CENT←X⌿CENT)∘.+SQ×S←S÷2 36 | CLOSE←(8≤CNT)∨(1↑⍴CENT)≤1↑⍴DER 37 | →LOOP 38 | NEWTON:CENT←(X⌿CENT)-DEL 39 | →(∧/,TOL≥|VAL)/CLEANUP 40 | →LOOP 41 | CLEANUP:CENT←(CENT[;1]≥0)⌿CENT 42 | D←⍴F 43 | I←¯1 44 | NEXT:→((1↑⍴CENT)≤I←I+1)/END 45 | A←CENT[I;] 46 | →(A[1]≠0)/COMPLEX 47 | U←(-A[0]),1 48 | →CHECK 49 | COMPLEX:U←(+/A×A),(-2×A[0]),1 50 | CHECK:→(~∧/TOL≥|U RXREM F)/NEXT 51 | G←G,[0]3↑U 52 | F←F RXQUOT U 53 | →CHECK 54 | END:DERR D>⍴F 55 | →(1<⍴F)/AGAIN 56 | G←G×~(|G)≤EPSILON×⌈/,|G 57 | -------------------------------------------------------------------------------- /LINK/RXFCLEAR.aplf: -------------------------------------------------------------------------------- 1 | RXFCLEAR;I 2 | ⍝ EXPUNGES THE VARIABLE RXRT DESCRIBING THE CURRENT 3 | ⍝ QUOTIENT ALGEBRA OF R[X]. 4 | I←⎕EX'RXRT' 5 | -------------------------------------------------------------------------------- /LINK/RXFDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A RXFDIFF B 2 | ⍝ COMPUTES THE DIFFERENCE OF TWO ARRAYS IN THE 3 | ⍝ CURRENT QUOTIENT ALGEBRA OF R[X]. 4 | C←A RXFSUM-B 5 | -------------------------------------------------------------------------------- /LINK/RXFINIT.aplf: -------------------------------------------------------------------------------- 1 | RXFINIT F;⎕IO;D;I 2 | ⍝ INITIALIZES THE CURRENT QUOTIENT ALGEBRA OF R[X]. 3 | ⎕IO←0 4 | DERR 1×⍴⍴F 5 | DERR 1≤D←¯1++/∨\⌽0≠F 6 | RXRT←((D-1),D)⍴-F←(÷F[D])×D↑F 7 | I←0 8 | LOOP:→((D-1)≤I←I+1)/0 9 | RXRT[I;]←(0,¯1↓RXRT[I-1;])-F×RXRT[I-1;D-1] 10 | →LOOP 11 | -------------------------------------------------------------------------------- /LINK/RXFINV.aplf: -------------------------------------------------------------------------------- 1 | r←RXFINV A;s;D;E 2 | ⍝ COMPUTES INVERSES IN THE CURRENT QUOTIENT 3 | ⍝ ALGEBRA OF R[X]. 4 | DERR(¯1↑⍴A)≤E←¯1↑⍴RXRT 5 | →(E=1)/SMALL 6 | D←A RXGCD(-RXRT[⎕IO;]),1 7 | DERR∧/(,D=1),1=¯1↑⍴D 8 | →0 9 | SMALL:r←÷A 10 | -------------------------------------------------------------------------------- /LINK/RXFPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A RXFPOWER B;R;RHO;I;J;M;N;D 2 | ⍝ COMPUTES THE B-TH POWER OF A IN THE CURRENT 3 | ⍝ QUOTIENT OF R[X]. 4 | B←((⍴B),1)⍴B 5 | EXPANDV 6 | DERR(M←¯1↑⍴A)≤N←¯1↑⍴RXRT 7 | R←×/RHO←¯1↓⍴A 8 | A←(R,N)↑(R,M←¯1↑⍴A)⍴A 9 | C←(R,N)⍴N↑1 10 | I←(B>0)/⍳⍴B←,B 11 | LOOP:C[J;]←((⍴J),N)↑C[J;]RXFPROD A[J←(2|B[I])/I;] 12 | →(0=⍴I←(B[I]≥2)/I)/END 13 | A[I;]←((⍴I),N)↑A[I;]RXFPROD A[I;] 14 | B[I]←⌊B[I]÷2 15 | →LOOP 16 | END:D←1⌈⌈/,+/∨\⌽0≠C 17 | C←(RHO,D)⍴(R,D)↑C 18 | -------------------------------------------------------------------------------- /LINK/RXFPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A RXFPROD B;D;E 2 | ⍝ COMPUTES THE PRODUCT OF TWO ARRAYS OVER THE 3 | ⍝ CURRENT QUOTIENT ALGEBRA OF R[X]. 4 | C←A RXPROD B 5 | DERR(D←¯1↑⍴C)≤+/⍴RXRT 6 | →(D≤E←¯1↑⍴RXRT)/0 7 | C←(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑RXRT 8 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 9 | C←((¯1↓⍴C),D)↑C 10 | -------------------------------------------------------------------------------- /LINK/RXFSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A RXFSUM B;D;E 2 | ⍝ COMPUTES THE SUM OF TWO ARRAYS OVER THE CURRENT 3 | ⍝ QUOTIENT ALGEBRA OF R[X]. 4 | D←¯1↑⍴C←A RXSUM B 5 | DERR D≤+/⍴RXRT 6 | →(D≤E←¯1↑⍴RXRT)/0 7 | C←(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑RXRT 8 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 9 | C←((¯1↓⍴C),D)↑C 10 | -------------------------------------------------------------------------------- /LINK/RXGCD.aplf: -------------------------------------------------------------------------------- 1 | C←A RXGCD B;⎕IO;M;U;V;R;RHO;I;Q;T;D;LA;LB;NOTEST;a 2 | ⍝ COMPUTES MONIC GCD'S OF REAL POLYNOMIALS. THE 3 | ⍝ RESULT C IS (r RXPROD A) RXSUM s RXPROD B. 4 | ⎕IO←1 5 | A←A×(|A)≥EPSILON×⌈/,|A 6 | B←B×(|B)≥EPSILON×⌈/,|B 7 | EXPANDV 8 | M←1⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴A),¯1↑⍴A)⍴A 9 | M←M⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴B),¯1↑⍴B)⍴B 10 | R←×/RHO←¯1↓⍴A 11 | NOTEST←1 12 | A←(R,M)⍴(RHO,M)↑A RXPROD LA←(RHO,1)⍴÷RXLEAD A 13 | B←(R,M)⍴(RHO,M)↑B RXPROD LB←(RHO,1)⍴÷RXLEAD B 14 | U←((⍴A)↑(R,1)⍴LA),[1]((⍴A)⍴0),[0.5]A 15 | V←((⍴B)⍴0),[1]((⍴B)↑(R,1)⍴LB),[0.5]B 16 | I←⍳R 17 | LOOP:→(0=⍴I←(∨/V[3;I;]≠0)/I)/END 18 | Q←((⍴I),M)↑U[3;I;]RXQUOT V[3;I;] 19 | T←(3,(⍴I),M)↑U[;I;]RXDIFF V[;I;]RXPROD(3,⍴Q)⍴Q 20 | T[3;;]←T[3;;]×(|T[3;;])≥⍉(⌽1↓⍴T)⍴EPSILON×⌈/|V[3;I;] 21 | T←(⍴T)↑T RXPROD(3,(⍴I),1)⍴÷RXLEAD T[3;;] 22 | U[;I;]←V[;I;] 23 | V[;I;]←T 24 | →LOOP 25 | END:D←1⌈+/∨\⌽∨⌿0≠U[3;;] 26 | C←(RHO,D)⍴(R,D)↑U[3;;] 27 | D←1⌈+/∨\⌽∨⌿0≠U[1;;] 28 | r←(RHO,D)⍴(R,D)↑U[1;;] 29 | D←1⌈+/∨\⌽∨⌿0≠U[2;;] 30 | s←(RHO,D)⍴(R,D)↑U[2;;] 31 | -------------------------------------------------------------------------------- /LINK/RXGCD0.aplf: -------------------------------------------------------------------------------- 1 | C←A RXGCD0 B;M;R;RHO;I;T;D;NOTEST 2 | ⍝ COMPUTES MONIC GCD'S OF REAL POLYNOMIALS WITHOUT 3 | ⍝ EXPRESSING THE RESULT AS A LINEAR COMBINATION 4 | ⍝ OF THE ARGUMENTS. 5 | A←A×(|A)≥EPSILON×⌈/,|A 6 | B←B×(|B)≥EPSILON×⌈/,|B 7 | EXPANDV 8 | M←1⌈+/∨\⌽0≠((×/¯1↓⍴A),¯1↑⍴A)⍴A 9 | M←M⌈+/∨\⌽0≠((×/¯1↓⍴B),¯1↑⍴B)⍴B 10 | I←⍳R←×/RHO←¯1↓⍴A 11 | NOTEST←1 12 | A←(R,M)⍴(RHO,M)↑A RXPROD(RHO,1)⍴÷RXLEAD A 13 | B←(R,M)⍴(RHO,M)↑B RXPROD(RHO,1)⍴÷RXLEAD B 14 | LOOP:→(0=⍴I←(∨/B[I;]≠0)/I)/END 15 | T←((⍴I),M)↑B[I;]RXREM A[I;] 16 | T←T×(|T)≥EPSILON×(⌈/|B[I;])∘.×M⍴1 17 | T←(⍴T)↑T RXPROD((⍴I),1)⍴÷RXLEAD T 18 | A[I;]←B[I;] 19 | B[I;]←T 20 | →LOOP 21 | END:D←1⌈+/∨\⌽∨⌿0≠A 22 | C←(RHO,D)⍴(R,D)↑A 23 | -------------------------------------------------------------------------------- /LINK/RXINTERP.aplf: -------------------------------------------------------------------------------- 1 | C←A RXINTERP B;⎕IO;D 2 | ⍝ INTERPOLATES REAL POLYNOMIALS. THE VECTOR A 3 | ⍝ GIVES THE VALUES OF THE ARGUMENT AND THE VECTORS 4 | ⍝ ALONG THE LAST AXIS OF B GIVE THE VALUES THE 5 | ⍝ POLYNOMIALS ARE TO HAVE. 6 | DERR∧/(1=⍴⍴A),(0<⍴A),(0<⍴⍴B),(⍴A)=¯1↑⍴B 7 | ⎕IO←0 8 | C←B+.×⌹⍉A∘.*⍳⍴A 9 | C←C×(|C)≥EPSILON×⌈/,|C 10 | D←1⌈⌈/,+/∨\⌽0≠C 11 | C←((¯1↓⍴C),D)↑C 12 | -------------------------------------------------------------------------------- /LINK/RXLEAD.aplf: -------------------------------------------------------------------------------- 1 | C←RXLEAD A;⎕IO;D;RHO;I;R 2 | ⍝ COMPUTES THE ARRAY OF LEADING COEFFICIENTS OF AN 3 | ⍝ ARRAY OF REAL POLYNOMIALS. 4 | ⎕IO←0 5 | →(0≠⍴⍴A)/NEXT 6 | A←,A 7 | NEXT:RHO←¯1↓⍴A←A×(|A)≥EPSILON×⌈/,|A 8 | D←,¯1++/∨\⌽0≠A 9 | I←(D≥0)/⍳R←×/RHO 10 | C←R⍴1 11 | C[I]←(,A)[D[I]+(¯1↑⍴A)×I] 12 | C←RHO⍴C 13 | -------------------------------------------------------------------------------- /LINK/RXMATPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A RXMATPROD B;⎕IO;X;AX;BX;RR;D;NOTEST;RA;RB 2 | ⍝ COMPUTES THE MATRIX PRODUCT OF TWO NONSCALAR ARRAYS 3 | ⍝ OF REAL POLYNOMIALS. 4 | ⎕IO←1 5 | DERR∧/2≤(⍴⍴A),⍴⍴B 6 | DERR(⍴A)[¯1+⍴⍴A]=1↑⍴B 7 | C←((RA←¯2↓⍴A),(RB←¯1↓1↓⍴B),1)⍴0 8 | X←1=⍳1↑⍴B 9 | RR←((⍴RA)+⍳⍴RB),(⍳⍴RA),⍴⍴C 10 | NOTEST←1 11 | LOOP:AX←RR⍉(RB,RA,¯1↑⍴A)⍴X/[¯1+⍴⍴A]A 12 | BX←((¯1↓⍴C),¯1↑⍴B)⍴X⌿B 13 | C←C RXSUM AX RXPROD BX 14 | →(~1↑X←¯1⌽X)/LOOP 15 | D←1⌈⌈/,+/∨\⌽0≠C 16 | C←((¯1↓⍴C),D)↑C 17 | -------------------------------------------------------------------------------- /LINK/RXPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A RXPROD B;⎕IO;D 2 | ⍝ COMPUTES THE ENTRY-BY-ENTRY PRODUCT OF TWO ARRAYS 3 | ⍝ OF REAL POLYNOMIALS. 4 | →NOTEST/BEGIN 5 | EXPANDV 6 | BEGIN:⎕IO←0 7 | C←(A∘.×(¯1↑⍴B)⍴1)×((⍳¯1+⍴⍴A),0 ¯1+⍴⍴A)⍉B∘.×(¯1↑⍴A)⍴1 8 | C←C,((⍴A),¯1+¯1↑⍴A)⍴0 9 | C←+/[¯2+⍴⍴C]((⍴A)⍴-⍳¯1↑⍴A)⌽C 10 | C←C×(|C)≥EPSILON×⌈/,|C 11 | D←1⌈⌈/,+/∨\⌽C≠0 12 | C←((¯1↓⍴C),D)↑C 13 | -------------------------------------------------------------------------------- /LINK/RXPRODRED.aplf: -------------------------------------------------------------------------------- 1 | C←RXPRODRED A;⎕IO;RHO;D;E;CC;L;M;NOTEST 2 | ⍝ COMPUTES THE PRODUCT REDUCTION ALONG THE LAST 3 | ⍝ AXIS OF AN ARRAY OF REAL POLYNOMIALS. 4 | →(1≥⍴⍴C←A)/0 5 | ⎕IO←1 6 | L←×/RHO←¯2↓⍴C 7 | C←(L,¯2↑⍴C)⍴C 8 | →(0=(⍴C)[2])/ZERO 9 | NOTEST←1 10 | LOOP:→(1=D←(⍴C)[2])/ONE 11 | CC←((L,E,¯1↑⍴C)↑C)RXPROD(L,(-E←⌊D÷2),¯1↑⍴C)↑C 12 | →(D≠2×E)/ODD 13 | C←CC 14 | →LOOP 15 | ODD:M←(+/∨\⌽∨⌿0≠C[;E+1;])⌈¯1↑⍴CC 16 | C←((L,M)↑C[;E+1;]),[2]((¯1↓⍴CC),M)↑CC 17 | →LOOP 18 | ONE:C←(RHO,¯1↑⍴C)⍴C 19 | →0 20 | ZERO:C←(RHO,1)⍴1 21 | -------------------------------------------------------------------------------- /LINK/RXQUOT.aplf: -------------------------------------------------------------------------------- 1 | C←A RXQUOT B;⎕IO;DB;N;K;L;R;I;F;D;E;RHO 2 | ⍝ COMPUTES QUOTIENTS IN THE EUCLIDEAN DOMAIN 3 | ⍝ OF REAL POLYNOMIALS. THE REMAINDER IS SAVED 4 | ⍝ IN THE GLOBAL VARIABLE a. 5 | ⎕IO←0 6 | EXPANDV 7 | DERR∧/,0≤DB←RXDEGREE B 8 | N←×/RHO←⍴DB 9 | L←K⌈(+/¯1↑⍴A)+⌈/R←(¯1+K←+/¯1↑⍴B)-,DB 10 | B←(-R)⌽(N,K)⍴B 11 | A←(-R)⌽(N,L)↑(N,¯1↑⍴A)⍴A 12 | C←(N,I←1++/L-K)⍴2-2 13 | E←÷B[;K-1] 14 | LOOP:→(0>I←I-1)/END 15 | C[;I]←F←A[;I+K-1]×E 16 | A[;I+⍳K]←A[;I+⍳K]-B×⍉(⌽⍴B)⍴F 17 | →LOOP 18 | END:C←C×(|C)≥EPSILON×⌈/,|C 19 | D←1⌈+/∨\⌽∨⌿C≠0 20 | C←(RHO,D)⍴(N,D)↑C 21 | A←A×(|A)≥EPSILON×⌈/(,|A),,|B 22 | D←1⌈+/∨\⌽∨⌿0≠A←R⌽A 23 | a←(RHO,D)⍴(N,D)↑A 24 | -------------------------------------------------------------------------------- /LINK/RXREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←RXREDUCE A;⎕IO;I;J;K;L;M;N;Q;E;D;Y;Z;U;V;X;a 2 | ⍝ REDUCES A MATRIX OF POLYNOMIALS IN R[X] USING 3 | ⍝ ROW AND COLUMN OPERATIONS. PRODUCES MATRICES r 4 | ⍝ AND s SUCH THAT B IS THE MATRIX PRODUCT OF 5 | ⍝ r, A AND s. 6 | DERR 3=⍴⍴A 7 | B←A×(|A)≥EPSILON×⌈/,|A 8 | ⎕IO←0 9 | r←(K,K,1)⍴1,(K←1↑⍴B)⍴0 10 | s←(L,L,1)⍴1,(L←(⍴B)[1])⍴0 11 | I←¯1 12 | LOOPI:→(∧/¯1=D←,RXDEGREE((I,I←I+1),0)↓B)/CLEANUP 13 | V←I+((2↑⍴B)-I)⊤D⍳⌊/(D≥0)/D 14 | X←B[J←V[0];K←V[1];] 15 | COL:→(∧/¯1=D←RXDEGREE X RXREM B[;K;])/ROW 16 | L←D⍳⌊/(D≥0)/D 17 | Q←B[L;K;]RXQUOT X 18 | E←Q RXPROD B[J;;] 19 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 20 | B[L;;]←B[L;;]-(1↓⍴B)↑E 21 | E←Q RXPROD r[J;;] 22 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 23 | r[L;;]←r[L;;]-(1↓⍴r)↑E 24 | B←B×(|B)≥EPSILON×⌈/,|B 25 | X←B[J←L;K;] 26 | →COL 27 | ROW:→(∧/¯1=D←RXDEGREE X RXREM B[J;;])/GENERAL 28 | M←D⍳⌊/(D≥0)/D 29 | Q←B[J;M;]RXQUOT X 30 | E←Q RXPROD B[;M;] 31 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 32 | B[;M;]←B[;M;]-(⍴B)[0 2]↑E 33 | E←Q RXPROD s[;M;] 34 | S←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 35 | s[;M;]←s[;M;]-(⍴s)[0 2]↑E 36 | B←B×(|B)≥EPSILON×⌈/,|B 37 | X←B[J;K←M;] 38 | →COL 39 | GENERAL:→(∧/¯1=D←,RXDEGREE X RXREM(I,I,0)↓B)/END 40 | V←I+((2↑⍴B)-I)⊤D⍳⌊/(D≥0)/D 41 | Q←B[L←V[0];K;]RXQUOT X 42 | E←Q RXPROD B[J;;] 43 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 44 | B[L;;]←B[L;;]-(1↓⍴B)↑E 45 | E←Q RXPROD r[J;;] 46 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 47 | r[L;;]←r[L;;]-(1↓⍴r)↑E 48 | Q←B[L;M←V[1];]RXQUOT X 49 | E←Q RXPROD B[;K;] 50 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 51 | B[;M;]←B[;M;]-(⍴B)[0 2]↑E 52 | E←Q RXPROD s[;K;] 53 | s←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 54 | s[;M;]←s[;M;]-(⍴s)[0 2]↑E 55 | B←B×(|B)≥EPSILON×⌈/,|B 56 | X←B[J←L;K←M;] 57 | →COL 58 | END:B[I,J;;]←B[J,I;;] 59 | r[I,J;;]←r[J,I;;] 60 | B[;I,K;]←B[;K,I;] 61 | s[;I,K;]←s[;K,I;] 62 | B[I;;]←B[I;;]×U←÷RXLEAD X 63 | r[I;;]←r[I;;]×U 64 | Q←B[Y←(I+1)↓⍳1↑⍴B;I;]RXQUOT B[I;I;] 65 | E←(1 0 2⍉((⍴B)[1],⍴Q)⍴Q)RXPROD((1↑⍴Q),1↓⍴B)⍴B[I;;] 66 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 67 | B[Y;;]←B[Y;;]-((⍴Y),1↓⍴B)↑E 68 | E←(1 0 2⍉((⍴r)[1],⍴Q)⍴Q)RXPROD((1↑⍴Q),1↓⍴r)⍴r[I;;] 69 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 70 | r[Y;;]←r[Y;;]-((⍴Y),1↓⍴r)↑E 71 | Q←B[I;Z←(I+1)↓⍳(⍴B)[1];]RXQUOT B[I;I;] 72 | B[I;Z;]←0 73 | E←(1 0 2⍉((1↑⍴Q),(⍴s)[0 2])⍴s[;I;])RXPROD((1↑⍴s),⍴Q)⍴Q 74 | s←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 75 | s[;Z;]←s[;Z;]-((1↑⍴s),(⍴Z),¯1↑⍴s)↑E 76 | B←B×(|B)≥EPSILON×⌈/,|B 77 | →LOOPI 78 | CLEANUP:D←1⌈+/∨\⌽∨⌿∨⌿0≠B 79 | B←((¯1↓⍴B),D)↑B 80 | D←1⌈+/∨\⌽∨⌿∨⌿0≠r 81 | r←((¯1↓⍴r),D)↑r 82 | D←1⌈+/∨\⌽∨⌿∨⌿0≠s 83 | s←((¯1↓⍴s),D)↑s 84 | -------------------------------------------------------------------------------- /LINK/RXREM.aplf: -------------------------------------------------------------------------------- 1 | C←A RXREM B;a;Q 2 | ⍝ COMPUTES THE REMAINDER OF B MODULO A IN THE 3 | ⍝ EUCLIDEAN DOMAIN OF REAL POLYNOMIALS. 4 | Q←B RXQUOT A 5 | C←a 6 | -------------------------------------------------------------------------------- /LINK/RXROWREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←RXROWREDUCE A;IO;I;J;K;L;C;D;M;a 2 | ⍝ ROW REDUCES A MATRIX OF POLYNOMIALS IN R[X]. 3 | ⍝ PRODUCES AN INVERTIBLE MATRIX r 4 | ⍝ OF POLYNOMIALS SUCH THAT B IS r RXMATPROD A. 5 | ⍝ THE VECTOR v LISTS THE COLUMNS OF THE CORNER 6 | ⍝ ENTRIES OF B. 7 | DERR 3=⍴⍴A 8 | B←A 9 | IO←⎕IO 10 | ⎕IO←1 11 | v←⍳0 12 | r←(K,K,1)⍴1,(K←1↑⍴B)⍴I←J←0 13 | LOOP:→((J≥1↑⍴B)∨(⍴B)[2]0),(N=⌊N),1=⍴N←,N 6 | DERR∧/(,S=⌊S),(,S≥⎕IO),,S<⎕IO+N 7 | →(0<⍴⍴S)/BEGIN 8 | S←,S 9 | BEGIN:A←(N××/RS←¯1↓⍴S)⍴0 10 | S←((×/RS),¯1↑⍴S)⍴S 11 | A[⎕IO+N⊥((×/⍴S)⍴(⍳1↑⍴S)-⎕IO),[⎕IO-0.5],⍉S-⎕IO]←1 12 | A←(RS,N)⍴A 13 | -------------------------------------------------------------------------------- /LINK/SEQREL.aplf: -------------------------------------------------------------------------------- 1 | T←SEQREL E;X;NT 2 | ⍝ TESTS IF E IS THE CHARACTERISTIC MATRIX OF AN 3 | ⍝ EQUIVALENCE RELATION ON ⍳1↑⍴E. E MUST BE A 4 | ⍝ SQUARE LOGICAL MATRIX. 5 | →NOTEST/BEGIN 6 | DERR∧/(2=⍴⍴E),(=/⍴E),,E∊0 1 7 | BEGIN:→(~T←∧/(2⍴⎕IO)⍉E)/0 8 | NT←NOTEST 9 | NOTEST←1 10 | T←∧/,E=X∘.=X←SFEL E 11 | NOTEST←NT 12 | -------------------------------------------------------------------------------- /LINK/SETDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A SETDIFF B 2 | ⍝ EXERCISE 1.1.14 3 | C←(~A∊B)/A 4 | -------------------------------------------------------------------------------- /LINK/SETEQ.aplf: -------------------------------------------------------------------------------- 1 | T←A SETEQ B 2 | ⍝ EXERCISE 1.1.14 3 | T←∧/(A∊B),B∊A 4 | -------------------------------------------------------------------------------- /LINK/SETINT.aplf: -------------------------------------------------------------------------------- 1 | C←A SETINT B 2 | ⍝ EXERCISE 1.1.14 3 | C←(A∊B)/A 4 | -------------------------------------------------------------------------------- /LINK/SETUN.aplf: -------------------------------------------------------------------------------- 1 | C←A SETUN B 2 | ⍝ EXERCISE 1.1.14 3 | C←SSORT A,B 4 | -------------------------------------------------------------------------------- /LINK/SFEL.aplf: -------------------------------------------------------------------------------- 1 | R←SFEL A 2 | ⍝ COMPUTES THE FIRST ELEMENTS IN THE SETS WHOSE 3 | ⍝ CHARACTERISTIC VECTORS ARE IN A. 4 | ⍝ THE SETS MUST BE NONEMPTY. 5 | →NOTEST/BEGIN 6 | DERR(1≤⍴⍴A)∧∧/,∨/A 7 | BEGIN:R←⎕IO++/∧\~A 8 | -------------------------------------------------------------------------------- /LINK/SIEVE.aplf: -------------------------------------------------------------------------------- 1 | P←SIEVE N;⎕IO;Q;N;M 2 | ⎕IO←1 3 | P←⍳0 4 | Q←1↓⍳N 5 | LOOP:→((0=⍴Q)∨N¯1↓W)/W←V[⍋V] 6 | -------------------------------------------------------------------------------- /LINK/SSUB.aplf: -------------------------------------------------------------------------------- 1 | T←K SSUB N;X 2 | ⍝ LISTS ALL K-ELEMENT SUBSETS OF ⍳N. ORIGIN DEPENDENT. 3 | DERR∧/(K≥0),(K≤N),(1=⍴K),(1=⍴N),(N=⌊N←,N),K=⌊K←,K 4 | →(∧/K≠0 1)/GENERAL 5 | T←((K!N),K)⍴⍳N 6 | →0 7 | GENERAL:T←1+(K-1)SSUB N-1 8 | X←,T[;⎕IO]∘.>⍳N-1 9 | T←(X/(⍴X)⍴⍳N-1),T[X/,⍉((N-1),1↑⍴T)⍴⍳1↑⍴T;] 10 | -------------------------------------------------------------------------------- /LINK/TIMES.apla: -------------------------------------------------------------------------------- 1 | [ 2 | 0 0 0 0 0 0 0 0 3 | 0 1 2 3 4 5 6 7 4 | 0 2 0 2 0 2 0 2 5 | 0 3 2 1 4 7 6 5 6 | 0 4 2 6 4 0 6 2 7 | 0 5 0 5 0 5 0 5 8 | 0 6 2 4 4 2 6 0 9 | 0 7 0 7 0 7 0 7 10 | ] 11 | -------------------------------------------------------------------------------- /LINK/TRAV.aplf: -------------------------------------------------------------------------------- 1 | B←TRAV A;R 2 | ⍝ TRANSPOSES AN ARRAY OF VECTORS. 3 | →(1≥⍴⍴A)/SMALL 4 | R←⍳⍴⍴A 5 | B←((⌽¯1↓R),¯1↑R)⍉A 6 | →0 7 | SMALL:B←A 8 | -------------------------------------------------------------------------------- /LINK/XXPOWER.aplf: -------------------------------------------------------------------------------- 1 | G←F XXPOWER N 2 | ⍝ EXERCISE 3.1.26 3 | G←⍳⍴F 4 | LOOP:→(N=0)/0 5 | →(0=2|N)/EVEN 6 | G←G[F] 7 | EVEN:F←F[F] 8 | N←⌊N÷2 9 | →LOOP 10 | -------------------------------------------------------------------------------- /LINK/ZACLEAR.aplf: -------------------------------------------------------------------------------- 1 | ZACLEAR;I 2 | ⍝ EXPUNGES THE ARRAY OF STRUCTURE CONSTANTS FOR 3 | ⍝ THE CURRENT Z-ALGEBRA. 4 | I←⎕EX'ZSC' 5 | -------------------------------------------------------------------------------- /LINK/ZADIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A ZADIFF B 2 | ⍝ COMPUTES DIFFERENCES IN THE CURRENT Z-ALGEBRA. 3 | C←A ZASUM-B 4 | -------------------------------------------------------------------------------- /LINK/ZAINIT.aplf: -------------------------------------------------------------------------------- 1 | ZAINIT A 2 | ⍝ INITIALIZES THE ARRAY OF STRUCTURE CONSTANTS 3 | ⍝ FOR THE CURRENT Z-ALGEBRA. 4 | DERR∧/(3=⍴⍴A),((1↓⍴A)=¯1↓⍴A),,A=⌊A 5 | ZSC←A 6 | -------------------------------------------------------------------------------- /LINK/ZANEG.aplf: -------------------------------------------------------------------------------- 1 | C←ZANEG A 2 | ⍝ COMPUTES NEGATIVES IN THE CURRENT Z-ALGEBRA. 3 | C←ZANRMLZ-A 4 | -------------------------------------------------------------------------------- /LINK/ZANRMLZ.aplf: -------------------------------------------------------------------------------- 1 | C←ZANRMLZ A;⎕IO 2 | ⍝ RETURNS THE STANDARD REPRESENTATION OF AN ARRAY 3 | ⍝ OVER THE THE CURRENT Z-ALGEBRA. SCALARS AND 4 | ⍝ VECTORS OF LENGTH 1 ARE PADDED WITH ZEROS. 5 | ⎕IO←1 6 | DERR∧/(,A=⌊A),(0=⍴⍴A)∨(1=¯1↑⍴A)∨(1↑⍴ZSC)=¯1↑⍴A 7 | C←((⍴A),⍳0=⍴⍴A)⍴A 8 | →((1↑⍴ZSC)=¯1↑⍴C)/0 9 | C←((¯1↓⍴C),1↑⍴ZSC)↑C 10 | -------------------------------------------------------------------------------- /LINK/ZAPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A ZAPOWER B;R;RHO;I;J;M 2 | ⍝ COMPUTES THE B-TH POWER OF A IN THE CURRENT 3 | ⍝ Z-ALGEBRA. 4 | DERR∧/(,B=⌊B),,B≥0 5 | A←ZANRMLZ A 6 | B←((⍴B),1)⍴B 7 | EXPANDV 8 | R←×/¯1↓RHO←⍴A 9 | A←(R,M←¯1↑⍴A)⍴A 10 | C←(⍴A)⍴M↑1 11 | I←(B>0)/⍳⍴B←,B 12 | LOOP:C[J;]←C[J;]ZAPROD A[J←(2|B[I])/I;] 13 | →(0=⍴I←(B[I]≥2)/I)/END 14 | A[I;]←A[I;]ZAPROD A[I;] 15 | B[I]←⌊B[I]÷2 16 | →LOOP 17 | END:C←RHO⍴C 18 | -------------------------------------------------------------------------------- /LINK/ZAPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZAPROD B;⎕IO;R;RHO;M 2 | ⍝ COMPUTES PRODUCTS IN THE CURRENT Z-ALGEBRA. 3 | A←ZANRMLZ A 4 | B←ZANRMLZ B 5 | EXPANDV 6 | R←×/¯1↓RHO←⍴A 7 | ⎕IO←0 8 | M←¯1↑⍴ZSC 9 | A←(R,M×M)⍴2 0 1⍉(M,R,M)⍴A 10 | B←(R,M×M)⍴1 0 2⍉(M,R,M)⍴B 11 | C←A×B 12 | C←RHO⍴C+.×((M×M),M)⍴ZSC 13 | -------------------------------------------------------------------------------- /LINK/ZASUM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZASUM B 2 | ⍝ COMPUTE SUMS IN THE CURRENT Z-ALGEBRA. 3 | A←ZANRMLZ A 4 | B←ZANRMLZ B 5 | EXPANDV 6 | C←A+B 7 | -------------------------------------------------------------------------------- /LINK/ZCHREM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZCHREM B;⎕IO;r;s;RHO;D;L;M;N;B1;B2;A1;F;E;X 2 | ⍝ SOLVES THE SIMULTANEOUS CONGRUENCE C CONGRUENT 3 | ⍝ TO THE I-TH CROSS SECTION OF A ALONG THE LAST AXIS 4 | ⍝ MODULO B[I]. THE VARIABLE B MUST BE A VECTOR AND 5 | ⍝ THE LCM OF THE COMPONENTS OF B IN COMPUTED AS m. 6 | ⎕IO←1 7 | X←∧/(1=⍴⍴B),(1≤⍴⍴A),((¯1↑⍴A)=⍴B),(0<⍴B),,0≠B←|B 8 | DERR∧/X,(,B=⌊B),,A=⌊A 9 | A←((N←×/RHO←¯1↓⍴A),¯1↑⍴A)⍴A 10 | LOOP:→(1=M←⍴B)/END 11 | L←B1×⌊B2÷D←(B1←E↑B)ZGCD B2←(-E←⌊M÷2)↑B 12 | DERR∧/,0=((⍴F)⍴D)|F←((N,-E)↑A)-A1←(N,E)↑A 13 | B←B[X←(E+1)×⍳M≠2×E],L 14 | A←(A[;X]),((⍴F)⍴L)|A1+(⌊F÷(⍴F)⍴D)×(⍴F)⍴r×B1 15 | →LOOP 16 | END:m←B[1] 17 | C←RHO⍴A 18 | -------------------------------------------------------------------------------- /LINK/ZDET.aplf: -------------------------------------------------------------------------------- 1 | D←ZDET A;⎕IO;V;J;W;Q 2 | ⍝ COMPUTES THE DETERMINANT OF AN INTEGER MATRIX 3 | ⍝ USING INTEGER ROW OPERATIONS. 4 | DERR∧/(,A=⌊A),(2=⍴⍴A),=/⍴A 5 | D←⎕IO←1 6 | →(0=1↑⍴A)/0 7 | LOOP:→(1=1↑⍴A)/END 8 | BACK:→(∧/0=V←|A[;1])/ZERO 9 | J←V⍳⌊/(V≠0)/V 10 | →(J=1)/OK 11 | A[1,J;]←A[J,1;] 12 | D←-D 13 | OK:→(∧/0=W←1↓A[;1])/ENDLP 14 | Q←0,(⌊W÷|A[1;1])××A[1;1] 15 | A←A-Q∘.×A[1;] 16 | →BACK 17 | ENDLP:D←D×A[1;1] 18 | A←1 1↓A 19 | →LOOP 20 | ZERO:→D←0 21 | END:D←D×A[1;1] 22 | -------------------------------------------------------------------------------- /LINK/ZFACTOR.aplf: -------------------------------------------------------------------------------- 1 | P←ZFACTOR N;Q;R;⎕IO 2 | ⍝ FACTORS A POSITIVE INTEGER INTO A PRODUCT OF PRIMES. 3 | ⍝ THE RESULT IS CORRECT IF N IS LESS THAN 2.5E9. 4 | DERR∧/(N=⌊N),(1≤N),1=⍴N←,N 5 | P←⍳⎕IO←0 6 | Q←2 3 5,R←,(30×⍳77⌊⌈(N*0.5)÷30)∘.+7 11 13 17 19 23 29 31 7 | LOOP:→(0=⍴Q←(0=Q|N)/Q)/NEXT 8 | P←P,1↑Q 9 | →LOOP,N←⌊N÷Q[0] 10 | NEXT:→(N=1)/0 11 | →((¯1↑R)≥50000⌊N*0.5)/END 12 | →(R[0]≠7)/GEN 13 | R←(∧⌿0≠7 11∘.|R)/R 14 | GEN:Q←R←R+2310 15 | →LOOP 16 | END:P←P,N 17 | -------------------------------------------------------------------------------- /LINK/ZGCD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZGCD B;⎕IO;RHO;M;U;V;I;Q;T 2 | ⍝ C IS RETURNED AS THE ENTRY-BY-ENTRY GCD OF THE INTEGER 3 | ⍝ ARRAYS A AND B. 4 | ⍝ THE VARIABLES r AND s EXPRESS C AS(r×A)+s×B. 5 | ⎕IO←1 6 | →NOTEST/BEGIN 7 | DERR∧/(,A=⌊A),,B=⌊B 8 | ⍝ TEST FOR CONFORMABILITY. 9 | EXPAND 10 | ⍝ REPLACE A AND B BY THEIR RAVELS AND 11 | ⍝ APPLY THE EUCLIDEAN ALGORITHM. 12 | BEGIN:M←×/RHO←⍴A 13 | U←(3,M)⍴(×A),(M⍴0),|A←,A 14 | V←(⍴U)⍴(M⍴0),(×B),|B←,B 15 | I←⍳M 16 | LOOP:→(0=⍴I←(V[3;I]≠0)/I)/END 17 | T←U[;I]-V[;I]×(3,⍴I)⍴⌊U[3;I]÷V[3;I] 18 | U[;I]←V[;I] 19 | V[;I]←T 20 | →LOOP 21 | END:C←RHO⍴U[3;] 22 | r←RHO⍴U[1;] 23 | s←RHO⍴U[2;] 24 | -------------------------------------------------------------------------------- /LINK/ZGCD0.aplf: -------------------------------------------------------------------------------- 1 | C←A ZGCD0 B;RHO;T;I 2 | ⍝ COMPUTES INTEGER GCD'S WITH A MINIMUM AMOUNT OF 3 | ⍝ CHECKING AND WITHOUT EXPRESSING THE RESULT AS A 4 | ⍝ LINEAR COMBINATION OF THE ARGUMENTS. 5 | →NOTEST/BEGIN 6 | DERR∧/(,A=⌊A),,B=⌊B 7 | EXPAND 8 | BEGIN:RHO←⍴A 9 | I←⍳⍴A←|,A 10 | B←|,B 11 | LOOP:→(0=⍴I←(B[I]≠0)/I)/END 12 | T←B[I]|A[I] 13 | A[I]←B[I] 14 | B[I]←T 15 | →LOOP 16 | END:C←RHO⍴A 17 | -------------------------------------------------------------------------------- /LINK/ZLCM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZLCM B 2 | ⍝ COMPUTES THE ENTRY-BY-ENTRY LCM OF THE 3 | ⍝ INTEGER ARRAYS A AND B. 4 | C←(C≠0)×⌊(C←|A×B)÷A ZGCD0 B 5 | -------------------------------------------------------------------------------- /LINK/ZLSYS.aplf: -------------------------------------------------------------------------------- 1 | C←A ZLSYS B;⎕IO;M;D;Q;r;s 2 | ⍝ SOLVES LINEAR SYSTEMS OVER THE INTEGERS. 3 | ⍝ A IS THE MATRIX OF COEFFICIENTS AND THE VECTORS 4 | ⍝ OF CONSTANT TERMS ARE THE VECTORS ALONG THE FIRST 5 | ⍝ AXIS OF B. THE ROWS OF THE GLOBAL ARRAY w 6 | ⍝ ARE A BASIS FOR THE SOLUTIONS OF THE CORRESPONDING 7 | ⍝ HOMOGENEOUS SYSTEM. 8 | ⎕IO←1 9 | DERR∧/(2=⍴⍴A),(,A=⌊A),(,B=⌊B),(1≤⍴⍴B),(1↑⍴A)=1↑⍴B 10 | D←(M←+/D≠0)↑D←1 1⍉A←ZREDUCE A 11 | DERR∧/,0=(M,(¯1+⍴⍴B)⍴0)↓B←r+.×B 12 | w←⍉(0,M)↓s 13 | DERR∧/0=(Q←⍉(⌽⍴B)⍴D)|B←(M,1↓⍴B)↑B 14 | C←(((1↑⍴s),M)↑s)+.×⌊B÷Q 15 | -------------------------------------------------------------------------------- /LINK/ZMATINV.aplf: -------------------------------------------------------------------------------- 1 | C←ZMATINV A;⎕IO;B;r;v 2 | ⍝ COMPUTES THE INVERSE OF THE SQUARE INTEGER 3 | ⍝ MATRIX A, WHICH MUST HAVE DETERMINANT 1 OR ¯1. 4 | DERR∧/(2=⍴⍴A),=/⍴A 5 | ⎕IO←1 6 | B←ZROWREDUCE A 7 | DERR∧/1=1 1⍉B 8 | C←r 9 | -------------------------------------------------------------------------------- /LINK/ZNACLEAR.aplf: -------------------------------------------------------------------------------- 1 | ZNACLEAR;I 2 | ⍝ EXPUNGES THE ARRAY OF STRUCTURE CONSTANTS 3 | ⍝ FOR THE CURRENT ZN-ALGEBRA. 4 | I←⎕EX'ZNSC' 5 | -------------------------------------------------------------------------------- /LINK/ZNADIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNADIFF B 2 | ⍝ COMPUTES DIFFERENCES IN THE CURRENT ZN-ALGEBRA. 3 | C←A ZNASUM-B 4 | -------------------------------------------------------------------------------- /LINK/ZNAINIT.aplf: -------------------------------------------------------------------------------- 1 | ZNAINIT A 2 | ⍝ INITIALIZES THE ARRAY OF STRUCTURE CONSTANTS 3 | ⍝ FOR THE CURRENT ZN-ALGEBRA. 4 | DERR∧/(3=⍴⍴A),((1↓⍴A)=¯1↓⍴A),,A=⌊A 5 | ZNSC←n|A 6 | -------------------------------------------------------------------------------- /LINK/ZNANEG.aplf: -------------------------------------------------------------------------------- 1 | C←ZNANEG A 2 | ⍝ COMPUTES NEGATIVES IN THE CURRENT ZN-ALGEBRA. 3 | C←ZNANRMLZ n|-A 4 | -------------------------------------------------------------------------------- /LINK/ZNANRMLZ.aplf: -------------------------------------------------------------------------------- 1 | C←ZNANRMLZ A;⎕IO 2 | ⍝ RETURNS THE STANDARD REPRESENTATION OF AN ARRAY 3 | ⍝ OVER THE THE CURRENT ZN-ALGEBRA. SCALARS AND 4 | ⍝ VECTORS OF LENGTH 1 ARE PADDED WITH ZEROS. 5 | ⎕IO←1 6 | DERR∧/(,A=⌊A),(0=⍴⍴A)∨(1=¯1↑⍴A)∨(1↑⍴ZNSC)=¯1↑⍴A 7 | C←((⍴A),⍳0=⍴⍴A)⍴n|A 8 | →((1↑⍴ZNSC)=¯1↑⍴C)/0 9 | C←((¯1↓⍴C),1↑⍴ZNSC)↑C 10 | -------------------------------------------------------------------------------- /LINK/ZNAPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNAPOWER B;R;RHO;I;J;M 2 | ⍝ COMPUTES THE B-TH POWER OF A IN THE CURRENT 3 | ⍝ ZN-ALGEBRA. n MUST NOT EXCEED 1E7. 4 | DERR∧/(n≤1000000),(,B=⌊B),,B≥0 5 | A←ZNANRMLZ A 6 | B←((⍴B),1)⍴B 7 | EXPANDV 8 | R←×/¯1↓RHO←⍴A 9 | A←(R,M←¯1↑⍴A)⍴A 10 | C←(⍴A)⍴M↑1 11 | I←(B>0)/⍳⍴B←,B 12 | LOOP:C[J;]←C[J;]ZNAPROD A[J←(2|B[I])/I;] 13 | →(0=⍴I←(B[I]≥2)/I)/END 14 | A[I;]←A[I;]ZNAPROD A[I;] 15 | B[I]←⌊B[I]÷2 16 | →LOOP 17 | END:C←RHO⍴C 18 | -------------------------------------------------------------------------------- /LINK/ZNAPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNAPROD B;⎕IO;R;RHO;M 2 | ⍝ COMPUTES PRODUCTS IN THE CURRENT ZN-ALGEBRA. 3 | ⍝ n MUST NOT EXCEED 1E7. 4 | DERR n≤10000000 5 | A←ZNANRMLZ A 6 | B←ZNANRMLZ B 7 | EXPANDV 8 | R←×/¯1↓RHO←⍴A 9 | ⎕IO←0 10 | M←¯1↑⍴ZNSC 11 | A←(R,M×M)⍴2 0 1⍉(M,R,M)⍴A 12 | B←(R,M×M)⍴1 0 2⍉(M,R,M)⍴B 13 | C←n|A×B 14 | C←RHO⍴n|C+.×((M×M),M)⍴ZNSC 15 | -------------------------------------------------------------------------------- /LINK/ZNASUM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNASUM B 2 | ⍝ COMPUTE SUMS IN THE CURRENT ZN-ALGEBRA. 3 | A←ZNANRMLZ A 4 | B←ZNANRMLZ B 5 | EXPANDV 6 | C←n|A+B 7 | -------------------------------------------------------------------------------- /LINK/ZNDET.aplf: -------------------------------------------------------------------------------- 1 | D←ZNDET A;⎕IO;V;J;W;Q 2 | ⍝ COMPUTES THE DETERMINANT OF AN INTEGER MATRIX 3 | ⍝ USING INTEGER ROW OPERATIONS MODULO n. 4 | DERR∧/(n<10000000),(,A=⌊A),(2=⍴⍴A),=/⍴A←n|A 5 | D←⎕IO←1 6 | →(0=1↑⍴A)/0 7 | LOOP:→(1=1↑⍴A)/END 8 | BACK:→(∧/0=V←A[;1])/ZERO 9 | J←V⍳⌊/(V≠0)/V 10 | →(J=1)/OK 11 | A[1,J;]←A[J,1;] 12 | D←n|-D 13 | OK:→(∧/0=W←1↓A[;1])/ENDLP 14 | Q←0,⌊W÷A[1;1] 15 | A←n|A-Q∘.×A[1;] 16 | →BACK 17 | ENDLP:D←n|D×A[1;1] 18 | A←1 1↓A 19 | →LOOP 20 | ZERO:→D←0 21 | END:D←n|D×A[1;1] 22 | -------------------------------------------------------------------------------- /LINK/ZNDIFF.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNDIFF B 2 | ⍝ COMPUTES THE DIFFERENCE OF A AND B MODULO n. 3 | ⍝ A AND B MUST BE INTEGERS. 4 | →NOTEST/BEGIN 5 | DERR∧/(,A=⌊A),,B=⌊B 6 | BEGIN:C←n|A-B 7 | -------------------------------------------------------------------------------- /LINK/ZNINV.aplf: -------------------------------------------------------------------------------- 1 | B←ZNINV A;r;s;D 2 | ⍝ COMPUTES THE INVERSES OF THE ENTRIES OF A MODULO n. 3 | DERR∧/,1=A ZGCD(⍴A)⍴n 4 | B←n|r 5 | -------------------------------------------------------------------------------- /LINK/ZNLSYS.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNLSYS B;T;X;r;v 2 | ⍝ SOLVES LINEAR SYSTEMS OVER ZN, WHERE n MUST BE 3 | ⍝ PRIME. PRODUCES AN ARRAY C SUCH THAT A+.×C IS 4 | ⍝ B AND A MATRIX w WHOSE ROWS ARE A BASIS FOR THE 5 | ⍝ SOLUTION SPACE OF THE CORRESPONDING HOMOGENEOUS 6 | ⍝ SYSTEM. 7 | DERR∧/(1=⍴ZFACTOR n),(,A=⌊A),(,B=⌊B) 8 | DERR∧/(2=⍴⍴A),(1≤⍴⍴B),(1↑⍴A)=1↑⍴B 9 | A←ZNROWREDUCE A 10 | B←n|r+.×B 11 | DERR∧/,0=((⍴v),(¯1+⍴⍴B)⍴0)↓B 12 | X←(~T←(¯1↑⍴A)SCHV v)/⍳¯1↑⍴A 13 | w←((⍴X),⍴T)⍴0 14 | w[;X]←X∘.=X 15 | w[;v]←⍉n|-A[⍳⍴v;X] 16 | C←T⍀((⍴v),1↓⍴B)↑B 17 | -------------------------------------------------------------------------------- /LINK/ZNMATINV.aplf: -------------------------------------------------------------------------------- 1 | C←ZNMATINV A;⎕IO;B;r;v 2 | ⍝ COMPUTES THE INVERSE OF THE SQUARE INTEGER 3 | ⍝ MATRIX A MODULO n. 4 | DERR∧/(2=⍴⍴A),=/⍴A 5 | ⎕IO←1 6 | B←ZNROWREDUCE A 7 | DERR∧/1=1 1⍉B 8 | C←r 9 | -------------------------------------------------------------------------------- /LINK/ZNMATPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNMATPROD B 2 | ⍝ COMPUTES THE MATRIX PRODUCT OF THE ARRAYS A AND B 3 | ⍝ MODULO n, WHICH IS ASSUMED TO BE LESS THAN 1E7. 4 | →NOTEST/BEGIN 5 | DERR∧/(,A=A←n|A),(,B=⌊B←n|B),n<10000000 6 | BEGIN:C←n|A+.×B 7 | -------------------------------------------------------------------------------- /LINK/ZNNEG.aplf: -------------------------------------------------------------------------------- 1 | B←ZNNEG A 2 | ⍝ COMPUTES THE NEGATIVE OF A MODULO n. 3 | ⍝ A MUST BE AN INTEGER ARRAY. 4 | →NOTEST/BEGIN 5 | DERR∧/,A=⌊A 6 | BEGIN:B←n|-A 7 | -------------------------------------------------------------------------------- /LINK/ZNPOWER.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNPOWER B;RHO;I;J;NOTEST 2 | ⍝ COMPUTES n|A*B USING THE BINARY POWER ALGORITHM. 3 | ⍝ A AND B MUST BE INTEGER ARRAYS AND B≥0. 4 | DERR∧/(,A=⌊A),(B=⌊B),,B≥0 5 | EXPAND 6 | RHO←⍴A 7 | C←(⍴A←,A)⍴1 8 | I←(B>0)/⍳⍴B←,B 9 | NOTEST←1 10 | LOOP:C[J]←C[J]ZNPROD A[J←(2|B[I])/I] 11 | →(0=⍴I←(B[I]≥2)/I)/END 12 | A[I]←A[I]ZNPROD A[I] 13 | B[I]←⌊B[I]÷2 14 | →LOOP 15 | END:C←RHO⍴C 16 | -------------------------------------------------------------------------------- /LINK/ZNPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNPROD B;RHO;D;Q;⎕IO 2 | ⍝ COMPUTES n|A×B USING MULTIPLE PRECISION IF n ≥ 1E7. 3 | →NOTEST/BEGIN 4 | DERR∧/(,A=⌊A←n|A),,B=⌊B←n|B 5 | BEGIN:→(n>10000000)/GEN 6 | C←n|A×B 7 | →0 8 | GEN:EXPAND 9 | RHO←⍴A 10 | ⎕IO←1 11 | D←(Q←3⍴M←1000000)⊤⌊((A←,A)×B←,B)÷n 12 | A←Q⊤A 13 | B←Q⊤B 14 | C←(5 3,1↓⍴A)↑((2 1 3⍉(3⍴1)∘.×A)×(3⍴1)∘.×B)-(Q⊤n)∘.×D 15 | C←+/[2](0 ¯1 ¯2∘.×(1↓⍴A)⍴1)⌽[1]C 16 | LOOP:C[1↓⍳5;]←¯499999+M|D←499999+1 0↓C 17 | C[⍳4;]←(¯1 0↓C)+⌊D÷M 18 | →(∨/,0≠¯3 0↓C)/LOOP 19 | C←n|RHO⍴M⊥2 0↓C 20 | -------------------------------------------------------------------------------- /LINK/ZNROWREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←ZNROWREDUCE A;IO;I;J;K;L;M;X;U;GCD;s;Y;D;NOTEST;R 2 | ⍝ ROW REDUCES A MODULO n, WHICH MUST BE LESS 3 | ⍝ THAN 1E7. PRODUCES r, AN INVERTIBLE MATRIX MODULO n 4 | ⍝ SUCH THAT B IS r ZNMATPROD A, AND A VECTOR v LISTING 5 | ⍝ THE COLUMNS CONTAINING THE 'CORNER ENTRIES' OF B. 6 | DERR∧/(n<10000000),(,A=⌊A),2=⍴⍴A 7 | IO←⎕IO 8 | ⎕IO←NOTEST←1 9 | L←¯1↑⍴B←n|A 10 | R←(K,K)⍴1,(K←1↑⍴B)⍴0 11 | v←⍳I←J←0 12 | LOOP1:→((J≥K)∨Ln*M)/SMALL 19 | U←(1,⍴H)⍴H 20 | LOOPA:→(∧/M=UD←ZNXDEGREE U)/ENDA 21 | I←(M¯1+2×D)/DERR 11 | A←n|(((¯1↓⍴A),D)↑A)+(((-⍴⍴A)↑D)↓A)+.×((E-D),D)↑ZNXRT 12 | OK:A←((RHO←¯1↓⍴A),D)↑A 13 | A←((R←×/RHO),D)⍴A 14 | C←(⍴A)⍴D↑1 15 | I←(B>0)/⍳⍴B←,B 16 | LOOP:C[J;]←((⍴J),D)↑C[J;]ZNXFPROD A[J←(2|B[I])/I;] 17 | →(0=⍴I←(B[I]≥2)/I)/END 18 | A[I;]←((⍴I),D)↑A[I;]ZNXFPROD A[I;] 19 | B[I]←⌊B[I]÷2 20 | →LOOP 21 | END:D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),D)⍴C≠0 22 | C←(RHO,D)⍴(R,D)↑C 23 | -------------------------------------------------------------------------------- /LINK/ZNXFPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXFPROD B;D;E 2 | ⍝ COMPUTE THE PRODUCT OF TWO ARRAYS OVER THE 3 | ⍝ CURRENT QUOTIENT ALGEBRA OF THE RING OF POLYNOMIALS 4 | ⍝ OVER THE INTEGERS MODULO n. 5 | C←n|(n|A)ZXPROD n|B 6 | DERR(D←¯1↑⍴C)≤+/⍴ZNXRT 7 | →(D≤E←¯1↑⍴ZNXRT)/0 8 | C←n|(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑ZNXRT 9 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 10 | C←((¯1↓⍴C),D)↑C 11 | -------------------------------------------------------------------------------- /LINK/ZNXFSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXFSUM B;D;E 2 | ⍝ COMPUTES THE SUM OF TWO ARRAYS OVER THE CURRENT 3 | ⍝ QUOTIENT ALGEBRA OF THE RING OF POLYNOMIALS 4 | ⍝ OVER THE INTEGERS MODULO n. 5 | D←¯1↑⍴C←A ZNXSUM B 6 | DERR D≤+/⍴ZNXRT 7 | →(D≤E←¯1↑⍴ZNXRT)/0 8 | C←n|(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑ZNXRT 9 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 10 | C←((¯1↓⍴C),D)↑C 11 | -------------------------------------------------------------------------------- /LINK/ZNXGCD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXGCD B;⎕IO;M;RHO;F;U;V;I;Q;T;D;LCI;a;R 2 | ⍝ COMPUTES THE GCD OF TWO ARRAYS OF INTEGER 3 | ⍝ POLYNOMIALS MODULO n, WHICH MUST BE A PRIME 4 | ⍝ LESS THAN 1E7. THE RESULT C IS WRITTEN 5 | ⍝ IN THE FORM (r ZNXPROD A) ZNXSUM s ZNXPROD B. 6 | DERR∧/(n<10000000),(1=⍴ZFACTOR n),(,A=⌊A),,B=⌊B 7 | ⎕IO←1 8 | EXPANDV 9 | M←1⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴A),¯1↑⍴A)⍴A←n|A 10 | M←M⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴B),¯1↑⍴B)⍴B←n|B 11 | R←×/RHO←¯1↓⍴A 12 | A←(R,M)⍴(RHO,M)↑A 13 | B←(R,M)⍴(RHO,M)↑B 14 | U←((⍴A)⍴M↑1),[1]((⍴A)⍴0),[0.5]A 15 | V←((⍴B)⍴0),[1]((⍴B)⍴M↑1),[0.5]B 16 | I←⍳R 17 | LOOP:→(0=⍴I←(∨/V[3;I;]≠0)/I)/END 18 | Q←((⍴I),M)↑U[3;I;]ZNXQUOT V[3;I;] 19 | T←(3,(⍴I),M)↑U[;I;]ZNXDIFF V[;I;]ZNXPROD(3,⍴Q)⍴Q 20 | U[;I;]←V[;I;] 21 | V[;I;]←T 22 | →LOOP 23 | END:D←1⌈+/∨\⌽∨⌿0≠U[3;;] 24 | LCI←ZNINV(RHO,1)⍴ZNXLEAD C←(RHO,D)⍴(R,D)↑U[3;;] 25 | C←C ZNXPROD LCI 26 | D←1⌈+/∨\⌽∨⌿0≠U[1;;] 27 | r←LCI ZNXPROD(RHO,D)⍴(R,D)↑U[1;;] 28 | D←1⌈+/∨\⌽∨⌿0≠U[2;;] 29 | s←LCI ZNXPROD(RHO,D)⍴(R,D)↑U[2;;] 30 | -------------------------------------------------------------------------------- /LINK/ZNXGCD0.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXGCD0 B;M;R;RHO;I;T;D;LCI 2 | ⍝ COMPUTES GCD'S OF INTEGER POLYNOMIALS MODULO 3 | ⍝ n WITH A MINIMUM OF CHECKING AND WITHOUT 4 | ⍝ EXPRESSING THE RESULT AS A LINEAR COMBINATION 5 | ⍝ OF THE ARGUMENTS. 6 | DERR∧/(n<10000000),(1=⍴ZFACTOR n),(,A=⌊A),,B=⌊B 7 | EXPANDV 8 | M←1⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴A),¯1↑⍴A)⍴A←n|A 9 | M←M⌈+/∨\⌽∨⌿0≠((×/¯1↓⍴B),¯1↑⍴B)⍴B←n|B 10 | R←×/RHO←¯1↓⍴A 11 | A←(R,M)⍴(RHO,M)↑A 12 | B←(R,M)⍴(RHO,M)↑B 13 | I←⍳R 14 | LOOP:→(0=⍴I←(∨/B[I;]≠0)/I)/END 15 | T←((⍴I),M)↑B[I;]ZNXREM A[I;] 16 | A[I;]←B[I;] 17 | B[I;]←T 18 | →LOOP 19 | END:D←1⌈+/∨\⌽∨⌿0≠A 20 | LCI←ZNINV(RHO,1)⍴ZNXLEAD C←(RHO,D)⍴(R,D)↑A 21 | C←C ZNXPROD LCI 22 | -------------------------------------------------------------------------------- /LINK/ZNXIRRED.aplf: -------------------------------------------------------------------------------- 1 | A←ZNXIRRED M;⎕IO;I;F;J;C 2 | ⍝ COMPUTES A MATRIX LISTING THE MONIC IRREDUCIBLE 3 | ⍝ POLYNOMIALS OF DEGREE AT MOST M OVER THE INTEGERS 4 | ⍝ MODULO n, WHICH MUST BE A PRIME LESS THAN 1E7. 5 | DERR∧/(n<10000000),(1=⍴ZFACTOR n),1≤M 6 | ⎕IO←0 7 | A←(0,M+1)⍴0 8 | I←⍳1↑⍴C←ZNXMONIC M 9 | LOOP:A←A,[0]F←C[J←+/1↑I;] 10 | I←1↓I 11 | →(M<2×ZXDEGREE F)/END 12 | I←(∨/0≠F ZNXREM C[I;])/I 13 | →LOOP 14 | END:A←A,[0]C[I;] 15 | -------------------------------------------------------------------------------- /LINK/ZNXLEAD.aplf: -------------------------------------------------------------------------------- 1 | C←ZNXLEAD A;⎕IO;D;RHO;I;R 2 | ⍝ COMPUTES THE ARRAY OF LEADING COEFFICIENTS OF AN 3 | ⍝ ARRAY OF INTEGER POLYNOMIALS MODULO n. 4 | ⎕IO←0 5 | →NOTEST/BEGIN 6 | DERR∧/,A=⌊A 7 | →(0≠⍴⍴A←n|A)/BEGIN 8 | A←,A 9 | BEGIN:RHO←¯1↓⍴A 10 | D←,¯1++/∨\⌽0≠A 11 | I←(D≥0)/⍳R←×/RHO 12 | C←R⍴1 13 | C[I]←(,A)[D[I]+(¯1↑⍴A)×I] 14 | C←RHO⍴C 15 | -------------------------------------------------------------------------------- /LINK/ZNXMATINV.aplf: -------------------------------------------------------------------------------- 1 | C←ZNXMATINV A;⎕IO;B;r;v 2 | ⍝ COMPUTES THE INVERSE OF A SQUARE MATRIX OVER ZN[X]. 3 | DERR∧/(3=⍴⍴A),=/¯1↓⍴A 4 | ⎕IO←1 5 | B←ZNXROWREDUCE A 6 | DERR∧/,(1 1 2⍉B)=(⍴B)[1 3]⍴(¯1↑⍴B)↑1 7 | C←r 8 | -------------------------------------------------------------------------------- /LINK/ZNXMATPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXMATPROD B;⎕IO;M;X;AX;BX;RR;RA;RB 2 | ⍝ COMPUTES THE MATRIX PRODUCT OF TWO NONSCALAR ARRAYS 3 | ⍝ OF INTEGER POLYNOMIALS MODULO n. 4 | ⎕IO←1 5 | DERR∧/(2≤(⍴⍴A),⍴⍴B),((⍴A)[¯1+⍴⍴A]=M←1↑⍴B) 6 | C←((RA←¯2↓⍴A),(RB←¯1↓1↓⍴B),1)⍴0 7 | X←1=⍳M 8 | RR←((⍴RA)+⍳⍴RB),(⍳⍴RA),⍴⍴C 9 | LOOP:AX←RR⍉(RB,RA,¯1↑⍴A)⍴X/[¯1+⍴⍴A]A 10 | BX←((¯1↓⍴C),¯1↑⍴B)⍴X⌿B 11 | C←C ZNXSUM AX ZNXPROD BX 12 | →(~1↑X←¯1⌽X)/LOOP 13 | -------------------------------------------------------------------------------- /LINK/ZNXMONIC.aplf: -------------------------------------------------------------------------------- 1 | A←ZNXMONIC M;⎕IO;Q;I 2 | ⍝ COMPUTES A MATRIX LISTING THE MONIC POLYNOMIALS 3 | ⍝ OF DEGREE AT MOST M OVER THE INTEGERS MODULO n. 4 | ⎕IO←0 5 | DERR∧/(1=⍴M),(,M=⌊M),,0I←I-1)/END 18 | C[;I]←F←n|A[;I+K-1]×E 19 | A[;I+⍳K]←n|A[;I+⍳K]-B×⍉(⌽⍴B)⍴F 20 | →LOOP 21 | END:D←1⌈⌈/,+/∨\⌽0≠C 22 | C←(RHO,D)⍴(N,D)↑C 23 | D←1⌈⌈/,+/∨\⌽0≠A←R⌽A 24 | a←(RHO,D)⍴(N,D)↑A 25 | -------------------------------------------------------------------------------- /LINK/ZNXREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←ZNXREDUCE A;⎕IO;I;J;K;L;M;N;Q;E;D;Y;Z;U;V;X;a 2 | ⍝ REDUCES A MATRIX OF POLYNOMIALS IN ZN[X] USING 3 | ⍝ ROW AND COLUMN OPERATIONS. PRODUCES MATRICES r 4 | ⍝ AND s SUCH THAT B IS THE MATRIX PRODUCT OF 5 | ⍝ r, A AND s. n MUST BE A PRIME. 6 | DERR∧/(1=⍴ZFACTOR n),(3=⍴⍴A),,A=⌊A 7 | B←n|A 8 | ⎕IO←0 9 | r←(K,K,1)⍴1,(K←1↑⍴B)⍴0 10 | s←(L,L,1)⍴1,(L←(⍴B)[1])⍴0 11 | I←¯1 12 | LOOPI:→(∧/¯1=D←,ZNXDEGREE((I,I←I+1),0)↓B)/CLEANUP 13 | V←I+((2↑⍴B)-I)⊤D⍳⌊/(D≥0)/D 14 | X←B[J←V[0];K←V[1];] 15 | COL:→(∧/¯1=D←ZNXDEGREE X ZNXREM B[;K;])/ROW 16 | L←D⍳⌊/(D≥0)/D 17 | Q←B[L;K;]ZNXQUOT X 18 | E←Q ZNXPROD B[J;;] 19 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 20 | B[L;;]←n|B[L;;]-(1↓⍴B)↑E 21 | E←Q ZNXPROD r[J;;] 22 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 23 | r[L;;]←n|r[L;;]-(1↓⍴r)↑E 24 | X←B[J←L;K;] 25 | →COL 26 | ROW:→(∧/¯1=D←ZNXDEGREE X ZNXREM B[J;;])/GENERAL 27 | M←D⍳⌊/(D≥0)/D 28 | Q←B[J;M;]ZNXQUOT X 29 | E←Q ZNXPROD B[;M;] 30 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 31 | B[;M;]←n|B[;M;]-(⍴B)[0 2]↑E 32 | E←Q ZNXPROD s[;M;] 33 | S←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 34 | s[;M;]←n|s[;M;]-(⍴s)[0 2]↑E 35 | X←B[J;K←M;] 36 | →COL 37 | GENERAL:→(∧/¯1=D←,ZNXDEGREE X ZNXREM(I,I,0)↓B)/END 38 | V←I+((2↑⍴B)-I)⊤D⍳⌊/(D≥0)/D 39 | Q←B[L←V[0];K;]ZNXQUOT X 40 | E←Q ZNXPROD B[J;;] 41 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 42 | B[L;;]←n|B[L;;]-(1↓⍴B)↑E 43 | E←Q ZNXPROD r[J;;] 44 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 45 | r[L;;]←n|r[L;;]-(1↓⍴r)↑E 46 | Q←B[L;M←V[1];]ZNXQUOT X 47 | E←Q ZNXPROD B[;K;] 48 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 49 | B[;M;]←n|B[;M;]-(⍴B)[0 2]↑E 50 | E←Q ZNXPROD s[;K;] 51 | s←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 52 | s[;M;]←n|s[;M;]-(⍴s)[0 2]↑E 53 | X←B[J←L;K←M;] 54 | →COL 55 | END:B[I,J;;]←B[J,I;;] 56 | r[I,J;;]←r[J,I;;] 57 | B[;I,K;]←B[;K,I;] 58 | s[;I,K;]←s[;K,I;] 59 | B[I;;]←n|B[I;;]×U←ZNINV ZNXLEAD X 60 | r[I;;]←n|r[I;;]×U 61 | Q←B[Y←(I+1)↓⍳1↑⍴B;I;]ZNXQUOT B[I;I;] 62 | E←(1 0 2⍉((⍴B)[1],⍴Q)⍴Q)ZNXPROD((1↑⍴Q),1↓⍴B)⍴B[I;;] 63 | B←((¯1↓⍴B),(¯1↑⍴B)⌈¯1↑⍴E)↑B 64 | B[Y;;]←n|B[Y;;]-((⍴Y),1↓⍴B)↑E 65 | E←(1 0 2⍉((⍴r)[1],⍴Q)⍴Q)ZNXPROD((1↑⍴Q),1↓⍴r)⍴r[I;;] 66 | r←((¯1↓⍴r),(¯1↑⍴r)⌈¯1↑⍴E)↑r 67 | r[Y;;]←n|r[Y;;]-((⍴Y),1↓⍴r)↑E 68 | Q←B[I;Z←(I+1)↓⍳(⍴B)[1];]ZNXQUOT B[I;I;] 69 | B[I;Z;]←0 70 | E←(1 0 2⍉((1↑⍴Q),(⍴s)[0 2])⍴s[;I;])ZNXPROD((1↑⍴s),⍴Q)⍴Q 71 | s←((¯1↓⍴s),(¯1↑⍴s)⌈¯1↑⍴E)↑s 72 | s[;Z;]←n|s[;Z;]-((1↑⍴s),(⍴Z),¯1↑⍴s)↑E 73 | →LOOPI 74 | CLEANUP:D←1⌈+/∨\⌽∨⌿∨⌿0≠B 75 | B←((¯1↓⍴B),D)↑B 76 | D←1⌈+/∨\⌽∨⌿∨⌿0≠r 77 | r←((¯1↓⍴r),D)↑r 78 | D←1⌈+/∨\⌽∨⌿∨⌿0≠s 79 | s←((¯1↓⍴s),D)↑s 80 | -------------------------------------------------------------------------------- /LINK/ZNXREM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZNXREM B;a;Q 2 | ⍝ COMPUTES THE REMAINDER OF B MODULO A IN THE 3 | ⍝ EUCLIDEAN DOMAIN OF POLYNOMIALS MOD n, WHICH 4 | ⍝ MUST BE A PRIME SMALLER THAN 1E7. 5 | Q←B ZNXQUOT A 6 | C←a 7 | -------------------------------------------------------------------------------- /LINK/ZNXROWREDUCE.aplf: -------------------------------------------------------------------------------- 1 | B←ZNXROWREDUCE A;IO;I;J;K;L;C;D;M;a 2 | ⍝ ROW REDUCES A MATRIX OF POLYNOMIALS IN ZN[X]. 3 | ⍝ n MUST BE A PRIME. PRODUCES AN INVERTIBLE MATRIX r 4 | ⍝ OF POLYNOMIALS SUCH THAT B IS r ZNXMATPROD A. 5 | ⍝ THE VECTOR v LISTS THE CORNER ENTRIES OF B. 6 | DERR∧/(1=⍴ZFACTOR n),(3=⍴⍴A),,A=⌊A 7 | B←n|A 8 | IO←⎕IO 9 | ⎕IO←1 10 | v←⍳0 11 | r←(K,K,1)⍴1,(K←1↑⍴B)⍴I←J←0 12 | LOOP:→((J≥1↑⍴B)∨(⍴B)[2]0)/⍳⍴B←,B 11 | LOOP:C[J;]←((⍴J),N)↑C[J;]ZXFPROD A[J←(2|B[I])/I;] 12 | →(0=⍴I←(B[I]≥2)/I)/END 13 | A[I;]←A[I;]ZXFPROD A[I;] 14 | B[I]←⌊B[I]÷2 15 | →LOOP 16 | END:D←1⌈⌈/,+/∨\⌽0≠C 17 | C←(RHO,D)⍴(R,D)↑C 18 | -------------------------------------------------------------------------------- /LINK/ZXFPROD.aplf: -------------------------------------------------------------------------------- 1 | C←A ZXFPROD B;D;E 2 | ⍝ COMPUTE THE PRODUCT OF TWO ARRAYS OVER THE 3 | ⍝ CURRENT QUOTIENT ALGEBRA OF Z[X]. 4 | C←A ZXPROD B 5 | DERR(D←¯1↑⍴C)≤+/⍴ZXRT 6 | →(D≤E←¯1↑⍴ZXRT)/0 7 | C←(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑ZXRT 8 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 9 | C←((¯1↓⍴C),D)↑C 10 | -------------------------------------------------------------------------------- /LINK/ZXFSUM.aplf: -------------------------------------------------------------------------------- 1 | C←A ZXFSUM B;D;E 2 | ⍝ COMPUTES THE SUM OF TWO ARRAYS OVER THE CURRENT 3 | ⍝ QUOTIENT ALGEBRA OF Z[X]. 4 | D←¯1↑⍴C←A ZXSUM B 5 | DERR D≤+/⍴ZXRT 6 | →(D≤E←¯1↑⍴ZXRT)/0 7 | C←(((¯1↓⍴C),E)↑C)+(((-⍴⍴C)↑E)↓C)+.×((D-E),E)↑ZXRT 8 | D←1⌈+/∨\⌽∨⌿((×/¯1↓⍴C),E)⍴C≠0 9 | C←((¯1↓⍴C),D)↑C 10 | -------------------------------------------------------------------------------- /LINK/ZXINTERP.aplf: -------------------------------------------------------------------------------- 1 | C←A ZXINTERP B;⎕IO;L;RHO;RC;G;I;M;N;NOTEST;D 2 | ⍝ INTERPOLATES INTEGER POLYNOMIALS. THE VECTOR A 3 | ⍝ GIVES THE INTEGER VALUES OF THE ARGUMENT AND THE 4 | ⍝ VECTORS ALONG THE LAST AXIS OF B GIVE THE INTEGER 5 | ⍝ VALUES WHICH THE POLYNOMIALS ARE TO HAVE. 6 | ⎕IO←1 7 | DERR∧/(1=⍴⍴A),(0<⍴A),(A=⌊A),(,B=⌊B),(0<⍴⍴B),(1↑⍴A)=¯1↑⍴B 8 | RC←×/RHO←¯1↓⍴B 9 | B←(RC,L←⍴A)⍴B 10 | C←(RC,1)⍴B[;1] 11 | G←(-A[1]),1 12 | NOTEST←I←1 13 | LOOP:→(L has written this 3 | Extended Precision workspace. It uses Jim Weigang's 4 | APLASCII Format. This multiprecision workspace is 5 | not quite vendor independent, in that it makes uses of 6 | quad-SIGNAL feature. If your APL does not include this 7 | feature, write change the "#SIGNAL" in the script to 8 | "SIGNAL" and write a SIGNAL function of your own to do 9 | what you think should be done. 10 | 11 | {del} z{<-}d addprec z 12 | [1] @ Add extra digits of precision to z (removing precision not allowed) 13 | [2] {->}(d{<=}0)/0 14 | [3] z{<-}(z[0]-d),(1{drop}z),d{rho}0 15 | {del} 16 | 17 | {<-}base{<-}100000000 18 | 19 | {del} z{<-}binary x 20 | [1] @ Convert a Multiprecision number to bits. 21 | [2] @ The result of chbase must be an integer, not float, so be careful 22 | [3] z{<-}(1073741824,base)chbase x 23 | [4] z{<-}(z{iota}1){drop}z{<-},{transpose}(30{rho}2){represent}z{<-}1{+ 24 | +}{drop}z,z[0]{rho}0 25 | {del} 26 | 27 | {<-}bsqr{<-}10000 28 | 29 | {del} z{<-}b chbase z;base;bsqr 30 | [1] @ Change to radix b[0] from b[1] 31 | [2] 'Invalid radix specification'#SIGNAL(2{/=}{rho}b)/8 32 | [3] {->}(=/b)/0 33 | [4] @ If the new base is less than 32768 then we make base and bsqr the same 34 | [5] {->}(b[0]{>=}32768)/{delta}1 35 | [6] bsqr{<-}base{<-}{floor}b[0] 36 | [7] {->}{delta}2 37 | [8] {delta}1:'Radix not a square'#SIGNAL(0{/=}1|bsqr{<-}(base{<-}b[0])*0.{+ 38 | +}5)/8 39 | [9] bsqr{<-}{floor}bsqr @ Make sure that is an integer 40 | [10] {delta}2:z{<-}b[1]frombase z 41 | {del} 42 | 43 | {del} z{<-}b dec x 44 | [1] @ Similar to primitive Decode ({basevalue}) except 45 | [2] @ left argument represents a single number 46 | [3] @ right argument is a vector of numbers 47 | [4] z{<-}0 0 48 | [5] {delta}1:z{<-}({disclose}x)Fadd b Fmul z 49 | [6] {->}(0{/=}{rho}x{<-}1{drop}x)/{delta}1 50 | {del} 51 | 52 | {del} z{<-}b enc x 53 | [1] @ Similar to primitive Encode ({represent}) except 54 | [2] @ only works on 1 multiprecision number at a time, 55 | [3] @ left argument is a single number, 56 | [4] @ left argument is assumed to repeat as often as required. 57 | [5] z{<-}{zilde} 58 | [6] {delta}1:{->}(b Fgt x)/{delta}2 59 | [7] x{<-}x Idiv b 60 | [8] z{<-}x[1],z 61 | [9] x{<-}{disclose}x 62 | [10] {->}{delta}1 63 | [11] {delta}2:z{<-}({enclose}x),z 64 | {del} 65 | 66 | {del} z{<-}floor z 67 | [1] {->}(z[0]{>=}0)/0 68 | [2] z{<-}0,1{drop}z[0]{drop}z 69 | {del} 70 | 71 | {del} z{<-}b frombase y;a;f;q 72 | [1] @ Converts numbers in radix to base 73 | [2] @ b is a normal integer representing the new radix 74 | [3] {->}(b{/=}base)/{delta}1 75 | [4] z{<-}y & {->}0 @ Result is unchanged if the base is {+ 76 | +}unchanged 77 | [5] {delta}1:z{<-}0 0 @ Got to start somewhere 78 | [6] {->}(base{>=}b)/{delta}2 79 | [7] b{<-}(0,base){represent}b 80 | [8] {delta}2:b{<-}0,b @ Old base in terms of new base 81 | [9] f{<-}0{max}-y[0] & y[0]{<-}0{max}y[0] 82 | [10] y{<-}1{drop}fullint y 83 | [11] {delta}4:{->}(base{>=}q{<-}y[0])/{delta}5 84 | [12] q{<-},(0,base){represent}q 85 | [13] {delta}5:z{<-}(0,q)Fadd b Fmul z @ Next digit 86 | [14] {->}(0{/=}{rho}y{<-}1{drop}y)/{delta}4 87 | [15] {->}(f=0)/0 88 | [16] z{<-}z Fdiv b Fspow f 89 | {del} 90 | 91 | {del} z{<-}fullint z 92 | [1] @ Make a full integer out of z 93 | [2] {->}(0>1{take}z)/0 94 | [3] z{<-}0,(1{drop}z),(1{take}z){rho}0 95 | {del} 96 | 97 | {del} a{<-}scalar a 98 | [1] @ Add a leading zero if a number is a scalar 99 | [2] a{<-}((1={rho}a{<-},a)/0),a 100 | {del} 101 | 102 | {del} z{<-}a ADD b;#IO 103 | [1] @ Multiprecision add, character or numeric input 104 | [2] #IO{<-}0 & z{<-}0 Ffmt{pick}Fadd/Fexec{each}a b 105 | {del} 106 | 107 | {del} z{<-}a DIV b;p;q;r;#IO 108 | [1] @ Multiprecision floating point division, character input 109 | [2] #IO{<-}0 & b{<-}mp.Fexec b 110 | [3] @ Default A is 1, with extra precision 111 | [4] {->}(^/~a{epsilon}#AV)/{delta}3 @ If numeric input {+ 112 | +}then do nothing 113 | [5] @ Allow increased precision in a by means of the Pxx syntax 114 | [6] p{<-}0 & {->}('P'^.{/=}a)/{delta}2 @ No p, so no action 115 | [7] p{<-}(1+r{<-}a{iota}'P'){drop}a & a{<-}r{take}a @ a holds {+ 116 | +}number, p precision 117 | [8] {->}(0{/=}{rho}p{<-}(p{epsilon}#D)/p)/{delta}1 118 | [9] p{<-}0 & {->}{delta}2 @ numbers only 119 | [10] {delta}1:#SIGNAL(2<{rho}p)/16 @ and not too big, or we will {+ 120 | +}soon have WS FULL! 121 | [11] p{<-}{execute}p 122 | [12] {delta}2:a{<-}mp.Fexec a 123 | [13] {->}(p{<=}0)/{delta}3 124 | [14] a[0]{<-}a[0]-p & a{<-}a,p{rho}0 @ Extend precision 125 | [15] {delta}3:z{<-}0 Ffmt a Fdiv b 126 | {del} 127 | 128 | {del} z{<-}a Fadd b;d;m;s 129 | [1] @ Add two multiprecision numbers 130 | [2] a{<-}scalar a & b{<-}scalar b @ Add leading 0 if a scalar 131 | [3] a{<-}a,(0{max}a[0]-b[0]){rho}0 @ Make both 'numbers' the {+ 132 | +}same length 133 | [4] b{<-}b,(0{max}b[0]-a[0]){rho}0 134 | [5] d{<-}a[0]{min}b[0] @ Save the position of the {+ 135 | +}radix point 136 | [6] a{<-}1{drop}a & b{<-}1{drop}b & m{<-}-({rho}a){max}{rho}b 137 | [7] {->}(0{/=}s{<-}{signum}1{take}(z{/=}0)/z{<-}(m{take}a)+m{take}b)/{+ 138 | +}{delta}1 139 | [8] z{<-}0 0 & {->}0 @ Zero value 140 | [9] {delta}1:z{<-}s{times}z @ Make value positive 141 | [10] {delta}2:{->}(0^.=(z{<-}(0,base){represent}z)[0;])/{delta}3 142 | [11] z{<-}(z[0;],0)+0,z[1;] & {->}{delta}2 @ Carry 143 | [12] @ 144 | [13] {delta}3:z{<-}s{times}z[1;] & z{<-}((z{/=}0){iota}1){drop}z @ Sign, {+ 145 | +}then Drop leading zeroes 146 | [14] z{<-}(d+m),(-m{<-}(0{/=}{reverse}z){iota}1){drop}z @ Drop {+ 147 | +}trailing zeroes 148 | {del} 149 | 150 | {del} a{<-}a Fdiv b;d;r 151 | [1] @ Multiprecision floating point divide 152 | [2] a{<-}scalar a & b{<-}scalar b @ Add leading 0 if a scalar 153 | [3] #SIGNAL(0^.=1{drop}b)/11 @ Domain error if divisor is zero 154 | [4] {->}(0^.=1{drop}a)/0 @ Quick quit if result is zero 155 | [5] @ The next line may be considered controversial 156 | [6] a{<-}({neg}1+{rho}b)addprec a @ Increase precision of the {+ 157 | +}dividend 158 | [7] d{<-}a[0],b[0] 159 | [8] a{<-}0,1{drop}a & b{<-}0,1{drop}b 160 | [9] a r{<-}a Idiv b @ Do an integer divide 161 | [10] {->}(b Fgt r Fmul 0 2)/{delta}1 162 | [11] a{<-}a Fadd 0 1 @ Round up if necessary 163 | [12] {delta}1:a{<-}fullint a @ Maintain precision 164 | [13] a[0]{<-}-/d @ Position radix point 165 | {del} 166 | 167 | {del} z{<-}x Fequal y 168 | [1] @ Multiprecision X = Y 169 | [2] z{<-}0^.=x Fsub y 170 | {del} 171 | 172 | {del} x{<-}Fexec x;e;f;i;n;p;p1;p10;q;s 173 | [1] @ Convert character numbers to multiprecision internal format 174 | [2] {->}(~(1{take}x){epsilon}#AV)/0 @ Exit if already {+ 175 | +}numeric 176 | [3] @ For this function the radix must be a power of 10 177 | [4] @ If it isn{'}t then make it 10*8 178 | [5] {->}(p10{<-}0=1|p{<-}10{log}base)/{delta}1 @ Is radix a {+ 179 | +}power of 10? 180 | [6] p{<-}8 @ No. Make it 100,000,000 181 | [7] {delta}1:p1{<-}(p+1){divide}p{<-}{floor}p @ Make p an {+ 182 | +}integer, save (p+1){divide}p 183 | [8] {->}(0=e{<-}+/n{<-}x{epsilon}'Ee')/{delta}2 @ Any E in {+ 184 | +}the number? 185 | [9] #SIGNAL(1{/=}e)/11 @ Domain error if more than one 186 | [10] q{<-}n{iota}1 187 | [11] e{<-}(q+1){drop}x & x{<-}q{take}x 188 | [12] e{<-}('+'=1{take}e){drop}e @ drop leading plus {+ 189 | +}sign from e 190 | [13] @ The exponent must be numeric, with an optional leading minus 191 | [14] #SIGNAL(~^/(e{epsilon}#D){or}({rho}e){take}(1{take}e){epsilon}'{neg}-{+ 192 | +}')/11 193 | [15] e{<-}(e{epsilon}#D,'-{neg}')/e @ Ignore invalid {+ 194 | +}characters 195 | [16] e{<-}{execute}e @ make numeric (crashes {+ 196 | +}if bare minus) 197 | [17] {delta}2:x{<-}(x{epsilon}#D,'.-{neg}')/x @ Ignore {+ 198 | +}invalid characters 199 | [18] x{<-}(s{<-}x[0]{epsilon}'-{neg}'){drop}x @ Negative No.{+ 200 | +} if s=1. Drop minus sign 201 | [19] {->}(0={rho}x)/0 @ Quick quit if null input (= {+ 202 | +}zero) 203 | [20] i{<-}(q{<-}x{iota}'.'){take}x @ Integer part 204 | [21] {->}(0={rho}f{<-}(q+1){drop}x)/{delta}3 @ Fractional part 205 | [22] #SIGNAL(f{or}.='.')/11 @ Only one decimal point allowed 206 | [23] {delta}3:x{<-}{zilde} 207 | [24] {->}(0={rho}i)/{delta}4 208 | [25] x{<-}x,{execute}({reverse}({floor}p1{times}{rho}i){rho}(p+1){take}p{+ 209 | +}{rho}1)\i @ Convert integer part to numerics 210 | [26] {delta}4:{->}(0{/=}{rho}f)/{delta}5 211 | [27] f{<-}{zilde} & {->}{delta}6 212 | [28] {delta}5:f{<-},{execute}((p1{times}{rho}f){rho}(p+1){take}p{rho}1)\f{+ 213 | +}{<-}f,(p|-{rho}f){rho}'0' 214 | [29] {delta}6:{->}(0^.=x{<-}(-{rho}f),1 {neg}1[s]{times}x,f)/0 @ Put it {+ 215 | +}all together, quit if zero 216 | [30] x{<-}(-f{<-}(0{/=}{reverse}x){iota}1){drop}x 217 | [31] f{<-}x[0]+f @ Drop trailing zeroes 218 | [32] x{<-}f,((x{/=}0){iota}1){drop}x{<-}1{drop}x @ Drop {+ 219 | +}leading zeroes 220 | [33] {->}p10/{delta}7 221 | [34] x{<-}(base,100000000)chbase x @ Change to current radix 222 | [35] {delta}7:{->}(1+{signum}e){pick}{delta}8,0,{delta}9 223 | [36] {delta}8:x{<-}x Fmul Fexec'0.',(({neg}1-e){rho}'0'),'1' & {->}{delta}9 224 | [37] {delta}9:x{<-}x Fmul Fexec'1',e{rho}'0' 225 | [38] {delta}9: 226 | {del} 227 | 228 | {del} z{<-}{leftbrace}h{rightbrace}Ffmt a;b;x;k;n;p;s 229 | [1] @ Format a multiprecision number 230 | [2] @ H says How: if not supplied then include spaces every p digits 231 | [3] @ where p is the size of the base, otherwise every h digits. 232 | [4] @ If h is negative use commas instead of spaces. 233 | [5] @ For normal thousand commas, h is {neg}3. 234 | [6] {->}(0=1|p{<-}10{log}base)/{delta}1 @ Radix must be a {+ 235 | +}power of 10 236 | [7] a{<-}(100000000,base)chbase a & p{<-}8 @ so make it one 237 | [8] {delta}1:n{<-}a[0] & a{<-}1{drop}a & p{<-}{floor}p @ Make {+ 238 | +}P integer 239 | [9] a{<-}(-s{<-}(0{/=}{reverse}a){iota}1){drop}a & n+{<-}s @ {+ 240 | +}Drop trailing zeroes 241 | [10] {->}(n{<=}0)/{delta}2 242 | [11] a{<-}a,n{rho}0 & n{<-}0 @ Now put them back if {+ 243 | +}appropriate 244 | [12] {delta}2:{->}(0{/=}s{<-}{signum}1{take}a{<-}((a{/=}0){iota}1){drop}a)/{+ 245 | +}{delta}3 @ Sign 246 | [13] z{<-}'0' & {->}0 @ Exit if 0 247 | [14] {delta}3:a{<-}|a @ Make positive 248 | [15] {->}(n{>=}0)/{delta}4 249 | [16] a{<-}(n{min}-{rho}a){take}a @ Put leading 0s {+ 250 | +}back if appropriate 251 | [17] {delta}4:z{<-},' ',('ZI',{format}p)#FMT a 252 | [18] {->}(n{>=}0)/{delta}5 253 | [19] z[({rho}z)+n{times}p+1]{<-}'.' @ Decimal point 254 | [20] {delta}5:z{<-}(' '=z[0]){drop}z @ Drop leading blank 255 | [21] z{<-}((z{/=}'0'){iota}1){drop}z @ Drop leading {+ 256 | +}zeroes 257 | [22] z{<-}(('.'=z[0])/'0'),z @ .1 {->} 0.1 258 | [23] z{<-}((s<1)/'-'),z @ Negative sign 259 | [24] @ If we have a decimal point, drop trailing zeroes 260 | [25] {->}(~'.'{epsilon}z)/{delta}6 261 | [26] z{<-}(-('0'{/=}{reverse}z){iota}1){drop}z 262 | [27] {delta}6:{->}(0=#NC'h')/0 @ If H not supplied then {+ 263 | +}quit 264 | [28] {->}(h=p{times}1 {neg}1)/0,{delta}8 @ We already {+ 265 | +}have spaces every P digits! 266 | [29] z{<-}z~' ' @ Get rid of all spaces 267 | [30] {->}(0=k{<-}|h)/0 @ Exit if H=0 268 | [31] n{<-}z{iota}'.' @ Where is the decimal {+ 269 | +}point? 270 | [32] s{<-}{reverse}({floor}n{times}b{<-}(k+1){divide}k){rho}c{<-}(k{rho}1){+ 271 | +},0 @ For numbers before the decimal point 272 | [33] {->}(n={rho}z)/{delta}7 @ No decimal point 273 | [34] s{<-}s,1,({floor}(({rho}z)-n+1){times}b){rho}c @ Numbers {+ 274 | +}after the decimal point 275 | [35] {delta}7:z{<-}s\z @ Space out as required 276 | [36] z{<-}(' '=z[0]){drop}z @ Drop resulting leading {+ 277 | +}blank 278 | [37] z{<-}(-' '={neg}1{take}z){drop}z @ ... and {+ 279 | +}trailing blank 280 | [38] {->}('- '{or}.{/=}2{take}z)/{delta}8 @ blank {+ 281 | +}between - and number? 282 | [39] z{<-}'-',2{drop}z @ Yes: get rid of the blank 283 | [40] {delta}8:{->}(h{>=}0)/0 284 | [41] z[(z=' ')/{iota}{rho}z]{<-}',' @ Commas, if H was {+ 285 | +}negative 286 | {del} 287 | 288 | {del} z{<-}x Fgt y 289 | [1] @ Multiprecision X > Y 290 | [2] @ Can be used for all the ordering functions, as follows: 291 | [3] @ For X=}Y use ~Y gt X 294 | [6] z{<-}0{or}.>1{drop}y Fsub x 295 | {del} 296 | 297 | {del} z{<-}a Fmul b;da;db;noconv;s;sa;sb 298 | [1] @ Multiply two numeric multiprecision numbers 299 | [2] a{<-}scalar a & b{<-}scalar b @ Add leading 0 if a scalar 300 | [3] da{<-}a[0] & db{<-}b[0] @ Decimal places 301 | [4] sa{<-}{signum}1{take}a{<-}((a{/=}0){iota}1){drop}a{<-}1{drop}a {+ 302 | +}@ Sign of A 303 | [5] sb{<-}{signum}1{take}b{<-}((b{/=}0){iota}1){drop}b{<-}1{drop}b {+ 304 | +}@ Sign of b 305 | [6] {->}(0{/=}s{<-}sa{times}sb)/{delta}1 @ Sign of the result 306 | [7] z{<-}0 0 & {->}0 @ Quick quit if result is zero 307 | [8] {delta}1:a{<-}|a & b{<-}|b @ Make numbers positive 308 | [9] {->}(({rho}b){>=}{rho}a)/{delta}2 309 | [10] a b{<-}b a @ Prevent avoidable WS FULL 310 | [11] {delta}2:{->}(noconv{<-}base=bsqr)/{delta}3 311 | [12] a{<-},{transpose}(0,bsqr){represent}|a @ Prevent overflow 312 | [13] b{<-},{transpose}(0,bsqr){represent}|b 313 | [14] {delta}3:z{<-}+{slashbar}(-1+{iota}1{take}{rho}z){rotate}z,(2{rho}1{+ 314 | +}{take}{rho}z{<-}a{jot}.{times}b){rho}0 @ Raw result 315 | [15] @ Refine result by 'carrying' 316 | [16] {delta}4:{->}((a{<-}(0,bsqr){represent}z)[0;]^.=0)/{delta}5 317 | [17] z{<-}(a[0;],0)+0,a[1;] 318 | [18] {->}{delta}4 319 | [19] {delta}5:{->}noconv/{delta}6 320 | [20] z{<-}((2|{rho}z){rho}0),z @ Make Z an even number of {+ 321 | +}elements 322 | [21] z{<-}(0,bsqr){basevalue}{transpose}((0.5{times}{rho}z),2){rho}z @ {+ 323 | +}Get Z back to full size 324 | [22] {delta}6:z{<-}s{times}((z{/=}0){iota}1){drop}z @ Drop {+ 325 | +}leading zeroes, get sign right 326 | [23] da{<-}da+db @ Number of 'decimals' 327 | [24] z{<-}(-db{<-}(0{/=}{reverse}z){iota}1){drop}z @ Drop {+ 328 | +}trailing zeros 329 | [25] z{<-}(da+db),z @ Prepend number of decimals 330 | {del} 331 | 332 | {del} z{<-}m Fspow x;i;n;q;rem 333 | [1] @ This function raises multiprecision to the power of scalar 334 | [2] @ for small values of x (otherwise we get WS FULL, and other rubbish) 335 | [3] @ For the method see Ribenboim [1988] p.38 336 | [4] {->}(2{/=}{rho},x)/{delta}1 337 | [5] {->}(0{/=}1{take}x)/{delta}1 338 | [6] x{<-}x[1] @ Allow small M.P.integers 339 | [7] {delta}1:#SIGNAL((^/x{epsilon}#AV){or}1{/=}{rho},x)/11 @ Correct {+ 340 | +}domain for X 341 | [8] #SIGNAL(x{<=}0)/11 @ Must be strictly positive 342 | [9] z{<-}m @ Start value for result 343 | [10] {->}(1={rho}n{<-}(({ceiling}2{log}1+x){rho}2){represent}x)/0 344 | [11] i{<-}1 345 | [12] {delta}2:z{<-}z Fmul z 346 | [13] {->}(~n[i])/{delta}3 347 | [14] z{<-}z Fmul m 348 | [15] {delta}3:{->}(({rho}n)>i{<-}i+1)/{delta}2 349 | {del} 350 | 351 | {del} z{<-}Fsqrt a;b;d;r 352 | [1] @ Multiprecision floating point square root 353 | [2] a{<-}scalar a @ Add leading 0 if a scalar 354 | [3] #SIGNAL(0^.>a)/11 @ Domain error if argument is negative 355 | [4] {->}(0{or}.{/=}1{drop}a)/{delta}1 @ Is source number {+ 356 | +}zero? 357 | [5] z{<-}0 0 & {->}0 @ Quick quit if result is zero 358 | [6] {delta}1:{->}(~2|d{<-}a[0])/{delta}2 @ Save radix places 359 | [7] d{<-}d-1 & a{<-}a,0 @ No. of radix places must be even 360 | [8] {delta}2:z r{<-}Isqrt 0,1{drop}a @ Integer square root 361 | [9] {->}(~r Fgt z)/{delta}4 362 | [10] z{<-}z Fadd 0 1 @ Round up if necessary 363 | [11] {delta}4:z[0]+{<-}{floor}0.5{times}d @ Position radix {+ 364 | +}point 365 | {del} 366 | 367 | {del} z{<-}a Fsub b 368 | [1] @ Multiprecision subtraction 369 | [2] z{<-}a Fadd(1{take}b),-1{drop}b{<-}scalar b 370 | {del} 371 | 372 | {del} z{<-}FSQRT x;#IO 373 | [1] #IO{<-}0 & z{<-}0 Ffmt Fsqrt Fexec x 374 | {del} 375 | 376 | {del} z{<-}a Gcd b 377 | [1] @ Euclid's algorithm for the gcd of 2 numbers 378 | [2] {->}(1^.=({rho}a),{rho}b)/{delta}2 @ Quick method if both {+ 379 | +}scalars 380 | [3] {execute}(b Fgt a)/'a b{<-}b a' 381 | [4] {delta}1:{->}(0 1 Fequal z{<-}a Imod b)/0 382 | [5] {execute}(0 0 Fequal z)/'z{<-}b & {->}0' 383 | [6] {execute}(0 Fgt z)/'z{<-}z Fadd b' 384 | [7] a{<-}b & b{<-}z & {->}{delta}1 385 | [8] @ 386 | [9] {delta}2:{execute}(b>a)/'a b{<-}b a' 387 | [10] {delta}3:{->}(1=z{<-}b|a)/0 388 | [11] {execute}(0=z)/'z{<-}b & {->}0' 389 | [12] {execute}(0>z)/'z{<-}z+b' 390 | [13] a{<-}b & b{<-}z & {->}{delta}3 391 | {del} 392 | 393 | {<-}HALF{<-}{neg}6 50000000 0 0 0 0 0 394 | 395 | {del} c{<-}a Idiv b;af;bf;j;q;qf;q1;r;r1;s;t 396 | [1] @ Multiprecision integer divide with remainder 397 | [2] @ Produces quotient {&} remainder in c 398 | [3] a{<-}scalar a & b{<-}scalar b @ Add leading 0 if a scalar 399 | [4] #SIGNAL(0{or}.>a[0],b[0])/11 @ Domain error if not integer 400 | [5] #SIGNAL(0^.=1{drop}b)/11 @ Domain error if divisor is zero 401 | [6] {->}(0{or}.{/=}1{drop}a)/{delta}1 402 | [7] c{<-}(0 0)(0 0) & {->}0 @ Quick quit if result is zero 403 | [8] {delta}1:s{<-}1 {neg}1[(a{or}.<0){/=}b{or}.<0] @ Sign of result 404 | [9] a{<-}fullint|a & b{<-}fullint|b 405 | [10] {->}(2{/=}{rho}b)/{delta}3 @ Code for speed if B {+ 406 | +}is scalar 407 | [11] {->}c{<-}(2{times}(b{<-}1{drop}b)=1{take}r{<-}0,1{take}a){rho}0 408 | [12] {delta}2:c{<-}c,q{<-}{floor}(t{<-}base{basevalue}r,1{take}a){divide}b 409 | [13] r{<-}0,t-q{times}b & {->}(0<{rho}a{<-}1{drop}a)/{delta}2 410 | [14] c{<-}c Fadd 0 & {->}{delta}99 @ ... and tidied up 411 | [15] @ B is not scalar. 412 | [16] {delta}3:r{<-}a & c{<-}0 0 @ Start by creating remainder 413 | [17] bf{<-}b[1]+b[2]{divide}base @ Floating point divisor 414 | [18] {delta}4:{->}(b Fgt r)/{delta}99 @ If b>r then we are done 415 | [19] {delta}5:af{<-}r[1] 416 | [20] {->}(2{>=}{rho}r)/{delta}6 417 | [21] af{<-}af+r[2]{divide}base 418 | [22] {delta}6:q{<-}{floor}qf{<-}af{divide}bf & j{<-}0 @ Q is the {+ 419 | +}provisional quotient 420 | [23] {->}(1{/=}qf)/{delta}7 421 | [24] q{<-}r Fgt({rho}r){take}b @ Get more accurate result {+ 422 | +}if =1 423 | [25] {delta}7:{->}(0{/=}q)/{delta}8 424 | [26] q{<-}{floor}qf{<-}qf{times}base & j{<-}1 @ if Q=0 shift 1 {+ 425 | +}place right 426 | [27] {delta}8:r1{<-}r Fsub b Fmul q1{<-}(2+({rho}r)-j+{rho}b){take}q1{<-}0,{+ 427 | +}{floor}q 428 | [28] {->}(~0 Fgt r1)/{delta}9 429 | [29] q{<-}q-1 & {->}{delta}8 430 | [30] {delta}9:c{<-}c Fadd q1 & r{<-}0,(1{drop}r1),r1[0]{rho}0 431 | [31] @ It may be that our truncation of the provisional quotient has 432 | [32] @ resulted in =, so 433 | [33] {->}(~b Fequal r)/{delta}10 434 | [34] r{<-}0 0 & c{<-}c Fadd 1 435 | [35] {delta}10:{->}{delta}4 436 | [36] {delta}99:c{<-}(c{times}1,({neg}1+{rho}c){rho}s)(r{times}1,({neg}1+{+ 437 | +}{rho}r){rho}s) 438 | {del} 439 | 440 | {del} a{<-}x Imod b;b1;j;q;qf;s 441 | [1] @ Multiprecision integer modulus function 442 | [2] x{<-}scalar x & b{<-}scalar b @ Allow scalar B 443 | [3] #SIGNAL(0{or}.>b[0],x[0])/11 @ Must be integers 444 | [4] s{<-}0 & a{<-}x 445 | [5] {->}(2<{rho},b{<-}fullint b)/{delta}1 446 | [6] {->}(b[1]{<=}bsqr)/{delta}7 447 | [7] {delta}1:b1{<-}b[1]+(3{take}b)[2]{divide}base 448 | [8] {delta}2:{->}(~0 0 Fgt a)/{delta}3 449 | [9] a{<-}|a & s{<-}~s @ Do everything positively 450 | [10] {delta}3:#SIGNAL(a Fgt|x)/11 @ Program error if this fires 451 | [11] {->}(~(a Fgt 0 {neg}1)^b Fgt a)/{delta}5 452 | [12] {->}(~s^~a Fequal 0 0)/{delta}4 453 | [13] a{<-}b Fsub a 454 | [14] {delta}4:{->}0 455 | [15] {delta}5:q{<-}{floor}qf{<-}(a[1]+(3{take}a)[2]{divide}base){divide}b1 456 | [16] j{<-}0 457 | [17] {->}(0{/=}q)/{delta}6 458 | [18] q{<-}{floor}qf{<-}qf{times}base & j{<-}1 @ If Q=0 then {+ 459 | +}shift 1 place right 460 | [19] {delta}6:a{<-}a Fsub q Fmul(a[0]+({rho}a)-j){take}b 461 | [20] {->}{delta}2 462 | [21] @ 463 | [22] {delta}7:b{<-}b[1] & x{<-}fullint x 464 | [23] a{<-}x[1] & x{<-}2{drop}x 465 | [24] {delta}8:a{<-}b|a 466 | [25] {->}(0={rho}x)/{delta}9 467 | [26] a{<-}base{basevalue}a,1{take}x 468 | [27] x{<-}1{drop}x 469 | [28] {->}{delta}8 470 | [29] {delta}9:{->}(~s^0{/=}a)/{delta}10 471 | [30] a{<-}b-a 472 | [31] {delta}10:a{<-}0,a 473 | {del} 474 | 475 | {del} z{<-}m Impow x;i;mod;n;q;r 476 | [1] @ This function raises multiprecision M to the power of 477 | [2] @ multiprecision X[0] and returns the residue modulo X[1] 478 | [3] @ For the method see Ribenboim [1988] p.38 479 | [4] x mod{<-}x @ separate the parameters 480 | [5] z{<-}1 @ Result if power is 0 481 | [6] {->}(0={rho}n{<-}binary x)/0 @ Get binary version {+ 482 | +}of power 483 | [7] z{<-}m @ Start with number 484 | [8] {->}(1={rho}n)/0 @ Exit if power is 1 485 | [9] i{<-}1 486 | [10] {delta}1:z{<-}z Fmul z @ Square Z 487 | [11] {->}(~n[i])/{delta}2 @ If the next bit is {+ 488 | +}set ... 489 | [12] z{<-}z Fmul m @ ... multiply by M 490 | [13] {delta}2:z{<-}z Imod mod @ Residue modulo mod 491 | [14] {->}(({rho}n)>i{<-}i+1)/{delta}1 @ Any more bits 492 | {del} 493 | 494 | {del} z{<-}x Inv_mod n;a;b;N;rn;r0;r1 495 | [1] @ Calculate the multiplicative inverse of x mod n 496 | [2] @ If the inverse does not exist, return 0 497 | [3] a{<-}{zilde} & N{<-}n 498 | [4] {->}(1{or}.{/=}({rho}x),{rho}n)/{delta}10 499 | [5] z{<-}0 & x{<-}N|x 500 | [6] {delta}1:a{<-}a,{disclose}b{<-}(0,x){represent}n 501 | [7] n{<-}x & {->}(0{/=}x{<-}1{pick}b)/{delta}1 502 | [8] @ At this point n holds the GCD of the original n and x. If this is {+ 503 | +}not 1 504 | [9] @ then there is no multiplicative inverse. 505 | [10] {->}(1{/=}n)/0 506 | [11] r0{<-}1 0 & r1{<-}0 1 507 | [12] @ Recurrence relation is r(n)=r(n-2)-q.r(n-1) 508 | [13] @ i.e. rn {<-} r0 - ({disclose}a).r1 509 | [14] {delta}3:rn{<-}r0-r1{times}{disclose}a 510 | [15] r0{<-}r1 & r1{<-}rn & a{<-}1{drop}a 511 | [16] {->}(1<{rho}a)/{delta}3 512 | [17] z{<-}N|1{pick}rn & {->}0 513 | [18] @ Multiprecision version 514 | [19] {delta}10:z{<-}0 0 & x{<-}x Imod N 515 | [20] {delta}11:a{<-}a,(b{<-}n Idiv x)[0] 516 | [21] n{<-}x & {->}(~0 0 Fequal x{<-}1{pick}b)/{delta}11 517 | [22] {->}(~0 1 Fequal n)/0 518 | [23] r0{<-}(0 1)(0 0) & r1{<-}(0 0)(0 1) 519 | [24] {delta}13:rn{<-}r0 Fsub{each}r1 Fmul{each}a[0] 520 | [25] r0{<-}r1 & r1{<-}rn & a{<-}1{drop}a 521 | [26] {->}(1<{rho}a)/{delta}13 522 | [27] z{<-}(1{pick}rn)Imod N 523 | {del} 524 | 525 | {del} z{<-}Isqrt a;b;f;n;q;r 526 | [1] @ Integer square root by Newton-Raphson iteration 527 | [2] a{<-}scalar a @ Add leading 0 if a scalar 528 | [3] #SIGNAL(0{or}.>a)/11 @ Domain error if negative or not {+ 529 | +}integer 530 | [4] {->}(0{or}.{/=}1{drop}a)/{delta}1 531 | [5] z{<-}(0 0)(0 0) & {->}0 @ Quick quit if result is zero 532 | [6] {delta}1:a{<-}fullint a @ Full precision number 533 | [7] {->}(3<{rho}a)/{delta}2 @ Special code for speed {+ 534 | +}if A is small 535 | [8] z{<-}0,{floor}(base{basevalue}a)*0.5 & {->}{delta}8 @ Result 536 | [9] @ Get an accurate starting value 537 | [10] {delta}2:n{<-}({rho}a){min}(2|{rho}a)+2{times}1{max}{floor}8{divide}10{+ 538 | +}{log}base @ How many digits do we take 539 | [11] z{<-}(n{<-}1+{floor}0.5{times}{rho}a){take}0 Fadd{min}(base{+ 540 | +}{basevalue}n{take}a)*0.5 541 | [12] {->}(0 0{match}r{<-}a Fsub z Fmul z)/{delta}9 @ Have we hit upon {+ 542 | +}the sq. root straight away? 543 | [13] @ z is our first guess at the square root 544 | [14] {delta}3:b{<-}z Fadd(a Fsub z Fmul z)Fdiv z Fmul 2 545 | [15] {execute}(b[0]<{neg}2)/'b{<-}{neg}2,1{drop}(2+b[0]){drop}b' 546 | [16] {->}((floor b)Fequal floor z)/{delta}4 547 | [17] z{<-}b & {->}{delta}3 548 | [18] {delta}4:{execute}(0>z[0])/'z{<-}floor z' 549 | [19] {delta}8:r{<-}a Fsub z Fmul z @ Square-root remainder 550 | [20] {delta}9:z{<-}z r 551 | {del} 552 | 553 | {del} z{<-}ISQRT x;#IO 554 | [1] #IO{<-}0 & z{<-}0 Ffmt{each}Isqrt Fexec x 555 | {del} 556 | 557 | {del} z{<-}a Lcm b 558 | [1] @ Least common multiple of 2 numbers 559 | [2] {->}(1^.=({rho}a),{rho}b)/{delta}2 @ Quick method if both {+ 560 | +}scalars 561 | [3] z{<-}{disclose}(a Fmul b)Idiv a Gcd b 562 | [4] {->}0 563 | [5] {delta}2:z{<-}(a{times}b){divide}a Gcd b 564 | {del} 565 | 566 | {<-}MINUSONE{<-}{neg}5 {neg}1 0 0 0 0 0 567 | 568 | {del} z{<-}a MUL b;#IO 569 | [1] @ Multiprecision multiply 570 | [2] #IO{<-}0 & z{<-}0 Ffmt{pick}Fmul/Fexec{each}a b 571 | {del} 572 | 573 | {<-}ONE{<-}{neg}5 1 0 0 0 0 0 574 | 575 | {del} z{<-}{leftbrace}a{rightbrace}SUB b;#IO 576 | [1] @ Multiprecision subtract 577 | [2] #IO{<-}0 578 | [3] {->}(0{/=}#NC'a')/{delta}1 579 | [4] a{<-}0 0 @ Allow monadic call, which just negates b 580 | [5] {delta}1:z{<-}0 Ffmt{pick}Fsub/Fexec{each}a b 581 | {del} 582 | -------------------------------------------------------------------------------- /archive/mpaspac.apl: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/apl --script 2 | ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝ 3 | ⍝ 4 | ⍝ mp 2019-10-30 13:25:12 (GMT-7) 5 | ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝ 6 | 7 | ∇ANCESTR X;A;H 8 | ⍝ For a function with name X , ANCESTR produces the names of functions 9 | ⍝ called by X and listed in the line beginning with '⍝ 888' 10 | ⎕←(⍕⍉(1,(⍴A))⍴A←H/⍳1↑⍴A),(H←∧/A[;⍳5]=((1↑⍴A),5)⍴'⍝ 888')⌿A←1 0↓⎕CR X 11 | ∇ 12 | 13 | ∇Z←X BIGRED Y;I 14 | ⍝ Z is the inverse mod X of the product ×/Y of the members of Y 15 | ⍝ 888 TINVERTP 16 | Z←X|Y[I←1] 17 | REK:→((⍴Y)S)/TE1 80 | →(49=J←(V|X)⍳0)/REK 81 | →SET,(Y←Y,V[J]),X←X÷V[J] 82 | REK:→TES,V←V+210 83 | TE1:→(1=X)/PRT 84 | Y←Y,X 85 | PRT:→0 86 | ∇ 87 | 88 | ∇V←M MAKEBIG N;I;X 89 | ⍝ V ist the vector of the N last primes P such that P≤M . 90 | ⍝ In a fixed situation V is called BIGPRIMES . 91 | ⍝ 888 FAC21 92 | V←⍳I←0 93 | REK:→(N≤⍴V)/0 94 | NEX:I←I+2 95 | →(1<⍴FAC21 X←(M+1)-I)/NEX 96 | V←X,V 97 | →REK 98 | ∇ 99 | 100 | ∇MAKEBIGINV;V;W;I 101 | ⍝ Starting from BIGPRIMES, for i>1 the number BIGV[i] is the inverse 102 | ⍝ mod BIGPRIMES[i] of the product of the first i-1 members of BIG- 103 | ⍝ PRIMES . In a fixed situtation, BIGV is called BIGINV . 104 | ⍝ 888 BIGPRIMES BIGRED 105 | BIGV←1↑W←BIGPRIMES 106 | I←1 107 | REK:→((⍴W)SC←×1↑C)/NEG 207 | →((⍴C)>⍴A)/DIV 208 | →(0>SC)/DIV 209 | →((⍴C)<⍴A)/0 210 | →((⍴A)=I←(A≠C)⍳1)/DIV 211 | →(A[I]>C[I])/0 212 | DIV:N←⌊10⍟Q←(G⊥|(M←3⌊⍴C)↑C)÷G⊥(L←3⌊⍴A)↑A 213 | →(12>T←N+6×((⍴C)-M)-(⍴A)-L)/LIL 214 | Q←⌊Q×10⋆T-N+6×R←¯2+⌊T÷6 215 | Q←(SA×SC×,(3⍴G)⊤Q),R⍴0 216 | →FIT 217 | LIL:Q←⌊SA×SC×Q×10⋆T-N 218 | Q←(×Q)×((1+⌊10⍟|Q)⍴G)⊤|Q 219 | FIT:QQ←QQ MGSUMM Q 220 | C←C MGSUMM(-SA)×Q MGPRODZ A 221 | →REK 222 | NEG:C←C MGSUMM A 223 | QQ←QQ MGSUMM-SA 224 | ∇ 225 | 226 | ∇C←A MGREMN B;⎕IO;I;L;M;N;Q;R;T;SC 227 | ⍝ A,B C are N-1E6-vectors; A,B positive. C is the remainder of A 228 | ⍝ divided in B. The quotient is saved in QQ . 229 | ⍝ 888 MGSUMM MGPRODN REEM REE ⋆ G GLOBAL 230 | QQ←,⎕IO←0 231 | C←B 232 | REK:→(((⍴C)<⍴A)∧0>SC←×C[0])/NEG 233 | →((⍴C)>⍴A)/DIV 234 | →(0>SC)/DIV 235 | →((⍴C)<⍴A)/0 236 | →((⍴A)=I←(A≠C)⍳1)/DIV 237 | →(A[I]>C[I])/0 238 | DIV:N←⌊10⍟Q←(G⊥|(M←3⌊⍴C)↑C)÷G⊥(L←3⌊⍴A)↑A 239 | →(12>T←+/N+6×((⍴C)-M)-(⍴A)-L)/LIL 240 | Q←⌊Q×10⋆T-N+6×R←¯2+⌊T÷6 241 | Q←(SC×,(3⍴G)⊤Q),R⍴0 242 | →FIT 243 | LIL:Q←⌊SC×Q×10⋆T-N 244 | Q←(×Q)×((1+⌊10⍟|Q)⍴G)⊤|Q 245 | FIT:QQ←QQ MGSUMM Q 246 | C←C MGSUMM ¯1×Q MGPRODN A 247 | →REK 248 | NEG:C←C MGSUMM A 249 | QQ←QQ MGSUMM ¯1 250 | ∇ 251 | 252 | ∇C←A MGREMN1 B;⎕IO;I;L;M;N;Q;R;T;SC 253 | ⍝ A,B C are N-1E6-vectors; A,B positive. C is the remainder of A 254 | ⍝ divided in B. The quotient is saved in QQ . 255 | ⍝ 888 MGSUMM MGPRODN ⋆ G GLOBAL 256 | QQ←,⎕IO←0 257 | C←B 258 | REK:→((((⍴C)<⍴A)∧0>SC),((⍴C)>⍴A),0>SC←×C[0])/NEG,DIV,DIV 259 | →(((⍴C)<⍴A),((⍴A)=I),A[I]>C[I←(A≠C)⍳1])/0,DIV,0 260 | DIV:N←⌊10⍟Q←(G⊥|(M←3⌊⍴C)↑C)÷G⊥(L←3⌊⍴A)↑A 261 | →(12>T←+/N+6×((⍴C)-M)-(⍴A)-L)/LIL 262 | Q←⌊Q×10⋆T-N+6×R←¯2+⌊T÷6 263 | Q←(SC×,(3⍴G)⊤Q),R⍴0 264 | →FIT 265 | LIL:Q←⌊SC×Q×10⋆T-N 266 | Q←(×Q)×((1+⌊10⍟|Q)⍴G)⊤|Q 267 | FIT:QQ←QQ MGSUMM Q 268 | C←C MGSUMM ¯1×Q MGPRODN A 269 | →REK 270 | NEG:C←C MGSUMM A 271 | QQ←QQ MGSUMM ¯1 272 | ∇ 273 | 274 | ∇C←A MGSUM B;M 275 | ⍝ A,B,C are nonnegative N-1E6-vectors. C is the sum A plus B . 276 | ⍝ 888 REE 277 | M←-(⍴A←,A)⌈⍴B←,B 278 | C←REE(M↑A)+M↑B 279 | ∇ 280 | 281 | ∇C←A MGSUMM B;M 282 | ⍝ A,B,C are N-1E6-vectors. C is the sum A plus B . 283 | ⍝ 888 REEM 284 | M←-(⍴A←,A)⌈⍴B←,B 285 | C←REEM(M↑A)+M↑B 286 | ∇ 287 | 288 | ∇X←MPZFORM A 289 | ⍝ numeric to character for vectors of digits to base 1E6 290 | X←,((⍴A),¯6)↑0⍕((⍴A),1)⍴⌊|A←,A 291 | X[(X=' ')/⍳⍴X]←'0' 292 | X←((¯1=×1↑A)⍴'¯'),((('0'≠¯1↓X)⍳1)-⎕IO)↓X 293 | ∇ 294 | 295 | ∇B←MPZNRMLZ A;SIGN;S 296 | ⍝ normalized vector of digits to base 1E6 297 | DERR∧/(1≥⍴⍴A),B=⌊B←,A 298 | SIGN←1 299 | LOOP:→(0=⍴B←(((B≠0)⍳1)-⎕IO)↓B)/ZERO 300 | B←⌊B×S←×1↑B 301 | SIGN←S×SIGN 302 | →(∧/(B<1000000),B≥0)/END 303 | B←(S,0)+0,B-1000000×S←⌊B÷1000000 304 | →LOOP 305 | ZERO:→B←,0 306 | END:B←SIGN×B 307 | ∇ 308 | 309 | ∇Z←X MPZPROD Y 310 | ⍝ product of integers given as character vectors to base 10 311 | ⍝ 888 MPZFORM MPZUNF MPZPROD0 312 | Z←MPZFORM(MPZUNF X)MPZPROD0 MPZUNF Y 313 | ∇ 314 | 315 | ∇C←A MPZPROD0 B;⎕IO;U 316 | ⍝ product of vectors of digits to base 1E6 317 | ⍝ 888 MPZNRMLZ 318 | ⎕IO←0 319 | U←(A←,A)∘.×,B 320 | C←MPZNRMLZ+⌿(-⍳⍴A)⌽U,(0 ¯1+2⍴⍴A)⍴0 321 | ∇ 322 | 323 | ∇A←MPZUNF X;⎕IO;M;SIGN 324 | ⍝ converts character vector X into vector of digits to base 1E6 325 | ⎕IO←0 326 | M←'¯'=1↑X←,X 327 | SIGN←1↑M↑X 328 | DERR∧/(X←M↓X)∈'0123456789' 329 | A←,⍎((7×M)⍴0 1 1 1 1 1 1)\(¯6×M←⌈(⍴X)÷6)↑X 330 | A←(¯1⋆SIGN='¯')×A 331 | ∇ 332 | 333 | ∇B←MZAVA A;N 334 | ⍝ A,B are C-10-vectors. B is the absolute value of A . 335 | DERR(1≥⍴⍴A)∧∧/,A∈'0123456789+¯' 336 | →(∼(1↑A←,A)∈'+¯')/NOSIGN 337 | A←1↓A 338 | NOSIGN:N←+/∧\A='0' 339 | →(0<⍴B←N↓A)/0 340 | B←,'0' 341 | ∇ 342 | 343 | ∇A←MZCNCO X;⎕IO;M;N 344 | ⍝ X is a C-10-vector, A is the corresponding N-1E6-vector 345 | ⎕IO←0 346 | M←'¯'=1↑X←,X 347 | DERR∧/(X←M↓X)∈'0123456789' 348 | A←(¯1⋆M)×,⍎((7×N)⍴0 1 1 1 1 1 1)\(¯6×N←⌈(⍴X)÷6)↑X 349 | ∇ 350 | 351 | ∇D←MZDET A;⎕IO;E;N;NN;F;H;P;I;QQ;N2;G 352 | ⍝ D is a C-10 number which is the determinant (after Cabay and Lam) 353 | ⍝ of the matrix X consisting of usual (APL single precision) numbers 354 | ⍝ 888 BIGPRIMES ZNDET BIGINV MGREM MGPROD MGPRODN MGPRODZ MGSUMM MGNCCO 355 | ⍝ 888 REEM REE 356 | DERR∧/(2=⍴⍴A),(=/⍴A),,A=⌊A 357 | ⎕IO←1 358 | G←1000000 359 | E←(⍟2)++/⍟(+/A×A)⋆0.5 360 | DERR(⍴BIGPRIMES)≥N←⌈E÷⍟BIGPRIMES[1] 361 | N2←⌊0.5×NN←BIGPRIMES[1] 362 | D←REEM,(NN|N2+ZNDET A)-N2 363 | P←,I←1 364 | REK:→(N9670)/END4 385 | Z←⍕,!N⌊10 386 | →(N≤10)/0 387 | →(0=R←⌊(M←¯10+N⌊100)÷7)/END0 388 | I←1 389 | A←10+⍳M 390 | REK0:Z←Z MZPROD⍕,×/7↑A 391 | A←7↓A 392 | →(R≥I←I+1)/REK0 393 | Z←Z MZPROD⍕,×/A 394 | →(N≤100)/0 395 | →(0=R←⌊(M←¯100+N⌊159)÷5)/END1 396 | I←1 397 | A←100+⍳M 398 | REK1:Z←Z MZPROD⍕,×/5↑A 399 | A←5↓A 400 | →(R≥I←I+1)/REK1 401 | Z←Z MZPROD⍕,×/A 402 | →(N≤159)/0 403 | →(0=R←⌊(M←¯159+N⌊959)÷4)/END2 404 | I←1 405 | A←159+⍳M 406 | REK2:Z←Z MZPROD⍕,×/4↑A 407 | A←4↓A 408 | →(R≥I←I+1)/REK2 409 | Z←Z MZPROD⍕,×/A 410 | →(N≤959)/0 411 | →(0=R←⌊(M←¯959+N⌊9670)÷3)/END3 412 | I←1 413 | A←959+⍳M 414 | REK3:Z←Z MZPROD⍕,×/3↑A 415 | A←3↓A 416 | →(R≥I←I+1)/REK3 417 | Z←Z MZPROD⍕,×/A 418 | →0 419 | END0:Z←Z MZPROD⍕,×/10+⍳M 420 | →0 421 | END1:Z←Z MZPROD⍕,×/100+⍳M 422 | →0 423 | END2:Z←Z MZPROD⍕,×/159+⍳M 424 | →0 425 | END3:Z←Z MZPROD⍕,×/959+⍳M 426 | →0 427 | END4:'THIS FUNCTION WORKS ONLY FOR N≤9670 ' 428 | ∇ 429 | 430 | ∇Z←X MZGCD Y;G 431 | ⍝ X,Y,Z are C-10-vectors. C is the natural GCD of A,B . 432 | ⍝ 888 MZCNCO MGNCCO MGGCD MGREMN MGSUMM MGPRODN REE REEM 433 | G←1000000 434 | Z←MGNCCO(MZCNCO X)MGGCD MZCNCO Y 435 | ∇ 436 | 437 | ∇B←MZNEG A;⎕IO;I;C 438 | ⍝ A,B are C-10-vectors. B is minus A . 439 | ⎕IO←0 440 | DERR(1≥⍴⍴A)∧' '=1↑0↑,A 441 | I←(C←1↑B←,A)∈'+¯' 442 | B←I↓B 443 | DERR∧/B∈'0123456789' 444 | B←(+/∧\'0'=¯1↓B)↓B 445 | →((C='¯')∨'0'=1↑B)/0 446 | B←'¯',B 447 | ∇ 448 | 449 | ∇Z←X MZPOWER N 450 | ⍝ N is an ordinary integer, X,Z are integers as C-10-vectors. 451 | ⍝ Z is the N-th power of X . 452 | ⍝ 888 MZCNCO MGNCCO MGPOWER MGPRODN REE 453 | Z←MGNCCO(MZCNCO X)MGPOWER N 454 | ∇ 455 | 456 | ∇Z←X MZPROD Y;G 457 | ⍝ X,Y,Z are C-10-vectors. Z is the product of X,Y . 458 | ⍝ 888 MZCNCO MGNCCO MGPRODZ MGPRODN MGSUMM REEM REE 459 | G←1000000 460 | Z←MGNCCO(MZCNCO X)MGPRODZ MZCNCO Y 461 | ∇ 462 | 463 | ∇Z←X MZREM Y;A;B;C;SA;SB;SC;G 464 | ⍝ X,Y,Z are C-10-vectors. Z is the remainder of X divided in Y : 465 | ⍝ Y = QQ×X + Z with (1) Z=Y if X=0 or Y=0 , (11) QQ=1 if X=0 , 466 | ⍝ (12) QQ=0 if X≠0 , Y=0 , (2) 0≤ZSA)∧0SB)/END2 481 | C←-C 482 | →END 483 | END1:→(SC=0)/END3 484 | C←A MGSUMM C 485 | QQ←¯1×QQ MGSUM 1 486 | →END 487 | END2:→(SC=0)/END3 488 | C←A MGSUMM-C 489 | QQ←¯1×QQ MGSUM 1 490 | →END 491 | END3:QQ←¯1×QQ 492 | END:Z←MGNCCO C 493 | QQ←MGNCCO QQ 494 | ∇ 495 | 496 | ∇Z←X MZREMN Y;G 497 | ⍝ X,Y,Z are C-10-vectors; X,Y positive. Z is the remainder of X 498 | ⍝ divided in Y . The integer quotient is saved in QQ . 499 | ⍝ speed faster than MZREM . 500 | ⍝ 888 MZCNCO MGNCCO MGREMN MGSUMM MGPRODN REEM REE 501 | G←1000000 502 | Z←MGNCCO(MZCNCO X)MGREMN MZCNCO Y 503 | QQ←MGNCCO QQ 504 | ∇ 505 | 506 | ∇Z←X MZREMP Y;G 507 | ⍝ X,Y,Z are C-10-vectors; X nonnegative. Z is the remainder of X 508 | ⍝ divided in Y . The integer quotient is saved in QQ . 509 | ⍝ 888 MZCNCO MGNCCO MGREM MGSUMM MGPRODZ MGPRODN REEM REE 510 | G←1000000 511 | Z←MGNCCO(MZCNCO X)MGREM MZCNCO Y 512 | QQ←MGNCCO QQ 513 | ∇ 514 | 515 | ∇T←MZSGN A;M 516 | ⍝ A is a C-10-vector. T is its sign . 517 | M←'¯'=1↑A←,A 518 | DERR∧/(A←M↓A)∈'0123456789' 519 | →(M=0)/NONNEG 520 | →(M∧∧/A∈'0')/ZERO 521 | →0,T←¯1 522 | NONNEG:→(∧/A∈'0')/ZERO 523 | →0,T←1 524 | ZERO:T←0 525 | ∇ 526 | 527 | ∇Z←X MZSUM Y 528 | ⍝ X,Y,Z are (signed) C-10-vectors. Z is the sum X plus Y . 529 | ⍝ 888 MZCNCO MGNCCO MGSUMM REEM 530 | Z←MGNCCO(MZCNCO X)MGSUMM MZCNCO Y 531 | ∇ 532 | 533 | ∇Z←REE X;Y 534 | ⍝ X is a vector of nonnegative integers. 535 | ⍝ Z is a vector of G-digits with the same G-value. 536 | Z←X 537 | REK:→(∧/ZI←I+1)/REK 575 | Z←(÷⍴Z)×+/Z 576 | ⍝DT 12.2.87 577 | ∇ 578 | 579 | ∇Z←PP TINVERTP R;X;Y;T;A;B;D;I;Q 580 | ⍝ Z is the the inverse mod PP of the integer R 581 | Y←PP 582 | T←PP|R 583 | Z←B←1+D←A←I←0 584 | REK:→(0=X←T|Y)/END 585 | Z←((A←Z)×Q←(Y-X)÷T)+A 586 | D←((B←D)×Q)+B 587 | Y←T 588 | T←X 589 | →REK,I←I+1 590 | END:Z←PP|PP+Zׯ1⋆I 591 | ∇ 592 | 593 | ∇D←ZNDET A;⎕IO;V;J;W;Q 594 | ⍝ determinant of integer matrix using integer row operations mod NN 595 | DERR∧/(NN<10000000),(,A=⌊A),(2=⍴⍴A),=/⍴A←NN|A 596 | D←⎕IO←1 597 | →(0=1↑⍴A)/0 598 | LOOP:→(1=1↑⍴A)/END 599 | BACK:→(∧/0=V←A[;1])/ZERO 600 | J←V⍳⌊/(V≠0)/V 601 | →(J=1)/OK 602 | A[1,J;]←A[J,1;] 603 | D←NN|-D 604 | OK:→(∧/0=W←1↓A[;1])/ENDLP 605 | Q←0,⌊W÷A[1;1] 606 | A←NN|A-Q∘.×A[1;] 607 | →BACK 608 | ENDLP:D←NN|D×A[1;1] 609 | A←1 1↓A 610 | →LOOP 611 | ZERO:→D←0 612 | END:D←NN|D×A[1;1] 613 | ∇ 614 | 615 | ABSTRACT←' ' ⍝ proto 1 616 | ABSTRACT←0⍴ABSTRACT ⍝ proto 2 617 | 618 | BIGINV←50⍴0 ⍝ prolog ≡1 619 | (BIGINV)[⍳8]←9999071 9165826 283452 9555586 7132394 5124772 2209919 1479669 620 | (BIGINV)[8+⍳8]←2132758 1530962 129491 477215 1243524 6299670 907263 796818 621 | (BIGINV)[16+⍳7]←9821791 5714457 7236163 7146222 5016272 3301955 3227005 622 | (BIGINV)[23+⍳7]←6747281 2534875 1143272 7126244 8503876 5143814 8711328 623 | (BIGINV)[30+⍳7]←4443269 5165260 9889622 6788847 2040129 7400470 4910934 624 | (BIGINV)[37+⍳7]←9702285 9257415 3970022 2784612 4765060 4998631 8059704 625 | (BIGINV)[44+⍳6]←5756328 8621884 7519471 348897 2528490 5009170 626 | 627 | BIGPRIMES←50⍴0 ⍝ prolog ≡1 628 | (BIGPRIMES)[⍳7]←9999071 9999083 9999161 9999163 9999167 9999193 9999217 629 | (BIGPRIMES)[7+⍳7]←9999221 9999233 9999271 9999277 9999289 9999299 9999317 630 | (BIGPRIMES)[14+⍳7]←9999337 9999347 9999397 9999401 9999419 9999433 9999463 631 | (BIGPRIMES)[21+⍳7]←9999469 9999481 9999511 9999533 9999593 9999601 9999637 632 | (BIGPRIMES)[28+⍳7]←9999653 9999659 9999667 9999677 9999713 9999739 9999749 633 | (BIGPRIMES)[35+⍳7]←9999761 9999823 9999863 9999877 9999883 9999889 9999901 634 | (BIGPRIMES)[42+⍳7]←9999907 9999929 9999931 9999937 9999943 9999971 9999973 635 | (BIGPRIMES)[49+⍳1]←9999990.9999999907 636 | 637 | G←1000000 638 | 639 | VMUL7←48⍴0 ⍝ prolog ≡1 640 | (VMUL7)[⍳21]←11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 641 | (VMUL7)[21+⍳15]←101 103 107 109 113 121 127 131 137 139 143 149 151 157 163 642 | (VMUL7)[36+⍳12]←167 169 173 179 181 187 191 193 197 199 209 211 643 | 644 | ⎕CT←9.9999999999999982E¯14 645 | 646 | ⎕FC←(,⎕UCS 46 44 8902 48 95 175) 647 | 648 | ⎕IO←1 649 | 650 | ⎕L←0 651 | 652 | ⎕LX←'ABSTRACT' 653 | 654 | ⎕PP←10 655 | 656 | ⎕PR←' ' 657 | 658 | ⎕PS←0 0 659 | 660 | ⎕PW←80 661 | 662 | ⎕R←0 663 | 664 | ⎕RL←2063936098 665 | 666 | ⎕TZ←¯7 667 | 668 | ⎕X←0 669 | 670 | -------------------------------------------------------------------------------- /archive/mpaspac.atf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LdBeth/CLASSLIB/748de41b3c8bf09c3ca7be4febcf4d42ad461126/archive/mpaspac.atf -------------------------------------------------------------------------------- /archive/mpaspac.txt: -------------------------------------------------------------------------------- 1 | From walter.felscher@uni-tuebingen.de Sun Dec 17 07:24:33 1995 2 | Date: Sun, 17 Dec 1995 13:22:40 +0100 (MEZ) 3 | From: Walter Felscher 4 | To: Lee Dickey 5 | Subject: Re: Extended precision 6 | 7 | MPASPAC 8 | 9 | A. 10 | 11 | MPASPAC.ATF will work under each of IBM's APL2/PC , APL2/OS2 , APL2/6000 , 12 | running under DOS or OS2 on PCs or under AIX on RS6000 work stations. 13 | The file should be loaded with the command ")IN MPASPAC" and can, 14 | if so desired after having made changes, be saved either as an ATF-file 15 | with the command ")OUT newfile" or as a processor dependent APL-file 16 | with the command ")SAVE newfile" . 17 | 18 | B. 19 | 20 | With a few exceptions, the functions in MPASPAC are variants of functions 21 | coming from 22 | 23 | C.C.Sims: A classlib user's manual. 24 | Wiley 1985 25 | 26 | which is a companion to 27 | 28 | C.C.Sims: Abstract Algebra. A computational approach. 29 | Wiley 1984 . 30 | 31 | In particular, the functions beginning with MPZ... are directly from 32 | there, as is ZNDET . 33 | 34 | C. 35 | 36 | For input and output, multiprecision integers are treated as character 37 | vectors of digits to base 10 : C-10-vectors. 38 | 39 | For computation, these are transformed into numerical vectors of 40 | numbers which are digits to base G=1E6 : N-1E6-vectors. 41 | 42 | Functions transforming input are MPZUNF and MZCNCO . 43 | 44 | Functions transforming output are MPZFORM and REEM, REEN . 45 | 46 | The C-10-vector functions MZ___ use for computation analogously named 47 | N-1E6-vector functions MG___ . 48 | 49 | * 50 | 51 | Errors and improvements may be reported to : 52 | 53 | Walter Felscher , felscher@maplog.informatik.uni-tuebingen.de 54 | 55 | -------------------------------------------------------------------------------- /examples.apl: -------------------------------------------------------------------------------- 1 | DESIGN1←7 3⍴1 2 3 1 4 5 1 6 7 2 4 6 2 5 7 3 4 7 3 5 6 2 | 3 | MTIMES←(1 18⍴0)⍪(⍳18)-⎕IO 4 | MTIMES←MTIMES⍪0 2 4 0 2 4 12 14 16 12 14 16 6 8 10 6 8 10 5 | MTIMES←MTIMES⍪0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3 6 | MTIMES←MTIMES⍪0 4 2 0 4 2 6 10 8 6 10 8 12 16 14 12 16 14 7 | MTIMES←MTIMES⍪0 5 4 3 2 1 12 17 16 15 14 13 6 11 10 9 8 7 8 | MTIMES←⍉MTIMES 9 | 10 | GP8←8 4⍴0 1 2 3 0 3 2 1 1 2 3 0 1 0 3 2 2 3 0 1 3 2 1 0 2 1 0 3 3 0 1 2 11 | 12 | P20←1 20⍴6 16 12 0 8 11 18 13 15 19 9 5 2 1 14 4 7 17 3 10 13 | P20←P20⍪12 7 18 2 10 13 0 1 4 19 15 11 6 17 5 8 14 16 3 9 14 | -------------------------------------------------------------------------------- /global.apl: -------------------------------------------------------------------------------- 1 | EPSILON←1E¯13 2 | 3 | NOTEST←0 4 | 5 | BIGPRIMES←999221 999233 999239 999269 999287 999307 999329 999331 999359 999371 6 | BIGPRIMES←BIGPRIMES, 999377 999389 999431 999433 999437 999451 999491 999499 7 | BIGPRIMES←BIGPRIMES, 999521 999529 999541 999553 999563 999599 999611 999613 8 | BIGPRIMES←BIGPRIMES, 999623 999631 999653 999667 999671 999683 999721 999727 9 | BIGPRIMES←BIGPRIMES, 999749 999763 999769 999773 999809 999853 999863 999883 10 | BIGPRIMES←BIGPRIMES, 999907 999917 999931 999953 999959 999961 999979 999983 11 | 12 | BIGINV←1 416347 564385 754637 356251 555937 372722 692421 694764 13 | BIGINV←BIGINV, 358869 388076 902744 505494 949639 545488 755533 561217 833761 14 | BIGINV←BIGINV, 904084 281090 340130 572038 313620 160778 656143 776323 771968 15 | BIGINV←BIGINV, 467359 775981 11363 825431 856786 127780 714724 454910 63491 16 | BIGINV←BIGINV, 235199 920209 538488 953104 920088 275987 518335 283952 925450 17 | BIGINV←BIGINV, 345471 132911 687127 124557 441543 18 | -------------------------------------------------------------------------------- /group.apl: -------------------------------------------------------------------------------- 1 | ∇GTINIT A;⎕IO 2 | ⍝ INITIALIZES THE CURRENT ABSTRACT GROUP. 3 | GTABLE←A 4 | ⎕IO←GTIO←⌊/A[⎕IO←1;] 5 | GTINV←SFEL A=⎕IO 6 | ∇ 7 | 8 | ∇T←GTCHECK G;⎕IO;E;N;M;I;GTABLE;GTIO;GTINV 9 | ⍝ CHECKS WHETHER G IS A GROUP TABLE WITH IDENTITY 10 | ⍝ EQUAL TO THE INDEX ORIGIN. 11 | ⍝ IS G A SQUARE INTEGER MATRIX? 12 | →(∧/(2≠⍴⍴G),(≠/⍴G),,G≠⌊G)/NO 13 | ⍝ THE ORIGIN SHOULD BE SET EQUAL TO ⌊/,G 14 | →(∧/0 1≠E←⌊/,G)/NO 15 | GTIO←⎕IO←E 16 | ⍝ CHECK CLOSURE. 17 | →(∧/,G>M←¯1+⎕IO+N←1↑⍴G)/NO 18 | ⍝ ANY BINARY OPERATION ON ⍳1 IS A GROUP. 19 | →(N=1)/YES 20 | ⍝ CHECK FOR TWO-SIDED IDENTITY. 21 | →(∧/(G[⎕IO;]≠⍳N),G[;⎕IO]≠⍳N)/NO 22 | ⍝ COPY G INTO GTABLE FOR USE IN GTSGP AND 23 | ⍝ SET G TO 1 TO SAVE SPACE. 24 | GTINIT G 25 | G←1 26 | ⍝ TRY TO FIND A GENERATING SET U WITH N≥2*⍴U. 27 | U←⍳0 28 | X←⎕IO=⍳N 29 | LOOP1:→(MSC←×1↑C)/NEG 106 | →((⍴C)>⍴A)/DIVIDE 107 | →(0>SC)/DIVIDE 108 | →((⍴C)<⍴A)/0 109 | →((⍴A)=I←(A≠C)⍳1)/DIVIDE 110 | →(A[I]>C[I])/0 111 | DIVIDE:N←⌊10⊥Q←(1000000⊥|(M←3⌊⍴C)↑C)÷1000000⊥(L←3⌊⍴A)↑A 112 | →(12>T←N+6×((⍴C)-M)-(⍴A)-L)/SMALL 113 | Q←⌊Q×10*T-N+6×R←¯2+⌊T÷6 114 | Q←(SA×SC×,(3⍴1000000)⊤Q),R⍴0 115 | →ADJUST 116 | SMALL:Q←⌊SA×SC×Q×10*T-N 117 | Q←(×Q)×((1+⌊10⊥|Q)⍴1000000)⊤|Q 118 | ADJUST:q←q MPZSUM0 Q 119 | C←C MPZSUM0(-SA)×Q MPZPROD0 A 120 | →LOOP 121 | NEG:C←C MPZSUM0 A 122 | q←q MPZSUM0-SA 123 | ∇ 124 | 125 | ∇B←MPZMAG A;N 126 | ⍝ COMPUTES THE ABSOLUTE VALUE OF AN INTEGER 127 | ⍝ GIVEN BY A CHARACTER VECTOR OF DIGITS TO 128 | ⍝ THE BASE 10. 129 | DERR(1≥⍴⍴A)∧∧/,A∊'0123456789+¯' 130 | →(~(1↑A←,A)∊'+¯')/NOSIGN 131 | A←1↓A 132 | NOSIGN:N←+/∧\A='0' 133 | →(0<⍴B←N↓A)/0 134 | B←,'0' 135 | ∇ 136 | 137 | ∇B←MPZMAG0 A 138 | ⍝ COMPUTES THE MAGNITUDE OF AN INTEGER GIVEN 139 | ⍝ BY A VECTOR OF DIGITS TO THE BASE 1E6. 140 | B←|MPZNRMLZ A 141 | ∇ 142 | 143 | ∇B←MPZNEG A;⎕IO;I;C 144 | ⍝ COMPUTES THE NEGATIVE OF AN INTEGER GIVEN 145 | ⍝ BY A CHARACTER VECTOR OF DIGITS TO THE BASE 10. 146 | ⎕IO←0 147 | DERR(1≥⍴⍴A)∧' '=1↑0↑,A 148 | I←(C←1↑B←,A)∊'+¯' 149 | B←I↓B 150 | DERR∧/B∊'0123456789' 151 | B←(+/∧\'0'=¯1↓B)↓B 152 | →((C='¯')∧'0'=1↑B)/0 153 | B←'¯',B 154 | ∇ 155 | 156 | ∇T←MPZSGN A 157 | ⍝ COMPUTES THE SIGNUM OF A MULTIPLE PRECISION INTEGER 158 | ⍝ GIVEN BY A CHARACTER VECTOR OF DIGITS TO THE BASE 10. 159 | DERR∧/(1≥⍴⍴A),,A∊'0123456789+¯' 160 | →('¯'≠1↑A←,A)/NONNEG 161 | T←¯1 162 | →0 163 | NONNEG:→(∧/A∊'0+')/ZERO 164 | T←1 165 | →0 166 | ZERO:T←0 167 | ∇ 168 | 169 | ∇Z←X MPZGCD Y 170 | ⍝ COMPUTES THE GCD OF TWO INTEGERS GIVEN BY 171 | ⍝ CHARACTER VECTORS OF DIGITS TO THE BASE 10. 172 | Z←MPZFORM(MPZUNF X)MPZGCD0 MPZUNF Y 173 | ∇ 174 | 175 | ∇C←A MPZGCD0 B;q 176 | ⍝ COMPUTES THE GCD OF TWO INTEGERS GIVEN 177 | ⍝ BY VECTORS OF DIGITS TO THE BASE 1E6. 178 | A←|MPZNRMLZ A 179 | C←|MPZNRMLZ B 180 | LOOP:→(0=1↑A)/0 181 | B←A MPZREM0 C 182 | C←A 183 | A←B 184 | →LOOP 185 | ∇ 186 | 187 | ∇D←MPZDET A;⎕IO;E;N;n;F;G;P;I;q;N2 188 | ⍝ MULTIPLE PRECISION DETERMINANT OF A SINGLE PRECISION 189 | ⍝ INTEGER MATRIX A LA CABAY AND LAM. 190 | DERR∧/(2=⍴⍴A),(=/⍴A),,A=⌊A 191 | ⎕IO←1 192 | E←(⍟2)++/⍟(+/A×A)*0.5 193 | DERR(⍴BIGPRIMES)≥N←⌈E÷⍟BIGPRIMES[1] 194 | N2←⌊0.5×n←BIGPRIMES[1] 195 | D←,(n|N2+ZNDET A)-N2 196 | P←,1 197 | I←1 198 | LOOP:→(N0 6 | R←((C=2)∨1,1↓|(¯1⌽N)-N)⊂C 7 | I←2=⊃¨R 8 | R[⍸I]←(0⍴⍨⍴)¨I/R 9 | OVERFLOW←⊃⌽I 10 | I←(-⍴I)↑¯1↓I 11 | R[⍸I]←(1,1↓0⍴⍨⍴)¨I/R 12 | R←⌽∊R 13 | ∇ 14 | -------------------------------------------------------------------------------- /prng/binary.apl: -------------------------------------------------------------------------------- 1 | ∇R←DECODE N 2 | R←2⊥N 3 | ∇ 4 | 5 | ∇R←X ENCODE N 6 | R←(X⍴2)⊤N 7 | ∇ 8 | 9 | ∇R←ENCODE32 N 10 | R←(32⍴2)⊤N 11 | ∇ 12 | 13 | ∇R←ENCODE64 N 14 | R←(64⍴2)⊤N 15 | ∇ 16 | 17 | ∇R←L EOR R 18 | R←1=L+R 19 | ∇ 20 | 21 | ∇R←A ADD B;C 22 | ⍝ BINARY ADDITION 23 | →NOTEST/BEGIN 24 | DERR∧/(A=A=1)∧B=B=1 25 | BEGIN: 26 | ⍝ RESET OVERFLOW 27 | OVERFLOW←0 28 | LOOP:A←A+B 29 | ⍝ FIND CARRY 30 | C←2=A 31 | →(0=+/C)/END 32 | A[C/⍳⍴C]←0 33 | ⍝ CHECK OVERFLOW 34 | OVERFLOW←OVERFLOW∨1=''⍴C 35 | B←(⍴C)↑1↓C 36 | →LOOP 37 | END: 38 | R←A 39 | ∇ 40 | -------------------------------------------------------------------------------- /prng/linear.apl: -------------------------------------------------------------------------------- 1 | ∇R←LCG0 X 2 | ⍝ THE LINEAR CONGRUENTIAL RANDOM NUMBER 3 | ⍝ GENERATOR 4 | R←M|C+A×X 5 | ∇ 6 | 7 | ∇R←K LCGG X;B;AK 8 | ⍝ GENERALIZED LCG0 9 | B←A-1 10 | AK←A*K 11 | R←M|((AK-1)×C÷B)+AK×X 12 | ∇ 13 | 14 | ∇R←NAG X;C;A;M 15 | C←0 16 | A←13*13 17 | M←2*59 18 | R←LCG0 X 19 | R÷M 20 | ∇ 21 | -------------------------------------------------------------------------------- /q.apl: -------------------------------------------------------------------------------- 1 | ∇B←QNRMLZ A;D;RHO 2 | ⍝ COMPUTES THE STANDARD REPRESENTATION OF AN ARRAY OF 3 | ⍝ RATIONAL NUMBERS EXPRESSED AS QUOTIENTS OF INTEGERS. 4 | ⍝ FOR SCALARS AND ARRAYS OF VECTORS OF LENGTH 1 A 5 | ⍝ DENOMINATOR OF 1 IS ADDED. 6 | →NOTEST/BEGIN 7 | DERR QTEST A 8 | BEGIN:→((0=⍴⍴B)∨1=¯1↑⍴B←A)/ADDDEN 9 | RHO←¯1↓⍴A 10 | D←(((RHO,1)↑A)ZGCD0 D)××D←(RHO,¯1)↑A 11 | B←⌊A÷D,D 12 | →0 13 | ADDDEN:B←A,1 14 | ∇ 15 | 16 | ∇C←A QDIFF B 17 | ⍝ COMPUTES THE DIFFERENCE OF TWO RATIONAL ARRAYS. 18 | C←A QSUM QNEG B 19 | ∇ 20 | 21 | ∇C←A QSUM B;RA;RB;AN;AD;BN;BD;NT 22 | ⍝ COMPUTES THE SUM OF TWO RATIONAL ARRAYS. 23 | →NOTEST/BEGIN 24 | A←QNRMLZ A 25 | B←QNRMLZ B 26 | EXPANDV 27 | BEGIN:RA←¯1↓⍴A 28 | RB←¯1↓⍴B 29 | AN←(RA,1)↑A 30 | AD←(RA,¯1)↑A 31 | BN←(RB,1)↑B 32 | BD←(RB,¯1)↑B 33 | NT←NOTEST 34 | NOTEST←1 35 | C←QNRMLZ((AN×BD)+AD×BN),AD×BD 36 | NOTEST←NT 37 | ∇ 38 | 39 | ∇B←QNEG A 40 | ⍝ COMPUTES THE NEGATIVE OF A RATIONAL ARRAY. 41 | →NOTEST/BEGIN 42 | A←QNRMLZ A 43 | BEGIN:B←A×(⍴A)⍴¯1 1 44 | ∇ 45 | 46 | ∇B←QINV A;D 47 | ⍝ COMPUTES THE RECIPROCAL OF A RATIONAL ARRAY. 48 | →NOTEST/BEGIN 49 | A←QNRMLZ A 50 | DERR∧/0≠,1 0/A 51 | BEGIN:B←(⌽A)×D,D←×1 0/A 52 | ∇ 53 | 54 | ∇C←A QPOWER B;RHO;RC;I;J;NOTEST 55 | ⍝ COMPUTES THE B-TH POWER OF THE RATIONAL 56 | ⍝ ARRAY A USING THE BINARY POWER ALGORITHM. 57 | NOTEST←0 58 | A←QNRMLZ A 59 | DERR∧/(,B=⌊B),,B≥0 60 | B←((⍴B),1)⍴B 61 | EXPANDV 62 | RC←(×/¯1↓RHO←⍴A),2 63 | A←RC⍴A 64 | C←RC⍴1 1 65 | I←(B>0)/⍳⍴B←,B 66 | NOTEST←1 67 | LOOP:C[J;]←C[J;]QPROD A[J←(2|B[I])/I;] 68 | →(0=⍴I←(B[I]≥2)/I)/END 69 | A[I;]←A[I;]QPROD A[I;] 70 | B[I]←⌊B[I]÷2 71 | →LOOP 72 | END:C←RHO⍴C 73 | ∇ 74 | 75 | ∇C←A QMATPROD B;⎕IO;X;AX;BX;RR;NOTEST;RA;RB 76 | ⍝ COMPUTES THE MATRIX PRODUCT OF TWO NONSCALAR ARRAYS 77 | ⍝ OF RATIONAL NUMBERS. 78 | ⎕IO←1 79 | NOTEST←0 80 | A←QNRMLZ A 81 | B←QNRMLZ B 82 | DERR∧/2≤(⍴⍴A),⍴⍴B 83 | DERR(⍴A)[¯1+⍴⍴A]=1↑⍴B 84 | C←((RA←¯2↓⍴A),(RB←¯1↓1↓⍴B),2)⍴0 1 85 | X←1=⍳1↑⍴B 86 | RR←((⍴RA)+⍳⍴RB),(⍳⍴RA),⍴⍴C 87 | NOTEST←1 88 | LOOP:AX←RR⍉(RB,RA,2)⍴X/[¯1+⍴⍴A]A 89 | BX←(⍴C)⍴X⌿B 90 | C←C QSUM AX QPROD BX 91 | →(~1↑X←¯1⌽X)/LOOP 92 | ∇ 93 | 94 | ∇C←A QPROD B;NT 95 | ⍝ COMPUTES THE PRODUCT OF TWO RATIONAL ARRAYS. 96 | →NOTEST/BEGIN 97 | A←QNRMLZ A 98 | B←QNRMLZ B 99 | EXPANDV 100 | BEGIN:NT←NOTEST 101 | NOTEST←1 102 | C←QNRMLZ A×B 103 | NOTEST←NT 104 | ∇ 105 | 106 | ∇C←A QQUOT B 107 | ⍝ COMPUTES THE QUOTIENT OF TWO RATIONAL ARRAYS. 108 | C←A QPROD QINV B 109 | ∇ 110 | 111 | ∇T←QTEST A 112 | ⍝ CHECKS WHETHER A REPRESENTS AN ARRAY 113 | ⍝ OF RATIONAL NUMBERS. 114 | →(~T←(∧/,A=⌊A)∧(0=⍴⍴A)∨(0<⍴⍴A)∧∨/1 2=¯1↑⍴A)/0 115 | →((0=⍴⍴A)∨1=¯1↑⍴A)/0 116 | T←∧/0≠,0 1/A 117 | ∇ 118 | -------------------------------------------------------------------------------- /set.apl: -------------------------------------------------------------------------------- 1 | 2 | 3 | ∇W←SSORT V 4 | ⍝ SORTS A VECTOR INTO INCREASING ORDER AND REMOVES 5 | ⍝ DUPLICATES. 6 | DERR 1=⍴⍴V 7 | W←(1,(1↓W)>¯1↓W)/W←V[⍋V] 8 | ∇ 9 | 10 | ∇T←K SSUB N;X 11 | ⍝ LISTS ALL K-ELEMENT SUBSETS OF ⍳N. ORIGIN DEPENDENT. 12 | DERR∧/(K≥0),(K≤N),(1=⍴K),(1=⍴N),(N=⌊N←,N),K=⌊K←,K 13 | →(∧/K≠0 1)/GENERAL 14 | T←((K!N),K)⍴⍳N 15 | →0 16 | GENERAL:T←1+(K-1)SSUB N-1 17 | X←,T[;⎕IO]∘.>⍳N-1 18 | T←(X/(⍴X)⍴⍳N-1),T[X/,⍉((N-1),1↑⍴T)⍴⍳1↑⍴T;] 19 | ∇ 20 | 21 | ∇A←N SCHV S;RS 22 | ⍝ COMPUTES THE CHARACTERISTIC VECTORS OF AN ARRAY OF INTEGER 23 | ⍝ VECTORS LISTING SUBSETS OF ⍳N. ORIGIN DEPENDENT. 24 | →NOTEST/BEGIN 25 | DERR∧/(N>0),(N=⌊N),1=⍴N←,N 26 | DERR∧/(,S=⌊S),(,S≥⎕IO),,S<⎕IO+N 27 | →(0<⍴⍴S)/BEGIN 28 | S←,S 29 | BEGIN:A←(N××/RS←¯1↓⍴S)⍴0 30 | S←((×/RS),¯1↑⍴S)⍴S 31 | A[⎕IO+N⊥((×/⍴S)⍴(⍳1↑⍴S)-⎕IO),[⎕IO-0.5],⍉S-⎕IO]←1 32 | A←(RS,N)⍴A 33 | ∇ 34 | 35 | ∇T←SEQREL E;X;NT 36 | ⍝ TESTS IF E IS THE CHARACTERISTIC MATRIX OF AN 37 | ⍝ EQUIVALENCE RELATION ON ⍳1×⍴E. E MUST BE A 38 | ⍝ SQUARE LOGICAL MATRIX. 39 | →NOTEST/BEGIN 40 | DERR∧/(2=⍴⍴E),(=/⍴E),,E∊0 1 41 | BEGIN:→(~T←∧/(2⍴⎕IO)⍉E)/0 42 | NT←NOTEST 43 | NOTEST←1 44 | T←∧/,E=X∘.=X←SFEL E 45 | NOTEST←NT 46 | ∇ 47 | 48 | ∇R←SFEL A 49 | ⍝ COMPUTES THE FIRST ELEMENTS IN THE SETS WHOSE 50 | ⍝ CHARACTERISTIC VECTORS ARE IN A. 51 | ⍝ THE SETS MUST BE NONEMPTY. 52 | →NOTEST/BEGIN 53 | DERR(1≤⍴⍴A)∧∧/,∨/A 54 | BEGIN:R←⎕IO++/∧\~A 55 | ∇ 56 | -------------------------------------------------------------------------------- /symgroup.apl: -------------------------------------------------------------------------------- 1 | ∇X←N GPCYCIN C;Y;I;D;U 2 | ⍝ CONSTRUCTS THE VECTOR FORM OF THE PERMUTATION OF ⍳N 3 | ⍝ GIVEN AS A PRODUCT OF CYCLES IN THE CHARACTER VECTOR C. 4 | ⍝ THE CYCLES DO NOT NEED TO BE DISJOINT. ORIGIN DEPENDENT. 5 | DERR(1=⍴N)∧N=⌊N←,N 6 | X←⍳N 7 | C←(C≠' ')/C←,C 8 | ⍝ GET THE NEXT CYCLE. 9 | LOOP:→(0=⍴C)/0 10 | D←(I←(C⍳')')+1-⎕IO)↑C 11 | C←I↓C 12 | DERR('('=1↑D)∧')'=¯1↑D 13 | D←¯1↓1↓D 14 | D[(D=',')/⍳⍴D]←' ' 15 | DERR∧/D∊'0123456789' 16 | DERR(⍴U)=⍴SSORT U←,¯D 17 | DERR∧/U0)/GENERAL 46 | T←1 0⍴0 47 | →0 48 | GENERAL:T←((!N),N-1)⍴GPSYMG N-1 49 | V←,⍉((!N-1),N)⍴(⍳N)-⎕IO 50 | T←V⌽((-V)⌽T),N+⎕IO-1 51 | ∇ 52 | 53 | ∇T←GPTEST A;M;N;Z 54 | ⍝ CHECKS THAT A IS AN ARRAY OF PERMUTATIONS. 55 | →(~T←∧/(1≤⍴⍴A),,A=⌊A)/0 56 | →(~T←(∧/,A≥⎕IO)∧∧/A<⎕IO+N←¯1↑⍴A)/0 57 | Z←(×/⍴A)⍴0 58 | Z[(,A)+,⍉(N,M)⍴N×(⍳M←×/¯1↓⍴A)-⎕IO]←1 59 | T←∧/Z 60 | ∇ 61 | 62 | ∇H←GPSGP X;N;HP;V;VP 63 | ⍝ COMPUTES THE PERMUTATION GROUP GENERATED BY THE 64 | ⍝ ROWS OF THE MATRIX X. VALID FOR DEGREES AT MOST 12. 65 | ⍝ WORKSPACE FULL ERRORS ARE LIKELY FOR DEGREES OVER 7. 66 | DERR(GPTEST X)∧(2=⍴⍴X)∧12≥¯1↑⍴X 67 | N←¯1↑⍴X 68 | H←(N⍴N+1)⊤HP←SSORT(N+1)⊥(⍳N),V←X←⍉X 69 | LOOP:HP←HP,VP←SSORT(~VP∊HP)/VP←,(N+1)⊥X[V;] 70 | H←H,V←(N⍴N+1)⊤VP 71 | →(0≠⍴VP)/LOOP 72 | H←⍉H 73 | ∇ 74 | 75 | ∇B←GPSGN A;C;D;N 76 | ⍝ COMPUTES THE SIGNS OF THE PERMUTATIONS IN A. 77 | →NOTEST/BEGIN 78 | DERR GPTEST A 79 | BEGIN:D←((⍳¯2+⍴⍴C),⎕IO+(⍴⍴C)-1 2)⍉C←A∘.×(N←¯1↑⍴A)⍴1 80 | B←¯1*+/+/(C>D)∧(⍴C)⍴(⍳N)∘.<⍳N 81 | ∇ 82 | 83 | ∇C←A GPORBIT I;V 84 | ⍝ COMPUTES A LIST C AND THE CHARACTERISTIC VECTOR x 85 | ⍝ OF THE ORBIT CONTAINING I OF THE PERMUATION GROUP 86 | ⍝ GENERATED BY THE ROWS OF THE MATRIX A. 87 | DERR(1=⍴I)∧(2=⍴⍴A)∧(∧/I=⌊I←,I)∧GPTEST A 88 | x←(¯1↑⍴A)⍴0 89 | x[C←V←I]←1 90 | LOOP:C←C,V←SSORT(~x[V])/V←,A[;V] 91 | x[V]←1 92 | →(0≠⍴V)/LOOP 93 | C←SSORT C 94 | ∇ 95 | 96 | ∇B←GPALLORB A;N;x;I;NOTEST;C 97 | ⍝ COMPUTES A SUMMARY OF THE ORBITS OF THE PERMUTATION 98 | ⍝ GROUP GENERATED BY THE ROWS OF THE MATRIX A. 99 | ⍝ THE FIRST ROW OF B GIVES THE LENGTHS OF THE ORBITS. 100 | ⍝ THE SECOND ROW OF B GIVES REPRESENTATIVES. 101 | ⍝ q[I] IS THE FIRST POINT IN THE ORBIT CONTAINING I. 102 | DERR(GPTEST A)∧2=⍴⍴A 103 | q←(N←¯1↑⍴A)⍴¯1 104 | B←2 0⍴0 105 | NOTEST←1 106 | LOOP:→((N+⎕IO)≤I←q⍳¯1)/0 107 | q[C←A GPORBIT I]←I 108 | B←B,I,⍴C 109 | →LOOP 110 | ∇ 111 | -------------------------------------------------------------------------------- /translate.txt: -------------------------------------------------------------------------------- 1 | O N Code point 2 | û ⍋ 0xDB 3 |  ⎕ 0x90 4 |  ⊥ 5 | ’ 6 | ˜ ⊤ 7 | Ç ↓ 0xC7 8 | ∊ ¯ 0x220A 9 | ¸ → 0xB8 10 | ∆ ⍴ 11 | ⎕ ≥ 12 | ó ≤ 0xF3 13 | ð ⌿ 0xF0 14 | õ × 15 | ö ÷ 16 | í ⍉ 17 | î ∊ î'1234567890+¯' 18 | ø ∘ 19 | ≤ ⌊ x2264 20 | © ⌈ 0xA9 21 | ® ⍕ 0xAE 22 | ⌈ ⍳ 23 | ∨ ⌽ 24 | × ↑ 25 | ∧ ∨ ?? 26 | 27 | 0161 [X 'U←FRINV/⌈∆FRINV←(∧/íC)∧{∧}/C←B=1' 28 | 0571 [XM AX RXPROD BX' '¸(~1×X←∊1∨X)/LOOP' 'D←1©©/,+/{∧}\∨0≠C' 29 | ---- 30 | 31 | Those work as expected 32 | ASCIIs 33 | ∇ ⍝ ← 34 | 35 | ---- 36 | 37 | Not good 38 | ⍒ ⊤ ∩ ∪ ⍎ ⊖ ⌹ ○ ⍟ ¨ ⍀ 39 | -------------------------------------------------------------------------------- /utils.apl: -------------------------------------------------------------------------------- 1 | ∇DERR T 2 | ⍝ IF T IS FALSE, A MESSAGE IS PRINTED AND ALL ACTIVE 3 | ⍝ PROCEDURES ARE TERMINATED. 4 | →T/0 5 | 'PROCEDURE DOMAIN ERROR' 6 | → 7 | ∇ 8 | ∇X←DAQ A;NA;RA;M;K;R 9 | ⍝ PRODUCES THE CHARACTER ARRAY FOR DISPLAYING AN 10 | ⍝ ARRAY OF RATIONAL NUMBERS. 11 | X←'' 12 | →(0=NA←×/⍴A)/0 13 | RA←⍴A←QNRMLZ A 14 | M←1⌈¯1↓¯2↑RA 15 | K←¯1↑⍴X←⍕(NA,1)⍴A 16 | R←(¯1++/X=' ')×NA⍴0 1 17 | X←R⌽X 18 | X←((×/¯1↓RA),2×K)⍴X 19 | X[;K+⎕IO]←'/' 20 | X←X,' ' 21 | X←((¯2↓RA),M×^1↑⍴X)⍴X 22 | ∇ 23 | 24 | ∇X←P DARV A;NA;RA;M;K 25 | ⍝ PRODUCES THE CHARACTER ARRAY DISPLAYING AN ARRAY 26 | ⍝ OF REAL VECTORS WITH P DECIMAL PLACES. 27 | X←'' 28 | →(0=NA←×/RA←⍴A)/0 29 | M←1⌈¯1↓¯2↑RA 30 | K←¯1↑⍴X←P⍕(NA,1)⍴A 31 | X←((×/¯1↓RA),Kׯ1↑RA)⍴X 32 | X←(0 2+⍴X)↑X 33 | X←((¯2↓RA),Mׯ1↑⍴X)⍴X 34 | ∇ 35 | 36 | ∇X←DAZV A 37 | ⍝ PRODUCES THE CHARACTER ARRAY DISPLAYING AN ARRAY 38 | ⍝ OF INTEGER VECTORS OR REAL VECTORS ROUNDED TO THE 39 | ⍝ NEAREST INTEGER. 40 | X←'' 41 | →(0=×/⍴A)/0 42 | X←0 DARV A 43 | ∇ 44 | 45 | ∇EXPANDV;RA;NA;RB;NB 46 | ⍝ TESTS IF TWO ARRAYS OF VECTORS ARE CONFORMABLE FOR 47 | ⍝ SCALAR OPERATIONS AND IF SO, EXPANDS ONE, IF 48 | ⍝ NECESSARY, SO THAT THEY HAVE THE SAME SHAPE ALONG ALL 49 | ⍝ BUT THE LAST AXIS. IF THEY ARE NOT CONFORMABLE, ALL 50 | ⍝ PROCESSING IS STOPPED. 51 | ⍝ SCALARS ARE REPLACED BY VECTORS OF LENGTH 1. 52 | →(1≤⍴⍴A)/CHECKB 53 | A←,A 54 | CHECKB:→(1≤⍴⍴B)/NEXT 55 | B←,B 56 | ⍝ IF A OR B HAS ONE ENTRY, THE ARE CONFORMABLE. 57 | NEXT:→(∧/1=(NA←×/RA←¯1↓⍴A),NB←×/RB←¯1↓⍴B)/EXP 58 | →((⍴RA)≠⍴RB)/RNKERR 59 | →(∧/RA≠RB)/LENERR 60 | →0 61 | RNKERR:'VECTOR RANK ERROR' 62 | → 63 | LENERR:'VECTOR LENGTH ERROR' 64 | → 65 | EXP:→((NA≠1)∧(NA=1)∧(NB=1)∧(⍴RA)>⍴RB)/EXPB 66 | A←(RB,¯1↑⍴A)⍴A 67 | →0 68 | EXPB:B←(RA,¯1↑⍴B)⍴B 69 | ∇ 70 | 71 | ∇EXPAND;RA;NA;RB;NB 72 | ⍝ PROCEDURE TO TEST IF THE GLOBAL VARIABLES A AND B ARE 73 | ⍝ CONFORMABLE FOR SCALAR OPERATIONS AND IF SO, TO EXPAND 74 | ⍝ ONE OF THEM, IF NECESSARY, SO THAT THEY HAVE THE SAME 75 | ⍝ SHAPE. IF THEY ARE NOT CONFORMABLE, ALL PROCESSING IS 76 | ⍝ STOPPED. IF EITHER A OR B HAS ONE ENTRY, THEY ARE 77 | ⍝ CONFOMRABLE. 78 | →(∧/1=(NA←×/RA←⍴A),NB←×/RB←⍴B)/EXP 79 | ⍝ OTHERWISE, THEY MUST HAVE THE SAME RANK. 80 | →((⍴RA)≠⍴RB)/RNKERR 81 | ⍝ AND THE SAME SHAPE. 82 | →(∧/RA≠RB)/LENERR 83 | →0 84 | RNKERR:'PROCEDURE RANK ERROR' 85 | → 86 | LENERR:'PROCEDURE LENGTH ERROR' 87 | → 88 | ⍝ SEE WHICH ARRAY MUST BE EXPANDED. 89 | EXP:→((NA≠1)∧(NA=1)∧(NB=1)∧(⍴RA)>⍴RB)/EXB 90 | ⍝ EXPAND A 91 | →0,⍴A←RB⍴A 92 | ⍝ EXPAND B 93 | EXB:B←RA⍴B 94 | ∇ 95 | 96 | ∇B←TRAV A;R 97 | ⍝ TRANSPOSES AN ARRAY OF VECTORS. 98 | →(1≥⍴⍴A)/SMALL 99 | R←⍳⍴⍴A 100 | B←((⌽¯1↓R),¯1↑R)⍉A 101 | →0 102 | SMALL:B←A 103 | ∇ 104 | -------------------------------------------------------------------------------- /z.apl: -------------------------------------------------------------------------------- 1 | ∇P←ZFACTOR N;Q;R;⎕IO 2 | ⍝ FACTORS A POSITIVE INTEGER INTO A PRODUCT OF PRIMES. 3 | ⍝ THE RESULT IS CORRECT IF N IS LESS THAN 2.5E9. 4 | DERR∧/(N=⌊N),(1≤N),1=⍴N←,N 5 | P←⍳⎕IO←0 6 | Q←2 3 5,R←,(30×⍳77⌊⌈(N*0.5)÷30)∘.+7 11 13 17 19 23 29 31 7 | LOOP:→(0=⍴Q←(0=Q|N)/Q)/NEXT 8 | P←P,1↑Q 9 | →LOOP,N←⌊N÷Q[0] 10 | NEXT:→(N=1)/0 11 | →((¯1↑R)≥50000⌊N*0.5)/END 12 | →(R[0]≠7)/GEN 13 | R←(∧⌿0≠7 11∘.|R)/R 14 | GEN:Q←R←R+2310 15 | →LOOP 16 | END:P←P,N 17 | ∇ 18 | 19 | ∇C←A ZGCD B;⎕IO;RHO;M;U;V;I;Q;T 20 | ⍝ C IS RETURNED AS THE ENTRY-BY-ENTRY GCD OF THE INTEGER 21 | ⍝ ARRAYS A AND B. 22 | ⍝ THE VARIABLES r AND s EXPRESS C AS(r×A)+s×B. 23 | ⎕IO←1 24 | →NOTEST/BEGIN 25 | DERR∧/(,A=⌊A),,B=⌊B 26 | ⍝ TEST FOR CONFORMABILITY. 27 | EXPAND 28 | ⍝ REPLACE A AND B BY THEIR RAVELS AND 29 | ⍝ APPLY THE EUCLIDEAN ALGORITHM. 30 | BEGIN:M←×/RHO←⍴A 31 | U←(3,M)⍴(×A),(M⍴0),|A←,A 32 | V←(⍴U)⍴(M⍴0),(×B),|B←,B 33 | I←⍳M 34 | LOOP:→(0=⍴I←(V[3;I]≠0)/I)/END 35 | T←U[;I]-V[;I]×(3,⍴I)⍴⌊U[3;I]÷V[3;I] 36 | U[;I]←V[;I] 37 | V[;I]←T 38 | →LOOP 39 | END:C←RHO⍴U[3;] 40 | r←RHO⍴U[1;] 41 | s←RHO⍴U[2;] 42 | ∇ 43 | 44 | ∇C←A ZGCD0 B;RHO;T;I 45 | ⍝ COMPUTES INTEGER GCD''S WITH A MINIMUM AMOUNT OF 46 | ⍝ CHECKING AND WITHOUT EXPRESSING THE RESULT AS A 47 | ⍝ LINEAR COMBINATION OF THE ARGUMENTS. 48 | →NOTEST/BEGIN 49 | DERR∧/(,A=⌊A),,B=⌊B 50 | EXPAND 51 | BEGIN:RHO←⍴A 52 | I←⌈⍴A←|,A 53 | B←|,B 54 | LOOP:→(0=⍴I←(B[I]≠0)/I)/END 55 | T←B[I]|A[I] 56 | A[I]←B[I] 57 | B[I]←T 58 | →LOOP 59 | END:C←RHO⍴A 60 | ∇ 61 | 62 | ∇C←A ZQUOT B 63 | ⍝ COMPUTES THE INTEGER QUOTIENT OF TWO INTEGER ARRAYS. 64 | →NOTEST/BEGIN 65 | DERR∧/(,A=⌊A),,B=⌊B 66 | BEGIN:C←(⌊A÷|B)××B 67 | ∇ 68 | 69 | ∇C←A ZREM B 70 | ⍝ COMPUTES THE REMAINDER WHEN B IS DIVIDED BY A. 71 | ⍝ BOTH ARRAYS MUST BE INTEGER. 72 | →NOTEST/BEGIN 73 | DERR∧/(,A=⌊A),,B=⌊B 74 | BEGIN:C←(|A)|B 75 | ∇ 76 | 77 | ∇C←A ZCHREM B;⎕IO;r;s;RHO;D;L;M;N;B1;B2;A1;F;E;X 78 | ⍝ SOLVES THE SIMULTANEOUS CONGRUENCE C CONGRUENT 79 | ⍝ TO THE I-TH CROSS SECTION OF A ALONG THE LAST AXIS 80 | ⍝ MODULO B[I]. THE VARIABLE B MUST BE A VECTOR AND 81 | ⍝ THE LCM OF THE COMPONENTS OF B IN COMPUTED AS m. 82 | ⎕IO←1 83 | X←∧/(1=⍴⍴B),(1≤⍴⍴A),((¯1↑⍴A)=⍴B),(0<⍴B),,0≠B←|B 84 | DERR∧/X,(,B=⌊B),,A=⌊A 85 | A←((N←×/RHO←¯1↓⍴A),¯1↑⍴A)⍴A 86 | LOOP:→(1=M←⍴B)/END 87 | L←B1×⌊B2÷D←(B1←E↑B)ZGCD B2←(-E←⌊M÷2)↑B 88 | DERR∧/,0=((⍴F)⍴D)|F←((N,-E)↑A)-A1←(N,E)↑A 89 | B←B[X←(E+1)×⍳M≠2×E],L 90 | A←(A[;X]),((⍴F)⍴L)|A1+(⌊F÷(⍴F)⍴D)×(⍴F)⍴r×B1 91 | →LOOP 92 | END:m←B[1] 93 | C←RHO⍴A 94 | ∇ 95 | 96 | ∇P←ZPRIMES N;⎕IO;Q;R 97 | ⍝ LISTS THE PRIMES UP TO N. 98 | ⎕IO←0 99 | DERR 1=⍴N←,N 100 | P←(N≥P)/P←2 3 5 7 11 13 17 19 101 | →(N≤22)/0 102 | Q←,(30×⍳⌈N÷30)∘.+7 11 13 17 19 23 29 31 103 | Q←(∧⌿0≠7 11 13 17 19∘.|Q)/Q 104 | LOOP:→((0=⍴Q)∨N<(1↑Q)*2)/END 105 | P←P,R←(5⌊⍴Q)↑Q 106 | Q←(∧⌿0≠R∘.|Q)/Q 107 | →LOOP 108 | END:P←(N≥P)/P←P,Q 109 | ∇ 110 | 111 | ∇D←ZDET A;⎕IO;V;J;W;Q 112 | ⍝ COMPUTES THE DETERMINANT OF AN INTEGER MATRIX 113 | ⍝ USING INTEGER ROW OPERATIONS. 114 | DERR∧/(,A=⌊A),(2=⍴⍴A),=/⍴A 115 | D←⎕IO←1 116 | →(0=1↑⍴A)/0 117 | LOOP:→(1=1↑⍴A)/END 118 | BACK:→(∧/0=V←|A[;1])/ZERO 119 | J←V⍳⌊/(V≠0)/V 120 | →(J=1)/OK 121 | A[1,J;]←A[J,1;] 122 | D←-D 123 | OK:→(∧/0=W←1↓A[;1])/ENDLP 124 | Q←0,(⌊W÷|A[1;1])××A[1;1] 125 | A←A-Q∘.×A[1;] 126 | →BACK 127 | ENDLP:D←D×A[1;1] 128 | A←1 1↓A 129 | →LOOP 130 | ZERO:→D←0 131 | END:D←D×A[1;1] 132 | ∇ 133 | 134 | ∇C←A ZLCM B 135 | ⍝ COMPUTES THE ENTRY-BY-ENTRY LCM OF THE 136 | ⍝ INTEGER ARRAYS A AND B. 137 | C←(C≠0)×⌊(C←|A×B)÷A ZGCD0 B 138 | ∇ 139 | 140 | ∇C←A ZLSYS B;⎕IO;M;D;Q;r;s 141 | ⍝ SOLVES LINEAR SYSTEMS OVER THE INTEGERS. 142 | ⍝ A IS THE MATRIX OF COEFFICIENTS AND THE VECTORS 143 | ⍝ OF CONSTANT TERMS ARE THE VECTORS ALONG THE FIRST 144 | ⍝ AXIS OF B. THE ROWS OF THE GLOBAL ARRAY w 145 | ⍝ ARE A BASIS FOR THE SOLUTIONS OF THE CORRESPONDING 146 | ⍝ HOMOGENEOUS SYSTEM. 147 | ⎕IO←1 148 | DERR∧/(2=⍴⍴A),(,A=⌊A),(,B=⌊B),(1≤⍴⍴B),(1↑⍴A)=1↑⍴B 149 | D←(M←+/D≠0)↑D←1 1⍉A←ZREDUCE A 150 | DERR∧/,0=(M,(¯1+⍴⍴B)⍴0)↓B←r+.×B 151 | w←⍉(0,M)↓s 152 | DERR∧/0=(Q←⍉(⌽⍴B)⍴D)|B←(M,1↓⍴B)↑B 153 | C←(((1↑⍴s),M)↑s)+.×⌊B÷Q 154 | ∇ 155 | 156 | ∇B←ZREDUCE A;⎕IO;I;J;K;L;M;Q;D;Y;Z;X;V 157 | ⍝ REDUCES AN INTEGER MATRIX. PRODUCES INVERTIBLE 158 | ⍝ INTEGER MATRICES r AND s SUCH THAT B IS 159 | ⍝ THE MATRIX PRODUCT OF r, A AND s. 160 | ⎕IO←0 161 | DERR∧/(2=⍴⍴A),,B=⌊B←A 162 | r←(K,K)⍴1,(K←1↑⍴B)⍴0 163 | s←(L,L)⍴1,(L←1↓⍴B)⍴0 164 | I←¯1 165 | LOOPI:→(∧/0=D←|,(I,I←I+1)↓B)/0 166 | V←I+((⍴B)-I)⊤D⍳⌊/(D≠0)/D 167 | X←B[J←V[0];K←V[1]] 168 | COL:→(∧/0=D←|X|B[;K])/ROW 169 | L←D⍳⌊/(D≠0)/D 170 | B[L;]←B[L;]-(Q←⌊(B[L;K]-X|B[L;K])÷X)×B[J;] 171 | r[L;]←r[L;]-Q×r[J;] 172 | X←B[J←L;K] 173 | →COL 174 | ROW:→(∧/0=D←|X|B[J;])/GENERAL 175 | M←D⍳⌊/(D≠0)/D 176 | B[;M]←B[;M]-(Q←⌊(B[J;M]-X|B[J;M])÷X)×B[;K] 177 | s[;M]←s[;M]-Q×s[;K] 178 | X←B[J;K←M] 179 | →COL 180 | GENERAL:→(∧/0=D←|X|,(I,I)↓B)/END 181 | V←I+((⍴B)-I)⊤D⍳⌊/(D≠0)/D 182 | B[L;]←B[L;]-(Q←¯1+⌊B[L←V[0];K]÷X)×B[J;] 183 | r[L;]←r[L;]-Q×r[J;] 184 | B[;M]←B[;M]-(Q←⌊(B[L;M]-X|B[L;M←V[1]])÷X)×B[;K] 185 | s[;M]←s[;M]-Q×s[;K] 186 | X←B[J←L;K←M] 187 | →COL 188 | END:B[I,J;]←B[J,I;] 189 | r[I,J;]←r[J,I;] 190 | B[;I,K]←B[;K,I] 191 | s[;I,K]←s[;K,I] 192 | B[I;]←B[I;]××X 193 | r[I;]←r[I;]××X 194 | B[Y;]←B[Y;]-(Q←⌊B[Y←(I+1)↓⍳1↑⍴B;I]÷B[I;I])∘.×B[I;] 195 | r[Y;]←r[Y;]-Q∘.×r[I;] 196 | B[;Z]←B[;Z]-B[;I]∘.×Q←⌊B[I;Z←(I+1)↓⍳1↓⍴B]÷B[I;I] 197 | s[;Z]←s[;Z]-s[;I]∘.×Q 198 | →LOOPI 199 | ∇ 200 | 201 | ∇B←ZROWREDUCE A;IO;I;J;K;L;D;E;F;X;Y;N;M 202 | ⍝ ROW REDUCES THE INTEGER MATRIX A. PRODUCES r, AN 203 | ⍝ INVERTIBLE INTEGER MATRIX SUCH THAT B IS r+.×A. 204 | ⍝ ALSO PRODUCES A VECTOR v LISTING THE COLUMNS CONTAINING 205 | ⍝ THE CORNER ENTRIES OF B. 206 | DERR∧/(2=⍴⍴A),,A=⌊A 207 | IO←⎕IO 208 | ⎕IO←1 209 | L←¯1↑⍴B←A 210 | r←(K,K)⍴1,(K←1↑⍴B)⍴0 211 | v←⍳I←J←0 212 | LOOP:→((J≥K)∨L