Remove the obsolete DEFMTRFUN-EXTERNAL macro
[maxima.git] / share / trigonometry / trigrat.lisp
blob7ddd2e29560ddc78db39a9e5afd99129e2a6d20a
1 (in-package :maxima)
3 (defun $listofei (e )
4 (declare (special $d2% $lg $lexp))
5 (setq $d2% (copy-tree (car e)))
6 (setq $lg ())
7 (setq $lexp ())
8 (do ((lvar (caddr $d2%) (cdr lvar))
9 (lg (cadddr $d2%) (cdr lg))
10 (var))
11 ((null lvar)(setq $lg (cons '(mlist) $lg))
12 (setq $lexp (cons '(mlist) $lexp))
13 (setq $d2% (cons $d2% (cdr e))) )
14 (setq var (car lvar))
15 (cond ((and (mexptp var)
16 (equal (cadr var) '$%e)
17 ; (mtimesp (caddr var))
18 ; (eq (cadr (caddr var)) '$%i)
19 ;; Check that we have a factor of %i. This test includes
20 ;; cases like %i, and %i*x/2, which we get for e.g.
21 ;; sin(1) and sin(x/2).
22 (eq '$%i (cdr (partition (if (atom (caddr var))
23 (list '(mtimes)(caddr var))
24 (caddr var))
25 '$%i 1))))
26 (setq $lexp (cons var $lexp))
27 (setq var (symbolconc "$_" (car lg)))
28 (setq $lg (cons var $lg))
29 (rplaca lvar var)))))
31 #$trigrat_equationp (e%) :=
32 not atom (e%)
33 and member (op (e%), ["=", "#", "<", "<=", ">=", ">"])$
35 #$trigrat(exp):=
36 if matrixp (exp) or listp (exp) or setp (exp) or trigrat_equationp (exp)
37 then map (trigrat, exp)
38 else block([e%,n%,d%,lg,f%,lexp,ls,d2%,l2%,alg,gcd1],
39 alg:algebraic,gcd1:gcd,
40 algebraic:true,gcd:subres,
41 e%: rat(ratsimp(expand(exponentialize(exp)))),
42 n%:num(e%),d%:denom(e%),
43 listofei(d%),
44 l2%:map(lambda([u%,v%],u%^((hipow(d2%,v%)+lopow(d2%,v%))/2)),
45 lexp,lg),
46 f%:if length(lexp)=0 then 1
47 else if length(lexp)=1 then part(l2%,1)
48 else apply("*",l2%),
49 n%:rectform(ratexpand(n%/f%)),
50 d%:rectform(ratexpand(d%/f%)),
51 e%:ratsimp(n%/d%,%i),
52 algebraic:alg,gcd:gcd1,
53 e%)$
55 ; written by D. Lazard, august 1988