1(in-package :maxima)
2
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)))))
30
31#$trigrat_equationp (e%) :=
32    not atom (e%)
33    and member (op (e%), ["=", "#", "<", "<=", ">=", ">"])$
34
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%)$
54
55; written by D. Lazard, august 1988
56
57