mirror of
https://github.com/PDP-10/its.git
synced 2026-04-17 16:53:08 +00:00
Added files to support building and running Macsyma.
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
This commit is contained in:
Eric Swenson
1039
src/jm/risch.434
Normal file
1039
src/jm/risch.434
Normal file
File diff suppressed because it is too large
Load Diff
2130
src/jm/simp.834
Normal file
2130
src/jm/simp.834
Normal file
File diff suppressed because it is too large
Load Diff
1419
src/jm/sin.200
Normal file
1419
src/jm/sin.200
Normal file
File diff suppressed because it is too large
Load Diff
374
src/jm/sinint.140
Normal file
374
src/jm/sinint.140
Normal file
@@ -0,0 +1,374 @@
|
||||
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
||||
;;; (c) Copyright 1982 Massachusetts Institute of Technology ;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(macsyma-module sinint)
|
||||
(load-macsyma-macros ratmac)
|
||||
|
||||
(DECLARE (GENPREFIX I)
|
||||
(SPECIAL RISCHPF GENVAR $SAVEFACTORS CHECKFACTORS
|
||||
EXP VAR $FACTORFLAG $RATFAC $LOGABS $EXPOP $EXPON
|
||||
$KEEPFLOAT RATFORM ROOTFACTOR PARDENOM $ALGEBRAIC
|
||||
WHOLEPART PARNUMER VARLIST LOGPTDX SWITCH1)
|
||||
(FIXNUM NARGS I N KLTH KX))
|
||||
|
||||
|
||||
(DEFUN ROOTFAC (Q)
|
||||
(PROG (NTHDQ NTHDQ1 SIMPROOTS ANS)
|
||||
(SETQ NTHDQ (PGCD Q (PDERIVATIVE Q VAR)))
|
||||
(SETQ SIMPROOTS (PQUOTIENT Q NTHDQ))
|
||||
(SETQ ANS (LIST (PQUOTIENT SIMPROOTS (PGCD NTHDQ SIMPROOTS))))
|
||||
AMEN (IF (OR (PCOEFP NTHDQ) (POINTERGP VAR (CAR NTHDQ)))
|
||||
(RETURN (REVERSE ANS)))
|
||||
(SETQ NTHDQ1 (PGCD (PDERIVATIVE NTHDQ VAR) NTHDQ))
|
||||
(SETQ ANS (CONS (PQUOTIENT (PGCD NTHDQ SIMPROOTS) (PGCD NTHDQ1 SIMPROOTS))
|
||||
ANS))
|
||||
(SETQ NTHDQ NTHDQ1)
|
||||
(GO AMEN)))
|
||||
|
||||
(DEFUN APROG (Q)
|
||||
(SETQ Q (OLDCONTENT Q))
|
||||
(SETQ ROOTFACTOR (ROOTFAC (CADR Q)))
|
||||
(SETQ ROOTFACTOR
|
||||
(CONS (PTIMES (CAR Q) (CAR ROOTFACTOR)) (CDR ROOTFACTOR)))
|
||||
(DO ((PD (LIST (CAR ROOTFACTOR)))
|
||||
(RF (CDR ROOTFACTOR) (CDR RF))
|
||||
(N 2 (1+ N)))
|
||||
((NULL RF) (SETQ PARDENOM (REVERSE PD)))
|
||||
(PUSH (PEXPT (CAR RF) N) PD))
|
||||
ROOTFACTOR)
|
||||
|
||||
(DEFUN CPROG (TOP BOTTOM)
|
||||
(PROG (FRPART PARDENOMC PPDENOM THEBPG)
|
||||
(SETQ FRPART (PDIVIDE TOP BOTTOM))
|
||||
(SETQ WHOLEPART (CAR FRPART))
|
||||
(SETQ FRPART (CADR FRPART))
|
||||
(IF (= (LENGTH PARDENOM) 1)
|
||||
(RETURN (SETQ PARNUMER (LIST FRPART))))
|
||||
(SETQ PARDENOMC (CDR PARDENOM))
|
||||
(SETQ PPDENOM (LIST (CAR PARDENOM)))
|
||||
DSEQ (IF (= (LENGTH PARDENOMC) 1) (GO OK))
|
||||
(SETQ PPDENOM (CONS (PTIMES (CAR PPDENOM) (CAR PARDENOMC)) PPDENOM))
|
||||
(SETQ PARDENOMC (CDR PARDENOMC))
|
||||
(GO DSEQ)
|
||||
OK (SETQ PARDENOMC (REVERSE PARDENOM))
|
||||
NUMC (SETQ THEBPG (BPROG (CAR PARDENOMC) (CAR PPDENOM)))
|
||||
(SETQ PARNUMER
|
||||
(CONS (CDR (RATDIVIDE (RATTI FRPART (CDR THEBPG) T)
|
||||
(CAR PARDENOMC)))
|
||||
PARNUMER))
|
||||
(SETQ FRPART
|
||||
(CDR (RATDIVIDE (RATTI FRPART (CAR THEBPG) T)
|
||||
(CAR PPDENOM))))
|
||||
(SETQ PARDENOMC (CDR PARDENOMC))
|
||||
(SETQ PPDENOM (CDR PPDENOM))
|
||||
(IF (NULL PPDENOM)
|
||||
(RETURN (SETQ PARNUMER (CONS FRPART PARNUMER))))
|
||||
(GO NUMC)))
|
||||
|
||||
(DEFUN POLYINT (P) (RATQU (POLYINT1 (RATNUMERATOR P)) (RATDENOMINATOR P)))
|
||||
|
||||
(DEFUN POLYINT1 (P)
|
||||
(COND ((OR (NULL P) (EQUAL P 0)) (CONS 0 1))
|
||||
((ATOM P) (LIST VAR 1 P))
|
||||
((NOT (NUMBERP (CAR P)))
|
||||
(IF (POINTERGP VAR (CAR P)) (LIST VAR 1 P) (POLYINT1 (CDR P))))
|
||||
(T (RATPLUS (POLYINT2 P) (POLYINT1 (CDDR P))))))
|
||||
|
||||
(DEFUN POLYINT2 (P) (CONS (LIST VAR (ADD1 (CAR P)) (CADR P)) (ADD1 (CAR P))))
|
||||
|
||||
(DEFUN DPROG (RATARG)
|
||||
(PROG (KLTH KX AROOTF DERIV THEBPG THETOP THEBOT PROD1 PROD2 ANS)
|
||||
(SETQ ANS (CONS 0 1))
|
||||
(IF (OR (PCOEFP (CDR RATARG)) (POINTERGP VAR (CADR RATARG)))
|
||||
(RETURN (DISREP (POLYINT RATARG))))
|
||||
(APROG (RATDENOMINATOR RATARG))
|
||||
(CPROG (RATNUMERATOR RATARG) (RATDENOMINATOR RATARG))
|
||||
(SETQ ROOTFACTOR (REVERSE ROOTFACTOR))
|
||||
(SETQ PARNUMER (REVERSE PARNUMER))
|
||||
(SETQ KLTH (LENGTH ROOTFACTOR))
|
||||
INTG (IF (= KLTH 1) (GO SIMP))
|
||||
(SETQ AROOTF (CAR ROOTFACTOR))
|
||||
(IF (ZEROP (PDEGREE AROOTF VAR)) (GO RESET))
|
||||
(SETQ DERIV (PDERIVATIVE AROOTF VAR))
|
||||
(SETQ THEBPG (BPROG AROOTF DERIV))
|
||||
(SETQ KX (1- KLTH))
|
||||
(SETQ THETOP (CAR PARNUMER))
|
||||
ITER (SETQ PROD1 (RATTI THETOP (CAR THEBPG) T))
|
||||
(SETQ PROD2 (RATTI THETOP (CDR THEBPG) T))
|
||||
(SETQ THEBOT (PEXPT AROOTF KX))
|
||||
(SETQ ANS
|
||||
(RATPLUS ANS (RATQU (RATMINUS PROD2) (RATTI KX THEBOT T))))
|
||||
(SETQ THETOP
|
||||
(RATPLUS PROD1
|
||||
(RATQU (RATREDUCE (PDERIVATIVE (CAR PROD2) VAR)
|
||||
(CDR PROD2))
|
||||
KX)))
|
||||
(SETQ THETOP (CDR (RATDIVIDE THETOP THEBOT)))
|
||||
(COND ((= KX 1) (SETQ LOGPTDX (CONS (RATQU THETOP AROOTF) LOGPTDX))
|
||||
(GO RESET)))
|
||||
(SETQ KX (1- KX))
|
||||
(GO ITER)
|
||||
RESET(SETQ ROOTFACTOR (CDR ROOTFACTOR))
|
||||
(SETQ PARNUMER (CDR PARNUMER))
|
||||
(SETQ KLTH (1- KLTH))
|
||||
(GO INTG)
|
||||
SIMP (SETQ LOGPTDX
|
||||
(CONS (RATQU (CAR PARNUMER) (CAR ROOTFACTOR)) LOGPTDX))
|
||||
(IF (EQUAL ANS 0) (RETURN (DISREP (POLYINT WHOLEPART))))
|
||||
(SETQ THETOP
|
||||
(CADR (PDIVIDE (RATNUMERATOR ANS) (RATDENOMINATOR ANS))))
|
||||
(RETURN (LIST '(MPLUS)
|
||||
(DISREP (POLYINT WHOLEPART))
|
||||
(DISREP (RATQU THETOP (RATDENOMINATOR ANS)))))))
|
||||
|
||||
(DEFUN LOGMABS (X)
|
||||
(LIST '(%LOG) (IF $LOGABS (SIMPLIFY (LIST '(MABS) X)) X)))
|
||||
|
||||
(DEFUN NPASK (EXP)
|
||||
(COND ((FREEOF '$%I EXP)
|
||||
(LEARN `((MNOTEQUAL) ,EXP 0) T) (ASKSIGN EXP))
|
||||
(T '$POSITIVE)))
|
||||
|
||||
(DEFUN EPROG (P)
|
||||
(PROG (P1E P2E A1E A2E A3E DISCRIM REPART SIGN NCC DCC ALLCC XX DEG)
|
||||
(IF (OR (EQUAL P 0) (EQUAL (CAR P) 0)) (RETURN 0))
|
||||
(SETQ P1E (RATNUMERATOR P) P2E (RATDENOMINATOR P))
|
||||
(COND ((OR SWITCH1
|
||||
(AND (NOT (ATOM P2E))
|
||||
(EQ (CAR (SETQ XX (CADR (OLDCONTENT P2E)))) VAR)
|
||||
(MEMBER (SETQ DEG (PDEGREE XX VAR)) '(5 6))
|
||||
(ZEROCOEFL XX DEG)
|
||||
(OR (EQUAL DEG 5) (NOT (PMINUSP (CAR (LAST XX)))))))
|
||||
(GO EFAC)))
|
||||
(SETQ A1E (INTFACTOR P2E))
|
||||
(IF (> (LENGTH A1E) 1) (GO E40))
|
||||
EFAC (SETQ NCC (OLDCONTENT P1E))
|
||||
(SETQ P1E (CADR NCC))
|
||||
(SETQ DCC (OLDCONTENT P2E))
|
||||
(SETQ P2E (CADR DCC))
|
||||
(SETQ ALLCC (RATQU (CAR NCC) (CAR DCC)))
|
||||
(SETQ DEG (PDEGREE P2E VAR))
|
||||
(SETQ A1E (PDERIVATIVE P2E VAR))
|
||||
(SETQ A2E (RATQU (POLCOEF P1E (PDEGREE P1E VAR))
|
||||
(POLCOEF A1E (PDEGREE A1E VAR))))
|
||||
(COND ((EQUAL (RATTI A2E A1E T) (CONS P1E 1))
|
||||
(RETURN (LIST '(MTIMES)
|
||||
(DISREP (RATTI ALLCC A2E T))
|
||||
(LOGMABS (DISREP P2E))))))
|
||||
(COND ((EQUAL DEG 1) (GO E10))
|
||||
((EQUAL DEG 2) (GO E20))
|
||||
((AND (EQUAL DEG 3) (EQUAL (POLCOEF P2E 2) 0)
|
||||
(EQUAL (POLCOEF P2E 1) 0))
|
||||
(RETURN (E3PROG P1E P2E ALLCC)))
|
||||
((AND (MEMBER DEG '(4 5 6)) (ZEROCOEFL P2E DEG))
|
||||
(RETURN (ENPROG P1E P2E ALLCC DEG))))
|
||||
(RETURN (LIST '(MTIMES)
|
||||
(DISREP ALLCC)
|
||||
(LIST '(%INTEGRATE)
|
||||
(LIST '(MQUOTIENT) (DISREP P1E) (DISREP P2E))
|
||||
(CAR (LAST VARLIST)))))
|
||||
E10 (RETURN (LIST '(MTIMES)
|
||||
(DISREP (RATTI ALLCC
|
||||
(RATQU (POLCOEF P1E (PDEGREE P1E VAR))
|
||||
(POLCOEF P2E 1))
|
||||
T))
|
||||
(LOGMABS (DISREP P2E))))
|
||||
E20 (SETQ DISCRIM
|
||||
(RATDIFFERENCE (CONS (PEXPT (POLCOEF P2E 1) 2) 1)
|
||||
(RATTI 4 (RATTI (POLCOEF P2E 2) (POLCOEF P2E 0) T) T)))
|
||||
(SETQ A2E (RATTI (POLCOEF P2E (PDEGREE P2E VAR)) 2 T))
|
||||
(IF (NOT (FREE (SETQ XX (SIMPLIFY (DISREP DISCRIM))) '$%I)) (GO POS))
|
||||
(SETQ SIGN (NPASK XX))
|
||||
(COND ((EQ SIGN '$NEGATIVE) (GO E30))
|
||||
((EQ SIGN '$ZERO) (GO ZIP)))
|
||||
POS (SETQ A1E (RATSQRT DISCRIM))
|
||||
(SETQ A3E (LOGMABS
|
||||
(LIST '(MQUOTIENT)
|
||||
(LIST '(MPLUS)
|
||||
(LIST '(MTIMES)
|
||||
(DISREP A2E) (DISREP (LIST VAR 1 1)))
|
||||
(DISREP (POLCOEF P2E 1))
|
||||
(LIST '(MMINUS) A1E))
|
||||
(LIST '(MPLUS)
|
||||
(LIST '(MTIMES)
|
||||
(DISREP A2E) (DISREP (LIST VAR 1 1)))
|
||||
(DISREP (POLCOEF P2E 1))
|
||||
A1E))))
|
||||
(COND ((ZEROP (PDEGREE P1E VAR))
|
||||
(RETURN (LIST '(MTIMES)
|
||||
(DISREP ALLCC)
|
||||
(LIST '(MQUOTIENT) (DISREP (POLCOEF P1E 0)) A1E)
|
||||
A3E))))
|
||||
(RETURN
|
||||
(LIST
|
||||
'(MPLUS)
|
||||
(LIST '(MTIMES)
|
||||
(DISREP (RATTI ALLCC (RATQU (POLCOEF P1E (PDEGREE P1E VAR)) A2E) T))
|
||||
(LOGMABS (DISREP P2E)))
|
||||
(LIST
|
||||
'(MTIMES)
|
||||
(LIST
|
||||
'(MQUOTIENT)
|
||||
(DISREP (RATTI ALLCC (RATQU (EPROGRATD A2E P1E P2E) A2E) T))
|
||||
A1E)
|
||||
A3E)))
|
||||
E30 (SETQ A1E (RATSQRT (RATMINUS DISCRIM)))
|
||||
(SETQ
|
||||
REPART
|
||||
(RATQU (COND ((ZEROP (PDEGREE P1E VAR)) (RATTI A2E (POLCOEF P1E 0) T))
|
||||
(T (EPROGRATD A2E P1E P2E)))
|
||||
(POLCOEF P2E (PDEGREE P2E VAR))))
|
||||
(SETQ A3E (COND ((EQUAL 0 (CAR REPART)) 0)
|
||||
(T `((MTIMES) ((MQUOTIENT)
|
||||
,(DISREP (RATTI ALLCC REPART T))
|
||||
,A1E)
|
||||
((%ATAN)
|
||||
((MQUOTIENT)
|
||||
,(DISREP (PDERIVATIVE P2E VAR))
|
||||
,A1E))))))
|
||||
(IF (ZEROP (PDEGREE P1E VAR)) (RETURN A3E))
|
||||
(RETURN (LIST '(MPLUS)
|
||||
(LIST '(MTIMES)
|
||||
(DISREP (RATTI ALLCC
|
||||
(RATQU (POLCOEF P1E (PDEGREE P1E VAR)) A2E)
|
||||
T))
|
||||
(LOGMABS (DISREP P2E)))
|
||||
A3E))
|
||||
ZIP (SETQ
|
||||
P2E
|
||||
(RATQU
|
||||
(PSIMP
|
||||
(P-VAR P2E)
|
||||
(PCOEFADD 2
|
||||
(PEXPT (PTIMES 2 (POLCOEF P2E 2)) 2)
|
||||
(PCOEFADD 1 (PTIMES 4 (PTIMES (POLCOEF P2E 2)
|
||||
(POLCOEF P2E 1)))
|
||||
(PCOEFADD 0 (PEXPT (POLCOEF P2E 1) 2) ()))))
|
||||
(PTIMES 4 (POLCOEF P2E 2))))
|
||||
(RETURN (FPROG (RATTI ALLCC (RATQU P1E P2E) T)))
|
||||
E40 (SETQ PARNUMER NIL PARDENOM A1E SWITCH1 T)
|
||||
(CPROG P1E P2E)
|
||||
(SETQ A2E
|
||||
(MAPCAR #'(LAMBDA (J K) (EPROG (RATQU J K))) PARNUMER PARDENOM))
|
||||
(SETQ SWITCH1 NIL)
|
||||
(RETURN (CONS '(MPLUS) A2E))))
|
||||
|
||||
(DEFUN E3PROG (NUM DENOM CONT)
|
||||
(PROG (A B C D E R RATR VAR* X)
|
||||
(SETQ A (POLCOEF NUM 2) B (POLCOEF NUM 1) C (POLCOEF NUM 0)
|
||||
D (POLCOEF DENOM 3) E (POLCOEF DENOM 0))
|
||||
(SETQ R (COND ((EQ (NPASK (SIMPLIFY (DISREP (RATQU E D)))) '$NEGATIVE)
|
||||
(SIMPNRT (DISREP (RATQU (RATTI -1 E T) D)) 3))
|
||||
(T (NEG (SIMPNRT (DISREP (RATQU E D)) 3)))))
|
||||
(SETQ VAR* (LIST VAR 1 1))
|
||||
(NEWVAR R)
|
||||
(ORDERPOINTER VARLIST)
|
||||
(SETQ X (RATF R))
|
||||
(SETQ RATFORM (CAR X) RATR (CDR X))
|
||||
(RETURN
|
||||
(SIMPLIFY
|
||||
(LIST '(MPLUS)
|
||||
(LIST '(MTIMES)
|
||||
(DISREP (RATQU (R* CONT (R+ (R* A RATR RATR) (R* B RATR) C))
|
||||
(R* RATR RATR 3 D)))
|
||||
(LOGMABS (DISREP (RATPL (RATTI -1 RATR T) VAR*))))
|
||||
(EPROG (R* CONT (RATQU (R+ (R* (R+ (R* 2 A RATR RATR)
|
||||
(R* -1 B RATR)
|
||||
(R* -1 C))
|
||||
VAR*)
|
||||
(R+ (RATQU (R* -1 A E) D)
|
||||
(R* B RATR RATR)
|
||||
(R* -1 2 C RATR)))
|
||||
(R* 3 D RATR RATR
|
||||
(R+ (RATTI VAR* VAR* T)
|
||||
(RATTI RATR VAR* T)
|
||||
(RATTI RATR RATR T))))))
|
||||
)))))
|
||||
|
||||
(DEFUN EPROGRATD (A2E P1E P2E)
|
||||
(RATDIFFERENCE (RATTI A2E (POLCOEF P1E (SUB1 (PDEGREE P1E VAR))) T)
|
||||
(RATTI (POLCOEF P2E (SUB1 (PDEGREE P2E VAR)))
|
||||
(POLCOEF P1E (PDEGREE P1E VAR))
|
||||
T)))
|
||||
|
||||
(DEFUN ENPROG (NUM DENOM CONT DEG)
|
||||
; Denominator is (A*VAR^4+B) =
|
||||
; (SQRT(A)*VAR^2 - SQRT(2)*A^(1/4)*B^(1/4)*VAR + SQRT(B)) *
|
||||
; (SQRT(A)*VAR^2 + SQRT(2)*A^(1/4)*B^(1/4)*VAR + SQRT(B))
|
||||
; or (A*VAR^5+B) =
|
||||
; (1/4) * (A^(1/5)*VAR + B^(1/5)) *
|
||||
; (2*A^(2/5)*VAR^2 + (-SQRT(5)-1)*A^(1/5)*B^(1/5)*VAR + 2*B^(2/5)) *
|
||||
; (2*A^(2/5)*VAR^2 + (+SQRT(5)-1)*A^(1/5)*B^(1/5)*VAR + 2*B^(2/5))
|
||||
; or (A*VAR^6+B) =
|
||||
; (A^(1/3)*VAR^2 + B^(1/3)) *
|
||||
; (A^(1/3)*VAR^2 - SQRT(3)*A^(1/6)*B^(1/6)*VAR + B^(1/3)) *
|
||||
; (A^(1/3)*VAR^2 + SQRT(3)*A^(1/6)*B^(1/6)*VAR + B^(1/3))
|
||||
(PROG ($EXPOP $EXPON A B TERM DISVAR $ALGEBRAIC)
|
||||
(SETQ $EXPOP 0 $EXPON 0)
|
||||
(SETQ A (SIMPLIFY (DISREP (POLCOEF DENOM DEG)))
|
||||
B (SIMPLIFY (DISREP (POLCOEF DENOM 0)))
|
||||
DISVAR (SIMPLIFY (GET VAR 'DISREP))
|
||||
NUM (SIMPLIFY (DISREP NUM))
|
||||
CONT (SIMPLIFY (DISREP CONT)))
|
||||
(COND ((= DEG 4)
|
||||
(SETQ DENOM (ADD2 (MUL2 (POWER A '((RAT SIMP) 1 2)) (POWER DISVAR 2))
|
||||
(POWER B '((RAT SIMP) 1 2)))
|
||||
TERM (MULN (LIST (POWER 2 '((RAT SIMP) 1 2))
|
||||
(POWER A '((RAT SIMP) 1 4))
|
||||
(POWER B '((RAT SIMP) 1 4))
|
||||
DISVAR)
|
||||
T))
|
||||
(SETQ DENOM (MUL2 (ADD2 DENOM TERM) (SUB DENOM TERM))))
|
||||
((= DEG 5)
|
||||
(SETQ TERM (MUL3 (POWER A '((RAT SIMP) 1 5))
|
||||
(POWER B '((RAT SIMP) 1 5))
|
||||
DISVAR))
|
||||
(SETQ DENOM (ADD2 (MUL3 2 (POWER A '((RAT SIMP) 2 5))
|
||||
(POWER DISVAR 2))
|
||||
(SUB (MUL2 2 (POWER B '((RAT SIMP) 2 5))) TERM)))
|
||||
(SETQ TERM (MUL2 (POWER 5 '((RAT SIMP) 1 2)) TERM))
|
||||
(SETQ DENOM (MULN (LIST '((RAT SIMP) 1 4)
|
||||
(ADD2 (MUL2 (POWER A '((RAT SIMP) 1 5)) DISVAR)
|
||||
(POWER B '((RAT SIMP) 1 5)))
|
||||
(ADD2 DENOM TERM) (SUB DENOM TERM))
|
||||
T)))
|
||||
(T (SETQ DENOM (ADD2 (MUL2 (POWER A '((RAT SIMP) 1 3)) (POWER DISVAR 2))
|
||||
(POWER B '((RAT SIMP) 1 3)))
|
||||
TERM (MULN (LIST (POWER 3 '((RAT SIMP) 1 2))
|
||||
(POWER A '((RAT SIMP) 1 6))
|
||||
(POWER B '((RAT SIMP) 1 6))
|
||||
DISVAR)
|
||||
T))
|
||||
(SETQ DENOM (MUL3 DENOM (ADD2 DENOM TERM) (SUB DENOM TERM)))))
|
||||
;;Needs $ALGEBRAIC NIL so next call to RATF will preserve factorization.
|
||||
(RETURN (MUL2 CONT (RATINT (DIV NUM DENOM) DISVAR)))))
|
||||
|
||||
(DEFUN ZEROCOEFL (E N)
|
||||
(DO ((I 1 (1+ I))) ((= I N) T)
|
||||
(IF (NOT (EQUAL (POLCOEF E I) 0)) (RETURN NIL))))
|
||||
|
||||
(DEFUN RATSQRT (A) (LET (VARLIST) (SIMPNRT (DISREP A) 2)))
|
||||
|
||||
(DEFUN FPROG (RAT*)
|
||||
(PROG (ROOTFACTOR PARDENOM PARNUMER LOGPTDX WHOLEPART SWITCH1)
|
||||
(RETURN (ADDN (CONS (DPROG RAT*) (MAPCAR #'EPROG LOGPTDX)) NIL))))
|
||||
|
||||
(DEFMFUN RATINT (EXP VAR)
|
||||
(PROG (GENVAR CHECKFACTORS VARLIST RATARG RATFORM $KEEPFLOAT)
|
||||
(SETQ VARLIST (LIST VAR))
|
||||
(SETQ RATARG (RATF EXP))
|
||||
(SETQ RATFORM (CAR RATARG))
|
||||
(SETQ VAR (CAADR (RATF VAR)))
|
||||
(RETURN (FPROG (CDR RATARG)))))
|
||||
|
||||
(DEFUN INTFACTOR (L)
|
||||
(PROG ($FACTORFLAG A B)
|
||||
(SETQ A (OLDCONTENT L) B (EVERYSECOND (PFACTOR (CADR A))))
|
||||
(RETURN (IF (EQUAL (CAR A) 1) B (CONS (CAR A) B)))))
|
||||
|
||||
(DEFUN EVERYSECOND (A)
|
||||
(IF A (CONS (IF (NUMBERP (CAR A))
|
||||
(PEXPT (CAR A) (CADR A))
|
||||
(CAR A))
|
||||
(EVERYSECOND (CDDR A)))))
|
||||
63
src/jm/zero.23
Normal file
63
src/jm/zero.23
Normal file
@@ -0,0 +1,63 @@
|
||||
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
||||
;;; (c) Copyright 1982 Massachusetts Institute of Technology ;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(macsyma-module zero)
|
||||
|
||||
(DECLARE (SPECIAL S VAR EXP V1 V R1 R2 $NUMER $LISTCONSTVARS VARLIST GENVAR)
|
||||
(*LEXPR $RAT))
|
||||
|
||||
(DEFMFUN $ZEROEQUIV (EXP VAR)
|
||||
(PROG (R S V VARLIST GENVAR)
|
||||
(SETQ EXP (SPECREPCHECK EXP))
|
||||
(SETQ R (LET ($LISTCONSTVARS) ($LISTOFVARS EXP)))
|
||||
(IF (AND (CDR R) (OR (CDDR R) (NOT (ALIKE1 (CADR R) VAR))))
|
||||
(RETURN '$DONTKNOW))
|
||||
(SETQ EXP ($EXPONENTIALIZE EXP))
|
||||
(SETQ R (SDIFF EXP VAR))
|
||||
(IF (ISINOP R '%DERIVATIVE) (RETURN '$DONTKNOW))
|
||||
($RAT R)
|
||||
(SETQ R ($RAT EXP))
|
||||
(SETQ S (CAR R))
|
||||
(SETQ V (RATNUMERATOR (CDR R)))
|
||||
(RETURN (ZEROEQUIV1 V))))
|
||||
|
||||
(DEFUN ZEROEQUIV1 (V)
|
||||
(PROG (V1 V2 COEFF DEG)
|
||||
(IF (ATOM V) (RETURN (EQUAL V 0)))
|
||||
COEFFLOOP (IF (NULL (CDR V)) (RETURN T))
|
||||
(SETQ DEG (CADR V))
|
||||
(IF (EQUAL DEG 0) (RETURN (ZEROEQUIV1 (CADDR V))))
|
||||
(SETQ COEFF (CADDR V))
|
||||
(WHEN (ZEROEQUIV1 COEFF)
|
||||
(SETQ V (CONS (CAR V) (CDDDR V)))
|
||||
(GO COEFFLOOP))
|
||||
(SETQ V1 ($RAT (SDIFF (RATDISREP (CONS S (CONS V (CADDR V))))
|
||||
VAR)))
|
||||
(SETQ V2 (CADR ($RAT (RATDISREP V1))))
|
||||
(IF (EQUAL (PDEGREE V2 (CAR V)) (CADR V))
|
||||
(RETURN (ZEROEQUIV2 V)))
|
||||
(IF (LESSP (PDEGREE V2 (CAR V)) (CADR V))
|
||||
(RETURN (IF (ZEROEQUIV1 V2) (ZEROEQUIV2 V))))
|
||||
(RETURN '$DONTKNOW)))
|
||||
|
||||
(DEFUN ZEROEQUIV2 (V)
|
||||
(PROG (R R1 R2)
|
||||
(SETQ R (SIN (TIMES 0.001 (RANDOM 1000.))))
|
||||
(SETQ V (SUBSTITUTE R VAR (RATDISREP (CONS S (CONS V 1)))))
|
||||
(SETQ V (MEVAL '(($EV) V $NUMER)))
|
||||
(COND ((AND (NUMBERP V) (LESSP (ABS V) (TIMES R 0.01)))
|
||||
(RETURN T))
|
||||
((NUMBERP V) (RETURN NIL)))
|
||||
(IF (AND (FREE V '$%I) (NOT (ISINOP V '%LOG)))
|
||||
(RETURN '$DONTKNOW))
|
||||
(SETQ R1 ($REALPART V))
|
||||
(SETQ R1 (MEVAL '(($EV) R1 $NUMER)))
|
||||
(IF (NOT (NUMBERP R1)) (RETURN '$DONTKNOW))
|
||||
(SETQ R2 ($IMAGPART V))
|
||||
(SETQ R2 (MEVAL '(($EV) R2 $NUMER)))
|
||||
(IF (NOT (NUMBERP R2)) (RETURN '$DONTKNOW))
|
||||
(COND ((AND (LESSP (ABS R1) (TIMES R 0.01))
|
||||
(LESSP (ABS R2) (TIMES R 0.01)))
|
||||
(RETURN T))
|
||||
(T (RETURN NIL)))))
|
||||
Reference in New Issue
Block a user