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