From e3bbf04ce1b93e23da8a7635c56d934e3935b4c5 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sat, 7 Jul 2018 11:01:18 -0700 Subject: [PATCH] Fix example and describe functions in Macsyma. Resolves ticket #967. --- Makefile | 2 +- build/lisp.tcl | 1 + src/demo/manual.78 | 930 +++++++++++++++++++++++++++++++++++++++++++ src/maxsrc/descri.59 | 230 +++++++++++ 4 files changed, 1162 insertions(+), 1 deletion(-) create mode 100644 src/demo/manual.78 create mode 100644 src/maxsrc/descri.59 diff --git a/Makefile b/Makefile index 7025adc2..04159491 100644 --- a/Makefile +++ b/Makefile @@ -10,7 +10,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ spcwar rwg libmax rat z emaxim rz maxtul aljabr cffk das ell ellen \ jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ - draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls + draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/build/lisp.tcl b/build/lisp.tcl index 35801b70..0c3fe235 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -537,6 +537,7 @@ respond "T" "(loader 1000)" respond "(C1)" "quit();" respond "*" ":link sys3;ts macsym,maxdmp;loser >\r" +respond "*" ":link demo;manual demo,demo;manual >\r" ### build ctensr for macsyma # ejs: commented out until we can fix NXM error in KA10 emulator diff --git a/src/demo/manual.78 b/src/demo/manual.78 new file mode 100644 index 00000000..2813143b --- /dev/null +++ b/src/demo/manual.78 @@ -0,0 +1,930 @@ + +/* This file is to be run by the EXAMPLE command, and may not + otherwise work. */ + +functions&& F(X):=X^2+Y; +F(2); +EV(F(2),Y:7); +F(X):=SIN(X)^2+1; +F(X+1); +G(Y,Z):=F(Z)+3*Y; +EV(G(2*Y+Z,-0.5),Y:7); +H(N):=SUM(I*X^I,I,0,N); +FUNCTIONS; +T[N](X):=RATEXPAND(2*X*T[N-1](X)-T[N-2](X)); +T[0](X):=1$ +T[1](X):=X$ +T[4](Y); +G[N](X):=SUM(EV(X),I,N,N+2); +H(N,X):=SUM(EV(X),I,N,N+2); +G[2](I^2); +H(2,I^2); +P[N](X):=RATSIMP(1/(2^N*N!)*DIFF((X^2-1)^N,X,N)); +Q(N,X):=RATSIMP(1/(2^N*N!)*DIFF((X^2-1)^N,X,N)); +P[2]; +P[2](Y+1); +Q(2,Y+1); +P[2](5); +F[I,J](X,Y):=X^I+Y^J; +G(FUN,A,B):=PRINT(FUN," applied to ",A," and ",B," is ",FUN(A,B))$ +G(F[2,1],SIN(%PI),2*C); +arrays&& A[N]:=N*A[N-1]; +A[0]:1$ +A[5]; +A[N]:=N$ +A[6]; +A[4]; +lambda&& LAMBDA([X,Y,Z],X^2+Y^2+Z^2); +%(1,2,A); +"+"(1,2,A); +lists&& [X^2,Y/3,-2]; +%[1]*X; +[A,%TH(2),%]; +matrices&& M:MATRIX([A,0],[B,1]); +M^2; +M.M; +M[1,1]*M; +%-%TH(2)+1; +M^^-1; +[X,Y].M; +MATRIX([A,B,C],[D,E,F],[G,H,I]); +%^^2; +equations&& X+1=Y^2; +X-1=2*Y+1$ +%TH(2)+%; +%TH(3)/Y; +1/%; +if&& FIB[N]:=IF N=1 OR N=2 THEN 1 ELSE FIB[N-1]+FIB[N-2]; +FIB[1]+FIB[2]; +FIB[3]; +FIB[5]; +ETA(MU,NU):=IF MU=NU THEN MU ELSE IF MU>NU THEN MU-NU ELSE MU+NU; +ETA(5,6); +ETA(ETA(7,7),ETA(1,2)); +IF NOT 5>=2 AND 6<=5 OR 4+1>3 THEN A ELSE B; +block&& HESSIAN(F):=BLOCK([DFXX,DFXY,DFXZ,DFYY,DFYZ,DFZZ], + DFXX:DIFF(F,X,2),DFXY:DIFF(F,X,1,Y,1), + DFXZ:DIFF(F,X,1,Z,1),DFYY:DIFF(F,Y,2), + DFYZ:DIFF(F,Y,1,Z,1),DFZZ:DIFF(F,Z,2), + DETERMINANT(MATRIX([DFXX,DFXY,DFXZ],[DFXY,DFYY,DFYZ], + [DFXZ,DFYZ,DFZZ])))$ +HESSIAN(X^3-3*A*X*Y*Z+Y^3); +SUBST(1,Z,QUOTIENT(%,-54*A^2)); +F(X):=BLOCK([Y], LOCAL(A), Y:4, A[Y]:X, DISPLAY(A[Y]))$ +Y:2$ +A[Y+2]:0$ +F(9); +A[Y+2]; +do&& FOR A:-3 THRU 26 STEP 7 DO LDISPLAY(A)$ +S:0$ +FOR I:1 WHILE I<=10 DO S:S+I; +S; +SERIES:1$ +TERM:EXP(SIN(X))$ +FOR P:1 UNLESS P>7 DO + (TERM:DIFF(TERM,X)/P, + SERIES:SERIES+SUBST(X=0,TERM)*X^P)$ +SERIES; +POLY:0$ +FOR I:1 THRU 5 DO + FOR J:I STEP -1 THRU 1 DO + POLY:POLY+I*X^J$ +POLY; +GUESS:-3.0$ +FOR I THRU 10 DO (GUESS:SUBST(GUESS,X,0.5*(X+10/X)), + IF ABS(GUESS^2-10)<0.00005 THEN RETURN(GUESS)); +FOR COUNT:2 NEXT 3*COUNT THRU 20 + DO LDISPLAY(COUNT)$ +X:1000; +THRU 10 WHILE X#0 DO X:0.5*(X+5/X)$ +X; +REMVALUE(X); +NEWTON(F,GUESS):=BLOCK([NUMER,Y], + LOCAL(DF), NUMER:TRUE, + DEFINE(DF(X),DIFF(F(X),X)), + DO (Y:DF(GUESS), IF Y=0 THEN ERROR( + "derivative at",GUESS,"is zero"), + GUESS:GUESS-F(GUESS)/Y, + IF ABS(F(GUESS))<5.0E-6 THEN RETURN(GUESS)))$ +SQR(X):=X^2-5.0$ +NEWTON(SQR,1000); +FOR F IN [LOG, RHO, ATAN] DO LDISP(F(1.0))$ +EV(CONCAT(E,LINENUM-1),NUMER); +evaluation&& DIFF(X*F(X),X); +F(X):=SIN(X)$ +EV(%TH(2),DIFF); +X; +X:3$ +X; +'X; +F(X):=X^2; +'F(2); +EV(%,F); +'(F(2)); +''%; +SUM(I!,I,1,4); +'SUM(I!,I,1,4); +'INTEGRATE(F(X),X,A,B); +FOR I THRU 5 DO S:S+I^2; +S; +EV(%,S:0); +EV(%TH(2)); +'SUM(G(I),I,0,N); +Z*%E^Z; +EV(%,Z:X^2); +SUBST(X^2,Z,%TH(3)); +A:%; +A+1; +KILL(A); +A; +DECLARE(INTEGRATE,NOUN)$ +INTEGRATE(Y^2,Y); +''INTEGRATE(Y^2,Y); +F(Y):=DIFF(Y*LOG(Y),Y,2); +F(Y):=''(DIFF(Y*LOG(Y),Y,2)); +''(CONCAT(C,LINENUM-1)); +(X+Y)^3$ +DIFF(%,X); +Y:X^2+1$ +''(CONCAT(C,LINENUM-2)); +exp&& EV(%E^X*SIN(X)^2,EXPONENTIALIZE); +INTEGRATE(%,X); +EV(%,DEMOIVRE); +ANS:EV(%,RATEXPAND); +EV(%,X:1,NUMER)-EV(%,X:0,NUMER); +INTEGRATE(%E^X*SIN(X)^2,X); +TRIGREDUCE(%); +%-ANS; +EV(SIN(X),%EMODE); +trig&& SIN(%PI/12)+TAN(%PI/6); +EV(%,NUMER); +SIN(1); +SIN(1),NUMER; +BETA(1/2,2/5); +EV(%,NUMER); +DIFF(ATANH(SQRT(X)),X); +FPPREC:25$ +SIN(0.5B0); +COS(X)^2-SIN(X)^2; +EV(%,X:%PI/3); +DIFF(%TH(2),X); +INTEGRATE(%TH(3),X); +EXPAND(%); +TRIGEXPAND(%); +TRIGREDUCE(%); +SECH(X)^2*SINH(X)*TANH(X)/COTH(X)^2 + COSH(X)^2*SECH(X)^2*TANH(X)/COTH(X)^2 + + SECH(X)^2*TANH(X)/COTH(X)^2; +TRIGSIMP(%); +EV(SIN(X),EXPONENTIALIZE); +TAYLOR(SIN(X)/X,X,0,4); +EV(COS(X)^2-SIN(X)^2,SIN(X)^2=1-COS(X)^2); +complex&& (SQRT(-4)+SQRT(2.25))^2; +EXPAND(%); +EXPAND(SQRT(2*%I)); +ev&& SIN(X)+COS(Y)+(W+1)^2+'DIFF(SIN(W),W); +EV(%,SIN,EXPAND,DIFF,X=2,Y=1); +EV(X+Y,X:A+Y,Y:2); +'DIFF(Y^2+X*Y+X^2,X,2,Y,1); +EV(%,DIFF); +2*X-3*Y=3$ +-3*X+2*Y=-4$ +SOLVE([%TH(2),%]); +EV(%TH(3),%); +X+1/X>GAMMA(1/2); +EV(%,NUMER,X=1/2); +EV(%,PRED); +zeroequiv&& ZEROEQUIV(SIN(2*X)-2*SIN(X)*COS(X),X); +ZEROEQUIV(%E^X+X,X); +ZEROEQUIV(LOG(A*B)-LOG(A)-LOG(B),A); +expand&& (1/(X+Y)^4-3/(Y+Z)^3)^2; +EXPAND(%,2,0); +EXPAND(A.(B+C.(D+E)+F)); +EXPAND((X+1)^3); +(X+1)^7; +EXPAND(%); +EXPAND(%TH(2),7,7); +EV(A*(B+C)+A*(B+C)^2,EXPOP:1); +ratexpand&& RATEXPAND((2*X-3*Y)^3); +(X-1)/(X+1)^2+1/(X-1); +EXPAND(%); +RATEXPAND(%TH(2)); +ratsimp&& SIN(X/(X^2+X))=%E^((LOG(X)+1)^2-LOG(X)^2); +RATSIMP(%); +B*(A/B-X)+B*X+A; +RATSIMP(%); +((X-1)^(3/2)-(X+1)*SQRT(X-1))/SQRT((X-1)*(X+1)); +RATSIMP(%); +EV(X^(A+1/A),RATSIMPEXPONS); +radcan&& (LOG(X^2+X)-LOG(X))^A/LOG(X+1)^(A/2); +RADCAN(%); +LOG(A^(2*X)+2*A^X+1)/LOG(A^X+1); +RADCAN(%); +(%E^X-1)/(%E^(X/2)+1); +RADCAN(%); +multthru&& X/(X-Y)^2-1/(X-Y)-F(X)/(X-Y)^3; +MULTTHRU((X-Y)^3,%); +RATEXPAND(%); +((A+B)^10*S^2+2*A*B*S+(A*B)^2)/(A*B*S^2); +MULTTHRU(%); +MULTTHRU(A.(B+C.(D+E)+F)); +xthru&& ((X+2)^20-2*Y)/(X+Y)^20+(X+Y)^-19-X/(X+Y)^20; +XTHRU(%); +partfrac&& 2/(X+2)-1/(X+1)-X/(X+1)^2; +RATSIMP(%); +PARTFRAC(%,X); +factor&& FACTOR(2^63-1); +FACTOR(Z^2*(X+2*Y)-4*X-8*Y); +X^2*Y^2+2*X*Y^2+Y^2-X^2-2*X-1; +DONTFACTOR:[X]$ +FACTOR(%/36/(Y^2+2*Y+1)); +FACTOR(%E^(3*X)+1); +FACTOR(X^4+1,A^2-2); +FACTOR(X^3+X^2*Y^2-X*Z^2-Y^2*Z^2); +(X+2)/(X+3)/(X+B)/(X+C)^2; +RATSIMP(%); +PARTFRAC(%,X); +MAP(FACOR,%); +RATSIMP((X^5-1)/(X-1)); +SUBST(A,X,%); +FACTOR(%TH(2),%); +MAP(FACTOR,%TH(2)),POWERDISP; +FACTOR(X^6+1); +FACTOR(X^12+1); +FACTOR(X^99+1); +factorsum&& EV((X+1)*((U+V)^2+A*(W+Z)^2),EXPAND); +FACTORSUM(%); +sqfr&& SQFR(4*X^4+4*X^3-3*X^2-4*X-1); +gfactor&& GFACTOR(X^4-1); +partition&& PARTITION(2*A*X*F(X),X); +PARTITION(A+B,X); +logcontract&& 2*(A*LOG(X) + 2*A*LOG(Y)); +LOGCONTRACT(%); +LOGCONTRACT(LOG(SQRT(X+1)+SQRT(X)) + LOG(SQRT(X+1)-SQRT(X))); +rootscontract&& ROOTSCONMODE:FALSE$ +ROOTSCONTRACT(X^(1/2)*Y^(3/2)); +ROOTSCONTRACT(X^(1/2)*Y^(1/4)); +ROOTSCONMODE:TRUE$ +ROOTSCONTRACT(X^(1/2)*Y^(1/4)); +ROOTSCONTRACT(X^(1/2)*Y^(1/3)); +ROOTSCONMODE:ALL$ +ROOTSCONTRACT(X^(1/2)*Y^(1/4)); +ROOTSCONTRACT(X^(1/2)*Y^(1/3)); +ROOTSCONMODE:FALSE$ +ROOTSCONTRACT(SQRT(SQRT(X+1)+SQRT(X))*SQRT(SQRT(X+1)-SQRT(X))); +ROOTSCONMODE:TRUE$ +ROOTSCONTRACT(SQRT(SQRT(5)+5)-5^(1/4)*SQRT(SQRT(5)+1)); +diff&& DIFF(SIN(X)+X^3+2*X^2,X); +DIFF(SIN(X)*COS(X),X); +DIFF(SIN(X)*COS(X),X,2); +DERIVABBREV:TRUE$ +DIFF(EXP(F(X)),X,2); +'INTEGRATE(F(X,Y),Y,G(X),H(X)); +DIFF(%,X); +depends&& DEPENDS(A,X); +DIFF(A.A,X); +DEPENDS(F,[X,Y],[X,Y],T); +DIFF(F,T); +gradef&& DEPENDS(Y,X); +GRADEF(F(X,Y),X^2,G(X,Y)); +DIFF(F(X,Y),X); +GRADEF(J(N,Z),'DIFF(J(N,Z),N), + J(N-1,Z)-N/Z*J(N,Z))$ +RATSIMP(DIFF(J(2,X),X,2)); +integrate&& INTEGRATE(SIN(X)^3,X); +INTEGRATE(%E^X/(%E^X+2),X); +INTEGRATE(1/(X*LOG(X)),X); +INTEGRATE(SIN(2*X+3),X); +INTEGRATE(%E^X*ERF(X),X); +INTEGRATE(X/(X^3+1),X); +DIFF(%,X); +RATSIMP(%); +INTEGRATE(X^(5/4)/(X+1)^(5/2),X,0,INF); +GRADEF(Q(X),SIN(X^2)); +DIFF(LOG(Q(R(X))),X); +INTEGRATE(%,X); +risch&& RISCH(X^2*ERF(X),X); +DIFF(%,X),RATSIMP; +changevar&& 'INTEGRATE(%E^SQRT(A*Y),Y,0,4); +CHANGEVAR(%,Y-Z^2/A,Z,Y); +part&& X+Y/Z^2; +PART(%,1,2,2); +'INTEGRATE(F(X),X,A,B)+X; +PART(%,1,1); +X^2+2*X=Y^2; +%+1; +LHS(%); +PART(%TH(2),2); +PART(%,1); +27*Y^3+54*X*Y^2+36*X^2*Y+Y+8*X^3+X+1; +PART(%,2,[1,3]); +SQRT(PIECE/54); +inpart&& X+Y+W*Z; +INPART(%,3,2); +PART(%TH(2),1,2); +'LIMIT(F(X)^G(X+1),X,0,MINUS); +INPART(%,1,2); +nounify&& 'LIMIT(F(X)^G(X+1),X,0,MINUS); +IS(INPART(%,0)=NOUNIFY(LIMIT)); +dpart&& DPART(X+Y/Z^2,1,2,1); +EXPAND((B+A)^4); +(B+A)^2*(Y+X)^2; +EXPAND(%); +%TH(3)/%; +FACTOR(%); +DPART(%TH(2),2,4); +PART(%TH(3),2,4); +subst&& SUBST(A,X+Y,X+(X+Y)^2+Y); +SUBST(-%I,%I,A+B*%I); +EV(A+B*%I,%I:-%I); +SUBST(X,Y,X+Y); +SUBST(X=0,DIFF(SIN(X),X)); +DIFF(SIN(X),X),X=0; +INTEGRATE(X^I,X),I=-1; +SUBST(-1,I,INTEGRATE(X^I,X)); +MATRIX([A,B],[C,D]); +SUBST("[",MATRIX,%); +ratsubst&& RATSUBST(A,X*Y^2,X^4*Y^8+X^4*Y^3); +1 + COS(X) + COS(X)^2 + COS(X)^3 + COS(X)^4; +RATSUBST(1-SIN(X)^2,COS(X)^2,%); +RATSUBST(1-COS(X)^2,SIN(X)^2,SIN(X)^4); +substpart&& 1/(X^2+2); +SUBSTPART(3/2,%,2,1,2); +27*Y^3+54*X*Y^2+36*X^2*Y+Y+8*X^3+X+1; +SUBSTPART(FACTOR(PIECE),%,[1,2,3,5]); +1/X+Y/X-1/Z; +SUBSTPART(XTHRU(PIECE),%,[2,3]); +SUBSTPART("+",%,1,0); +RATSIMP((K^2*X^2-1)*(COS(X)+EPS)/(3*K+N[1])/(5*K-N[2])); +FACTOR(%); +SUBSTPART(RATSIMP(PIECE),%,1,[1,2]); +-SUBSTPART(-PIECE,%,1,1); +A+B/(X*(Y+(A+B)*X)+1); +SUBSTPART(MULTTHRU(PIECE),%,1,2,1); +substinpart&& X.'DIFF(F(X),X,2); +SUBSTINPART(D^2,%,2); +SUBSTINPART(F1,F[1](X+1),0); +atvalue&& ATVALUE(F(X,Y),[X=0,Y=1],A^2)$ +ATVALUE('DIFF(F(X,Y),X),X=0,Y+1); +PRINTPROPS(ALL,ATVALUE); +DIFF(4*F(X,Y)^2-U(X,Y)^2,X); +AT(%,[X=0,Y=1]); +at&& ATVALUE(F(X,Y),[X=0,Y=1],A^2); +ATVALUE('DIFF(F(X,Y),X),X=0,Y+1); +PRINTPROPS(ALL,ATVALUE); +DIFF(4*F(X,Y)^2-U(X,Y)^2,X); +AT(%,[X=0,Y=1]); +listofvars&& LISTOFVARS(F(X[1]+Y)/G^(2+A)); +coeff&& COEFF(2*A*TAN(X)+TAN(X)+B=5*TAN(X)+3,TAN(X)); +COEFF(Y+X*%E^X+1,X,0); +ratcoeff&& A*X+B*X+5$ +RATCOEF(%,A+B); +bothcoeff&& ISLINEAR(EXP,VAR):=BLOCK([C], + C:BOTHCOEF(RAT(EXP,VAR),VAR), + IS(FREEOF(VAR,C) AND C[1]#0))$ +ISLINEAR((R^2-(X-R)^2)/X,X); +isolate&& (A+B)^4*(1+X*(2*X+(C+D)^2)); +ISOLATE(%,X); +RATEXPAND(%)$ +EV(%); +(A+B)*(X+A+B)^2*%E^(X^2+A*X+B); +ISOLATE(%,X),EXPTISOLATE:TRUE; +pickapart&& INTEGRATE(1/(X^3+2),X)$ +PICKAPART(%,1); +numfactor&& GAMMA(7/2); +NUMFACTOR(%); +derivdegree&& 'DIFF(Y,X,2)+'DIFF(Y,Z,3)*2+'DIFF(Y,X)*X^2; +DERIVDEGREE(%,Y,X); +realpart&& (%I*V+U)/(F+%I*E)+%E^(%I*ALPHA); +REALPART(%); +polarform&& RECTFORM(SIN(2*%I+X)); +POLARFORM(%); +RECTFORM(LOG(3+4*%I)); +POLARFORM(%); +RECTFORM((2+3.5*%I)^0.25),NUMER; +POLARFORM(%); +delete&& DELETE(SIN(X),X+SIN(X)+Y); +nroots&& X^10-2*X^4+1/2; +NROOTS(%,-6,9.1); +realroots&& REALROOTS(X^5-X-1,5.0E-6); +%[1],FLOAT; +X^5-X-1,%; +allroots&& (2*X+1)^3=13.5*(X^5+1); +ALLROOTS(%); +linsolve&& X+Z=Y$ +2*A*X-Y=2*A^2$ +Y-2*Z=2$ +LINSOLVE([%TH(3),%TH(2),%],[X,Y,Z]),GLOBALSOLVE; +algsys&& F1:2*X*(1-L1)-2*(X-1)*L2$ +F2:L2-L1$ +F3:L1*(1-X**2-Y)$ +F4:L2*(Y-(X-1)**2)$ +ALGSYS([F1,F2,F3,F4],[X,Y,L1,L2]); +F1:X**2-Y**2$ +F2:X**2-X+2*Y**2-Y-1$ +ALGSYS([F1,F2],[X,Y]); +solve&& SOLVE(ASIN(COS(3*X))*(F(X)-1),X); +SOLVE(5^F(X)=125,F(X)),SOLVERADCAN; +[4*X^2-Y^2=12,X*Y-X=2]; +SOLVE(%,[X,Y]); +SOLVE(X^3+A*X+1,X); +SOLVE(X^3-1); +SOLVE(X^6-1); +EV(X^6-1,%[1]); +EXPAND(%); +X^2-1; +SOLVE(%,X); +%TH(2),%[1]; +entermatrix&& ENTERMATRIX(2,1); +genmatrix&& H[I,J]:=1/(I+J-1)$ +GENMATRIX(H,3,3); +augcoefmatrix&& [2*X-(A-1)*Y=5*B,A*X+B*Y+C=0]$ +AUGCOEFMATRIX(%,[X,Y]); +echelon&& MATRIX([2,1-A,-5*B],[A,B,C]); +ECHELON(%); +triangularize&& MATRIX([2,1-A,-5*B],[A,B,C]); +TRIANGULARIZE(%); +rank&& MATRIX([2,1-A,-5*B],[A,B,C]); +RANK(%); +charpoly&& A:MATRIX([3,1],[2,4]); +EXPAND(CHARPOLY(A,LAMBDA)); +(PROGRAMMODE:TRUE,SOLVE(%)); +MATRIX([X1],[X2]); +EV(A.%-LAMBDA*%,%TH(2)[1]); +%[1,1]=0; +X1^2+X2^2=1; +SOLVE([%TH(2),%],[X1,X2]); +MATRIX([X^3,X^2,X,1],[Y^3,Y^2,X,1],[Z^3,Z^2,Z,1],[W^3,W^2,W,1]); +DETERMINANT(%); +FACTOR(%); +dotscrules&& DECLARE(L,SCALAR,[M1,M2,M3],NONSCALAR); +EXPAND((1-L*M1).(1-L*M2).(1-L*M3)); +%,DOTSCRULES; +RAT(%,L); +rat&& RAT(X^2); +DIFF(F(%),X); +((X-2*Y)^4/(X^2-4*Y^2)^2+1)*(Y+A)*(2*Y+X)/(4*Y^2+X^2); +RAT(%,Y,A,X); +(X+3)^20; +RAT(%); +DIFF(%,X); +FACTOR(%); +ratweight&& RATWEIGHT(A,1,B,1); +RAT(A+B+1); +%^2; +EV(%TH(2)^2,RATWTLVL:1); +horner&& 1.0E-20*X^2-5.5*X+5.2E20; +HORNER(%,X),KEEPFLOAT); +EV(%,X=1.0E20); +divide&& DIVIDE(X+Y,X-Y,X); +DIVIDE(X+Y,X-Y); +content&& CONTENT(2*X*Y+4*X^2*Y^2,Y); +resultant&& RESULTANT(A*Y+X^2+1,Y^2+X*Y+B,X); +ratdiff&& (4*X^3+10*X-11)/(X^5+5); +MOD(%),MODULUS:3; +RATDIFF(%TH(3),X); +tellrat&& 10*(1+%I)/(3^(1/3)+%I); +RATDISREP(RAT(%)),ALGEBRAIC; +TELLRAT(A^2+A+1); +A/(SQRT(2)+SQRT(3))+1/(A*SQRT(2)-1); +RATDISREP(RAT(%)),ALGEBRAIC; +TELLRAT(Y^2=X^2); +taytorat&& TAYLOR(1+X,[X,0,3]); +1/%; +TAYLOR(1+X+Y+Z,[X,0,3],[Y,1,2],[Z,2,1]); +1/%; +TAYLOR(1+X+Y+Z,[X,0,3],[Y,0,3],[Z,0,3]); +1/%; +sum&& SUM(I^2+2^I,I,0,N),SIMPSUM; +SUM(3^(-I),I,1,INF),SIMPSUM; +SUM(I^2,I,1,4)*SUM(1/I^2,I,1,INF),SIMPSUM; +SUM(I^2,I,1,5); +product&& PRODUCT(X+I*(I+1)/2,I,1,4); +limit&& LIMIT(X*LOG(X),X,0,PLUS); +LIMIT((1+X)^(1/X),X,0); +LIMIT(%E^X/X,X,INF); +LIMIT(SIN(1/X),X,0); +residue&& RESIDUE(S/(S^2+A^2),S,A*%I); +RESIDUE(SIN(A*X)/X^4,X,0); +taylor&& TAYLOR(SQRT(1+A*X+SIN(X)),X,0,3); +%^2; +TAYLOR(SQRT(1+X),X,0,5); +%^2; +PRODUCT((X^I+1)^2.5,I,1,INF)/(X^2+1); +TAYLOR(%,X,0,3),KEEPFLOAT; +TAYLOR(1/LOG(1+X),X,0,3); +TAYLOR(COS(X)-SEC(X),X,0,5); +TAYLOR((COS(X)-SEC(X))^3,X,0,5); +TAYLOR((COS(X)-SEC(X))^-3,X,0,5); +TAYLOR(SQRT(1-K^2*SIN(X)^2),X,0,6); +TAYLOR((1+X)^N,X,0,4); +TAYLOR(SIN(X+Y),X,0,3,Y,0,3); +TAYLOR(SIN(X+Y),[X,Y],0,3); +TAYLOR(1/SIN(X+Y),X,0,3,Y,0,3); +TAYLOR(1/SIN(X+Y),[X,Y],0,3); +deftaylor&& DEFTAYLOR(F(X),X^2+SUM(X^I/(2^I*I!^2),I,4,INF)); +TAYLOR(%E^SQRT(F(X)),X,0,4); +powerseries&& POWERSERIES(LOG(SIN(X)/X),X,0); +trigexpand&& X+SIN(3*X)/SIN(X),TRIGEXPAND,EXPAND; +TRIGEXPAND(SIN(10*X+Y)); +trigreduce&& -SIN(X)^2+3*COS(X)^2+X; +EXPAND(TRIGREDUCE(%)); +DECLARE(J,INTEGER,E,EVEN,O,ODD); +SIN(X+(E+1/2)*%PI); +SIN(X+(O+1/2)*%PI); +optimize&& DIFF(EXP(X^2+Y)/(X+Y),X,2); +OPTIMIZE(%); +laplace&& LAPLACE(%E^(2*T+A)*SIN(T)*T,T,S); +ilt&& 'INTEGRATE(SINH(A*X)*F(T-X),X,0,T)+B*F(T)=T^2; +LAPLACE(%,T,S); +LINSOLVE([%],['LAPLACE(F(T),T,S)]); +ILT(EV(%[1]),S,T); +minfactorial&& N!/(N+1)!; +MINFACTORIAL(%); +factcomb&& (N+1)^B*N!^B; +FACTCOMB(%); +qunit&& QUNIT(17); +EXPAND(%*(SQRT(17)-4)); +cf&& CF([1,2,-3]+[1,-2,1]); +CFDISREP(%); +CFLENGTH:4$ +CF(SQRT(3)); +CFEXPAND(%); +EV(%[1,2]/%[2,2],NUMER); +cfdisrep&& CF([1,2,-3]+[1,-2,1]); +CFDISREP(%); +cfexpand&& CFLENGTH:4$ +CF(SQRT(3)); +CFEXPAND(%); +EV(%[1,2]/%[2,2],NUMER); +featurep&& DECLARE(J,EVEN)$ +FEATUREP(J,INTEGER); +map&& MAP(F,X+A*Y+B*Z); +MAP(LAMBDA([U],PARTFRAC(U,X)),X/(X^3+4*X^2+5*X+2)); +MAP(RATSIMP, X/(X^2+X)+(Y^2+Y)/Y); +MAP("=",[A,B],[-0.5,3,2.5]); +fullmap&& FULLMAP(G,A+B*C); +MAP(G,A+B*C); +fullmapl&& FULLMAPL("+",[3,[4,5]],[[A,1],[0,-1.5]]); +scanmap&& (A^2+2*A+1)*Y+X^2; +SCANMAP(FACTOR,%); +SCANMAP(FACTOR,%TH(2)AND(EXP)); +U*V^(A*X+B)+C; +SCANMAP('F,%); +append&& APPEND([Y+X,0,-3.2],[2.5E20,X]); +reverse&& UNION(X,Y):=IF X=[] THEN Y ELSE + IF MEMBER(T:FIRST(X),Y) THEN UNION(REST(X),Y) + ELSE CONS(T,UNION(REST(X),Y)$ +UNION([A,B,1,1/2,X^2],[-X^2,A,Y,1/2]); +BERNPOLY(X,5); +MAPLIST(NUMFACTOR,%); +APPLY(MIN,%); +display&& DISPLAY(B[1,2]); +reveal&& INTEGRATE(1/(X^3+2),X)$ +REVEAL(%,2); +REVEAL(%TH(2),3); +catch&& G(L):=CATCH(MAP(LAMBDA([X],IF X<0 THEN THROW(X) ELSE F(X)),L))$ +G([1,2,3,7]); +G([1,2,-3,7]); +unorder&& A^2+B*X; +ORDERGREAT(A); +A^2+B*X; +%-%TH(3); +UNORDER(); +arrayinfo&& B[1,X]:1$ +ARRAY(F,2,3); +ARRAYINFO(B); +ARRAYINFO(F); +properties&& PROPERTIES(CONS); +ASSUME(VAR1>0); +PROPERTIES(VAR1); +VAR2:2$ +PROPERTIES(VAR2); +printprops&& GRADEF(R,X,X/R)$ +GRADEF(R,Y,Y/R)$ +PRINTPROPS(R,ATOMGRAD); +PROPVARS(ATOMGRAD); +propvars&& GRADEF(R,X,X/R)$ +GRADEF(R,Y,Y/R)$ +PRINTPROPS(R,ATOMGRAD); +PROPVARS(ATOMGRAD); +get&& PUT(%E,TRANSCENDENTAL,TYPE); +PUT(%PI,TRANSCENDENTAL,TYPE)$ +PUT(%I,ALGEBRAIC,TYPE)$ +TYPEOF(X):=BLOCK([Q], IF NUMBERP(X) + THEN RETURN(ALGEBRAIC), + IF NOT ATOM(X) + THEN RETURN(MAPLIST(TYPEOF,X)), + Q:GET(X,TYPE), IF Q=FALSE THEN + ERROR("NOT NUMERIC") ELSE Q)$ +ERRCATCH(TYPEOF(2*%E+X*%PI)); +TYPEOF(2*%E+%PI); +is&& IS(X^2>=2*X-1); +IS(EQUAL(Y^3,1) OR LOG(X)>0); +ASSUME(A>1); +IS(LOG(LOG(A+1)+1)>0 AND A^2+1>2*A); +freeof&& FREEOF(Y,SIN(X+2*Y)); +FREEOF(COS(Y),"*",SIN(Y)+COS(X)); +matchdeclare&& MATCHDECLARE(A,TRUE)$ +TELLSIMP(SIN(A)^2,1-COS(A)^2)$ +SIN(Y)^2; +KILL(RULES); +NONZEROANDFREEOF(X,E):=IS(E#0 AND FREEOF(X,E)); +MATCHDECLARE(A,NONZEROANDFREEOF(X),B,FREEOF(X)); +DEFMATCH(LINEAR,A*X+B,X); +LINEAR(3*Z+(Y+1)*Z+Y**2,Z); +MATCHDECLARE([A,F],TRUE); +CONSTINTERVAL(L,H):=CONSTANTP(H-L)$ +MATCHDECLARE(B,CONSTINTERVAL(A))$ +MATCHDECLARE(X,ATOM)$ +BLOCK(REMOVE(INTEGRATE,OUTATIVE), + DEFMATCH(CHECKLIMITS,'INTEGRATE(F,X,A,B)), + DECLARE(INTEGRATE,OUTATIVE))$ +'INTEGRATE(SIN(T),T,X+%PI,X+2*%PI)$ +CHECKLIMITS(%); +'INTEGRATE(SIN(T),T,0,X)$ +CHECKLIMITS(%); +tellsimp&& MATCHDECLARE(X,FREEOF(%I))$ +%IARGS:FALSE$ +TELLSIMP(SIN(%I*X),%I*SINH(X)); +TRIGEXPAND(SIN(X+%I*Y)); +%IARGS:TRUE$ +ERRCATCH(0^0); +TELLSIMP(0^0,1),SIMP:FALSE; +0^0; +REMRULE("^","^RULE1"); +TELLSIMP(SIN(X)^2,1-COS(X)^2)$ +(SIN(X)+1)^2; +EXPAND(%); +SIN(X)^2; +KILL(RULES); +MATCHDECLARE(A,TRUE)$ +TELLSIMP(SIN(A)^2,1-COS(A)^2)$ +SIN(Y)^2; +KILL(RULES); +defmatch&& NONZEROANDFREEOF(X,E):=IS(E#0 AND FREEOF(X,E)); +MATCHDECLARE(A,NONZEROANDFREEOF(X),B,FREEOF(X)); +DEFMATCH(LINEAR,A*X+B,X); +LINEAR(3*Z+(Y+1)*Z+Y**2,Z); +MATCHDECLARE([A,F],TRUE); +CONSTINTERVAL(L,H):=CONSTANTP(H-L)$ +MATCHDECLARE(B,CONSTINTERVAL(A))$ +MATCHDECLARE(X,ATOM)$ +BLOCK(REMOVE(INTEGRATE,OUTATIVE), + DEFMATCH(CHECKLIMITS,'INTEGRATE(F,X,A,B)), + DECLARE(INTEGRATE,OUTATIVE))$ +'INTEGRATE(SIN(T),T,X+%PI,X+2*%PI)$ +CHECKLIMITS(%); +'INTEGRATE(SIN(T),T,0,X)$ +CHECKLIMITS(%); +let&& MATCHDECLARE([A,A1,A2],TRUE); +ONELESS(X,Y):=IS(X=Y-1)$ +LET(A1*A2!,A1!,ONELESS,A2,A1); +LET(A1!/A1,(A1-1)!),LETRAT; +LETSIMP(N*M!*(N-1)!/M),LETRAT; +LET(SIN(A)^2,1-COS(A)^2); +SIN(X)^4; +LETSIMP(%); +letrules&& MATCHDECLARE([A,A1,A2],TRUE); +ONELESS(X,Y):=IS(X=Y-1)$ +LET(A1*A2!,A1!,ONELESS,A2,A1); +LET(A1!/A1,(A1-1)!),LETRAT; +LETSIMP(N*M!*(N-1)!/M),LETRAT; +LET(SIN(A)^2,1-COS(A)^2); +SIN(X)^4; +LETSIMP(%); +poissimp&& PFEFORMAT:TRUE$ +POISSIMP(SIN(X)^2); +(2*A^2-B)*COS(X+2*Y)-(A*B+5)*SIN(U-4*X); +POISEXPT(%,2)$ +PRINTPOIS(%); +POISINT(%TH(2),Y)$ +POISSIMP(%); +POISSIMP(SIN(X)^5+COS(X)^5); +PFEFORMAT:FALSE$ +tensor&& LOADFILE(ETENSR,FASL,DSK,SHARE); +setup&& SETUP(); +christof&& CHRISTOF(MCS); +riccicom&& RICCICOM(TRUE); +riemann&& RIEMANN(TRUE); +rinvariant&& RINVARIANT(); +dscalar&& DEPENDS(FIELD,R); +DSCALAR(FIELD); +riemann&& G(L1,L2):=BLOCK([A,B],IF L2=[] + THEN [A:L1[1],B:L1[2],RETURN(E(L1,[])*(1+2*L*P([],[]))-4*L*P(L1,[]))], + A:L2[1],B:L2[2],E([],L2)*(1-2*L*P([],[]))+4*L*P([],L2))$ +METRIC:G$ +DEFCON(G); +DECLARE(E,CONSTANT); +DEFCON(E); +DEFCON(E,E,DELTA)$ +RIEMANN([I,J,K],[J])$ +SHOW(%); +UNDIFF(%TH(2))$ +EV(%,CHR2,DIFF)$ +RATWEIGHT(L,1)$ +RATEXPAND(%TH(2)),RATWTLVL:1,TAKEGCD; +CONTRACT(%)$ +SHOW(%); +can&& P([I,J,S,V],[M,N,Q],V)*P1([Q,T],[R,S]) + *P2([R,L,M,N,U],[I,J,K]) + + P2([L,N,U],[R,M,I,J,K]) + *P([M,I,J,V],[N,Q,S],V)*P1([R,S,Q,T],[])$ +SHOW(%); +SHOW(RENAME(%TH(2))); +SHOW(CAN(%TH(3))); +BATCH(ITENSR,DEMO,DSK,SHARE); +/* DEMONSTRATION OF MACSYMAS INDICIAL MANIPULATION + OF SYMMETRIC TENSORS. WE WILL SHOW THAT THE COVARIANT + DERIVATIVE OF THE COVARIANT FORM OF THE METRIC TENSOR + IS ZERO */ + +/* LOAD IN INDICIAL TENSOR MANIPULATION PACKAGE */ + +LOADFILE(ITENSR,FASL,DSK,SHARE)$ +/* STATE THAT G IS THE METRIC AND THAT IT CONTRACTS +WITH ITSELF TO FORM THE KRONECKER DELTA */ + +DEFCON(G)$ +DEFCON(G,G,DELTA)$ +METRIC:G$ +/* SHOW THE TIMES OF THE COMPUTATIONS */ + +TIME:TRUE$ +/* OBTAIN COVARIANT DERIVATIVE OF METRIC + AND DISPLAY IT */ + +E:COVDIFF(G([I,J]),K)$ +SHOW(%)$ +/* REPLACE CHRISTOFFEL SYMBOLS OF SECOND + KIND BY THEIR VALUE */ + +E:EV(E,CHR2)$ +SHOW(%)$ +/* EXPAND OUT COMPLETELY */ + +E:EXPAND(E)$ +SHOW(%)$ +/* CONTRACT INDICES MAKING USE OF ALL RULES + AND THE RESULT IS 0 */ + +CONTRACT(E); +ode2&& X^2*'DIFF(Y,X) + 3*X*Y = SIN(X)/X; +SOLN1:ODE2(%,Y,X); +IC1(SOLN1,X=%PI,Y=0); +'DIFF(Y,X,2) + Y*'DIFF(Y,X)^3 = 0; +SOLN2:ODE2(%,Y,X); +RATSIMP(IC2(SOLN2,X=0,Y=0,'DIFF(Y,X)=2)); +BC2(SOLN2,X=0,Y=1,X=1,Y=3); +scsimp&& EXP:K^2*N^2+K^2*M^2*N^2-K^2*L^2*N^2-K^2*L^2*M^2*N^2; +EQ1:K^2+L^2=1; +EQ2:N^2-M^2=1; +SCSIMP(EXP,EQ1,EQ2); +EXQ:(K1*K4-K1*K2-K2*K3)/K3^2; +EQ3:K1*K4-K2*K3=0; +EQ4:K1*K2+K3*K4=0; +SCSIMP(EXQ,EQ3,EQ4); +eliminate&& EXP1:2*X^2+Y*X+Z; +EXP2:3*X+5*Y-Z-1; +EXP3:Z^2+X-Y^2+5; +ELIMINATE([EXP3,EXP2,EXP1],[Y,Z]); +desolve&& EQN1:'DIFF(F(X),X)='DIFF(G(X),X)+SIN(X); +EQN2:'DIFF(G(X),X,2)='DIFF(F(X),X)-COS(X); +ATVALUE('DIFF(G(X),X),X=0,A); +ATVALUE(F(X),X=0,1); +DESOLVE([EQN1,EQN2],[F(X),G(X)]); +/* VERIFICATION */ +[EQN1,EQN2],%,DIFF; +break&& ROOT(F,V):=BLOCK([VAL,FUN,DER],DER:DIFF(F,V),VAL:0, + WHILE(ABS(FUN:SUBST(VAL,V,F))<5.0E-7 + DO VAL:VAL-FUN/DER:SUBST(VAL,V,DER), + VAL)$ +SIN(%PI*X)-%PI*(X-1),NUMER$ +ROOT(%,X); +DEBUGMODE(TRUE); +ROOT(%TH(3),X),DEBUG; +TRACE(SUBST); +ROOT(%TH(5),X); +ROOT(F,V):=BLOCK([VAL,FUN,DER],DER:DIFF(F,V,1),VAL:0, + TEST,FUN:SUBST(VAL,V,F),IF ABS(FUN)<5.0E-7 THEN + RETURN(VAL),DER:SUBST(VAL,V,DER),IF ABS(DER)<5.E-8 + THEN ERROR("Derivative is zero"),VAL:VAL-FUN/DER, + GO(TEST))$ +UNTRACE(); +ERRCATCH(ROOT(%TH(8),X)); +syntax&& MATCHFIX("{","}"); +INFIX("|"); +{X|X>0}; +{X|X<2}; +INFIX(".U.")$ +INFIX(".I.")$ +%TH(4).U.%TH(3); +%TH(5).U.%TH(4); +{1,2,3}$ +{3,4,5}$ +%TH(2).U.%TH(2).U.%; +INFIX(".U.",100,100)$ +INFIX(".I.",120,120)$ +%TH(5).U.%TH(5).U.%; +REMOVE(".U.",OPERATOR)$ +ERRCATCH(%TH(7).U.%TH(3)); +solder&& BATCH(SOLDER,DEMO,DSK,DEMO); +/* THE FOLLOWING ROUTINE RETURNS THE HOMOG.-PART SOLN. +TO 2ND ORDER LINEAR DIFF'L EQNS. WITH CONST. COEFFS. */ + +MATCHDECLARE([B,C],RATNUMP)$ +MATCHDECLARE(F,FREEOF(U))$ +ALIAS(D,DIFF)$ +DEFMATCH(SOLDE,'D(U,X,2) + B*'D(U,X) + C*U = F,U,X)$ +SOLDER(EQN,U,X) := + BLOCK([B,C,F,DISC,R1,R2,ALPHA,BETA], + IF SOLDE(EQN,U,X) = FALSE THEN RETURN(FALSE), + DISC: B^2 - 4*C, ALPHA: -B/2, + IF DISC=0 THEN RETURN(%E^(ALPHA*X)*(A1+A2*X)), + BETA: SQRT(DISC)/2, + IF DISC > 0 + THEN (R1: ALPHA + BETA, R2: ALPHA - BETA, + RETURN(A1*%E^(R1*X) + A2*%E^(R2*X))) + ELSE (BETA: SQRT(-1)*BETA, + RETURN(%E^(ALPHA*X) * (A1*COS(BETA*X) + + A2*SIN(BETA*X)))))$ +DE: 'D(Y,X,2) - 'D(Y,X) - 6*Y = SIN(X); +YH(X) := ''(SOLDER(%,Y,X)); +YP(X) := B1*SIN(X) + B2*COS(X)$ +YG(X) := YH(X) + YP(X)$ +PLUGIN: EV(DE,DIFF,EXPAND,Y=YP(X)); +EQN1: COEFF(PLUGIN,SIN(X)); +EQN2: COEFF(PLUGIN,COS(X)); +GLOBALSOLVE: TRUE$ +SOLN: LINSOLVE([EQN1,EQN2],[B1,B2]); +YG(X); +/* PLUGGING IN INITIAL CONDITIONS OF Y(0)=1 + AND Y'(0)=0 */ + +EQN1: YG(0) = 1; +DIFF(YG(X),X); +EQN2: EV(%,X=0) = 0; +SOLN: LINSOLVE([EQN1,EQN2],[A1,A2]); +YG(X); +/* RESETTING OF OPTIONS */ + + GLOBALSOLVE: FALSE$ +"SOLUTION BY LAPLACE TRANSFORMS"$ +SUBST(Y(X),Y,DE); +[ATVALUE(Y(X),X=0,1), ATVALUE('DIFF(Y(X),X),X=0,0)]; +LAPLACE(%TH(2),X,S); +LINSOLVE([%],['LAPLACE(Y(X),X,S)]); +ILT(%[1],S,X); +BATCH(C2CYL,DEMO,DSK,DEMO); +/* CONVERSION OF THE LAPLACIAN FROM CARTESIAN + COORDS. TO CYLINDRICAL COORDS. */ + +/* CAUSE DERIVATIVES TO DISPLAY WITH SUBSCRIPTS */ + +DERIVABBREV:TRUE$ +/* ORDER X,Y, AND Z SO THEY WILL BE GROUPED NICELY */ + +ORDERLESS(Z,Y,X)$ +/* U(X,Y,Z) BECOMES U(R,T,Z) IN CYLINDRICAL COORDINATES + R STANDS FOR RHO AND T FOR THETA */ + +DEPENDS(U,[R,T,Z])$ +/* INPUT THE TRANSFORMATION RULES FROM THE + CARTESIAN SYSTEM TO THE CYLINDRICAL SYSTEM */ + +GRADEF(R,X,X/R)$ +GRADEF(R,Y,Y/R)$ +GRADEF(T,X,-Y/R^2)$ +GRADEF(T,Y,X/R^2)$ +/* SET EXPOP TO CAUSE PARENTHESIZED EXPRESSIONS +TO BE EXPANDED AUTOMATICALLY */ + +EXPOP:1$ +/* NOW JUST INPUT THE LAPLACIAN IN CART. COORDS., + AND LET THE CHAIN RULE DO ITS THING */ + +DIFF(U,X,2)+DIFF(U,Y,2)+DIFF(U,Z,2); +SUBST(R^2-X^2,Y^2,%); +EQ:T^4*B(T)^3*DIFF(B(T),T,2)+(1-K*T^2)*B(T)^4-T^4; +TRIAL:T+SUM(A[2*I+1]*T^(2*I+1),I,1,5); +POWERDISP:TRUE$ +RATWEIGHT(T,1)$ +RATWTLVL:14$ +EV(EQ,B(T)=TRIAL,DIFF); +EXPANDEDEQ:RAT(%,T); +COEFF(EXPANDEDEQ,T,6); +ANS3:SOLVE(%,A[3]); +COEFF(EXPANDEDEQ,T,8); +EV(%,ANS3); +SOLVE(%,A[5]); +/* ETC*/ + + FOR I:3 THRU 11 STEP 2 DO + COEFFICIENT[I]:COEFF(EXPANDEDEQ,T,I+3)$ +FOR I:3 THRU 11 STEP 2 DO + (SOL[I]:ANS:SOLVE(COEFFICIENT[I],A[I]), + FOR J:I+2 STEP 2 THRU 11 DO + COEFFICIENT[J]:EV(COEFFICIENT[J],ANS))$ +RATEXPAND:TRUE$ +FOR I:3 THRU 11 STEP 2 + DO PRINT(RATSIMP(EV(SOL[I])))$ + \ No newline at end of file diff --git a/src/maxsrc/descri.59 b/src/maxsrc/descri.59 new file mode 100644 index 00000000..56335871 --- /dev/null +++ b/src/maxsrc/descri.59 @@ -0,0 +1,230 @@ +;;; -*- Mode:LISP; Package:MACSYMA -*- + +; ** (c) Copyright 1981 Massachusetts Institute of Technology ** + +(macsyma-module descri) + +(DECLARE (SPLITFILE DESCR)) + +;;; Updated for New-I/O by KMP, 5:31pm Tuesday, 8 August 1978 +;;; Updated for FILEPOSing by RLB, 20 December 1978 +;;; Updated for Multics by putting the index to the doc on the plist of the +;;; symbol being doc'ed by JIM 25 Oct. 1980. + +;;; This version will allow  (control-Q) to quote an & in the +;;; doc file. It first reads MANUAL;MACSYM BINDEX (prepared by doing +;;; :L MANUAL;MANDEX) to find out where in +;;; MANUAL;MACSYM DOC to look. It then reads the latter file +;;; for the entries found in the index. The entry is printed by TYI'ing +;;; chars to the next (non-quoted) "&" in the file. Elements which are +;;; not Macsyma keywords will not be searched for. Any elements which are +;;; not found will be noted explicitly. +;;; The format of the index file is found in comments in RLB;MANDEX . + +;;; This version runs most of the old $DESCRIBE (here named ODESCRIBE) +;;; as a fallback if the index info is out of date. + +(DEFMFUN $DESCRIBE FEXPR (NODES) + (DO ((N NODES (CDR N)) (L) (X)) + ((NULL N) (SETQ NODES (NREVERSE L))) + (SETQ X (CAR N)) + (COND ((SYMBOLP X) (PUSH (prepare-a-node x) L)) + (T (MTELL "~&Non-atomic arg being ignored: ~M" X) + ))) + (COND ((NULL NODES) (SETQ NODES (NCONS 'DESCRIBE)))) + (CURSORPOS 'A) + (LET ((L (LOCATE-INDEX-INFO NODES #+ITS'((DSK MAXOUT) MACSYM BINDEX) + #-ITS ())) + (F)) + (SETQ F (CAR L) L (CDR L)) + (COND ((NULL F) + (PRINC + "Description index is out of date, this may take a lot longer.") + (ODESCRIBE NODES)) + ('T (DO ((L L (CDR L))) ((NULL L) (CLOSE F)) + (COND ((ATOM (CAR L)) + (PRINC "No info for ") + (PRINC (fullstrip1 (CAR L))) (TERPRI)) + ((DO POS (CAR L) (CDR POS) (NULL POS) + (TERPRI) + (FILEPOS F (CAR POS)) + (DO C (TYI F -1) (TYI F -1) () + (CASEQ C + (#/ (TYO (TYI F))) + ((#/& -1) (RETURN 'T)) + (#o14 () ) ;^L + (T (TYO C))))))))))) + '$DONE) + +#-Multics +(DEFUN UPCASE-FULLSTRIP1 (X) + (IMPLODE + (MAP #'(LAMBDA (CHS) + (COND ((< (CAR CHS) #/a)) + ((> (CAR CHS) #/z)) + (T (RPLACA CHS (- (CAR CHS) + #.(- #/a #/A)))))) + (EXPLODEN (FULLSTRIP1 X))))) + +#-Multics +(DEFUN LH-BITS MACRO (FORM) `(BOOLE 1 #o777777 (LSH ,(CADR FORM) -18.))) +#-Multics +(DEFUN RH-BITS MACRO (FORM) `(BOOLE 1 #o777777 ,(CADR FORM))) + +#-Multics +(defun prepare-a-node (x) + (COND ((= (GETCHARN X 1) #/&) (UPCASE-FULLSTRIP1 X)) + (T (FULLSTRIP1 X)))) + +#+Multics +(defun prepare-a-node (x) + (setq x (downcase-it (fullstrip1 x)));For strings and to get the alias's. + (implode (cons #/$ (explode x)))) + +#+Multics +(defun downcase-it (x) + (IMPLODE + (MAP #'(LAMBDA (CHS) + (COND ((< (CAR CHS) #/A)) + ((> (CAR CHS) #/Z)) + (T (RPLACA CHS (+ (CAR CHS) + #.(- #/a #/A)))))) + (EXPLODEN X)))) + +;;;Return +;;; (open-file-obj-or-NIL . (list of (list of starting pos's) or losing-atom)) +#+Multics +(defun locate-index-info (nodes f) + f ;IGNORED + (cond ((not (get '$describe 'user-doc)) + (mtell "Loading DESCRIBE data-base, please be patient.~%") + (load-documentation-file manual-index))) + (setq nodes (sort (append nodes ()) 'alphalessp)) + (do ((l nodes (cdr l)) + (locations ())) + ((null l) (return (cons (open (find-documentation-file manual) + '(in ascii)) + locations))) + (let ((item-location (and (symbolp (car l)) + (get (car l) 'user-doc)))) + (push (if (not (null item-location)) + (ncons item-location) + (car l)) + locations)))) + +#-Multics +(DEFUN LOCATE-INDEX-INFO (NODES F) + (SETQ NODES (SORT (APPEND NODES ()) 'ALPHALESSP) F (OPEN F '(IN FIXNUM))) + (LET ((FILE (DO ((I (IN F) (1- I)) (L)) ;Grab file name + ((< I 1) (PNPUT (NREVERSE L) 7)) + (PUSH (IN F) L))) + (CDATE (IN F)) (FPINDEX (FILEPOS F))) + (DO ((L NODES (CDR L)) (PN) (1STCH 0) (NENT 0) (RET)) + ((NULL L)) + ;(DECLARE (FIXNUM NENT 1STCH)) + (SETQ 1STCH (GETCHARN (CAR L) 1) PN (PNGET (CAR L) 7)) + (FILEPOS F (+ FPINDEX 1STCH)) ;Pos to index-to-the-index + (SETQ NENT (IN F)) + (COND ((NOT (= 0 NENT)) + (FILEPOS F (RH-BITS NENT)) ;Pos to the entries + (SETQ NENT (LH-BITS NENT)) + (DO I 1 (1+ I) (> I NENT) ;Check all entries + (LET ((LPNAME (IN F)) (NSTARTS 0) (FOUND 'T)) + (SETQ NSTARTS (RH-BITS LPNAME) + LPNAME (LH-BITS LPNAME)) + ;;Read in LPNAME file entry pname words, + ;;comparing word-by-word with pname list of the + ;;symbol. Assume they all match (FOUND=T) unless + ;;(a) a mismatch is found + ;;(b) pname list of symbol ran out before LPNAME + ;; words were read from the file + ;;(c) any pname list words left when all words + ;; read from the file + (DO ((I 1 (1+ I)) (PN PN (CDR PN))) + ((> I LPNAME) ;Read pname of entry + (AND PN (SETQ FOUND ()))) + (COND ((NULL PN) (SETQ FOUND ()) (IN F)) + ((NOT (= (CAR PN) (IN F))) + (SETQ FOUND ())))) + ;;If we found the one, read in all the starts and + ;;return a list of them. If we didn't find it, we + ;;need too read in all the starts anyway (dumb + ;;filepos) but remember that simple DO returns nil. + (COND (FOUND (DO ((I 1 (1+ I)) (L)) + ((> I NSTARTS) + (SETQ RET (NREVERSE L))) + (PUSH (IN F) L))) + ((SETQ RET (DO I 1 (1+ I) (> I NSTARTS) + (IN F)))))) + (COND (RET (RPLACA L RET) (RETURN 'T))))))) + (CLOSE F) + (SETQ F (OPEN FILE '(IN ASCII))) + (COND ((NOT (= CDATE (CAR (SYSCALL 1 'RFDATE F)))) + (CLOSE F) (SETQ F ()))) + (CONS F NODES))) + +(DEFMFUN MDESCRIBE (X) (APPLY '$DESCRIBE (NCONS X))) + +;;;ODESCRIBE is mostly like the old $DESCRIBE, except the arg checking +;;; has already been done, and it is a SUBR. + +(DEFUN ODESCRIBE (NODES) + (TERPRI) + (COND ((NOT NODES) (ERROR "Nothing to describe!"))) + (CURSORPOS 'A) + (PRINC "Checking...") + (TERPRI) + (PROG (STREAM EOF) + (SETQ STREAM (OPEN '((DSK MAXOUT) MACSYM DOC) '(IN ASCII))) + (SETQ EOF (GENSYM)) + (*CATCH 'END-OF-FILE + (DO ((FORM (READ STREAM EOF) (READ STREAM EOF))) + ((OR (NULL NODES) (EQ FORM EOF))) + (COND ((MEMQ FORM NODES) + (SETQ NODES (DELETE FORM NODES)) + (CURSORPOS 'A) + (PRINC FORM) + (DO ((C (TYI STREAM -1.) (TYI STREAM -1.))) + ((= C 38.)) ; "&" = End of entry + (COND ((= C -1.) ; -1 = EOF + (*THROW 'END-OF-FILE T)) + ((= C 17.) ; "" = Quote + (SETQ C (TYI STREAM)) + (TYO C)) + ((NOT (MEMBER C '(3. 12.))) + (TYO C))))) + (T (DO ((C (TYI STREAM -1.) (TYI STREAM -1.))) + ((= C 38.)) + (COND ((= C -1.) + (*THROW 'END-OF-FILE T)) + ((= C 17.) + (SETQ C (TYI STREAM))))))))) + (CLOSE STREAM)) + (COND (NODES + (MTELL "Information missing: ~%~M" + (CONS '(MLIST) NODES)) + )) + '$DONE) + +(DEFMFUN $HELP FEXPR (X) X (MDESCRIBE '$HELP)) + +(DECLARE (SPLITFILE EXAMPL)) + +(DEFUN FEXPRCHK (L FN) + (IF (OR (NULL L) (CDR L)) + (MERROR "Wrong number of args to ~:@M~%~M" FN L))) + +;In essence, example(func):=DEMO([manual,demo,dsk,demo],OFF,func,OFF); + +(DEFUN $example FEXPR (func) + (FEXPRCHK func '$example) + (NONSYMCHK (SETQ func (CAR func)) '$example) + (let (($change_filedefaults ())) + (batch1 `(#-Multics((MLIST) manual demo dsk demo) + #+Multics((mlist) ,(string-to-mstring + (string-append macsyma-dir + ">demo>manual.demo"))) + NIL ,func NIL) + t nil nil)) + '$done) +