share/trigonometry/trigrat.lisp

   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