home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / logarc.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  2.5 KB  |  64 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module logarc)
  13.  
  14. ;;;  Logarc and Halfangles
  15.  
  16. (defmfun $logarc (exp)
  17.      (cond ((atom exp) exp)
  18.            ((arcp (caar exp)) (logarc (caar exp) ($logarc (cadr exp))))
  19.            ((eq (caar exp) '$atan2)
  20.         (logarc '%atan ($logarc (div (cadr exp) (caddr exp)))))
  21.            (t (recur-apply #'$logarc exp))))
  22.  
  23. (defmfun logarc (f x)
  24.   ;;Gives logarithmic form of arc trig and hyperbolic functions
  25.  (let ((s (memq f '(%acos %atan %asinh %atanh))))
  26.    (cond 
  27.     ((memq f '(%acos %asin))
  28.      (mul (min%i)
  29.       (take '(%log)
  30.         (add (mul (if s '$%i 1)
  31.                (root (add 1 (neg (power x 2))) 2))
  32.              (mul (if s 1 '$%i) x)))))
  33.     ((memq f '(%atan %acot))
  34.      (mul (i//2)
  35.       (take '(%log) (div (add 1 (morp s (mul '$%i x)))
  36.                  (add (mul '$%i x) (porm s 1))))))
  37.     ((memq f '(%asinh %acosh))
  38.      (take '(%log) (add x (root (add (power x 2) (porm s 1)) 2))))
  39.     ((memq f '(%atanh %acoth))
  40.      (mul (half) (take '(%log) (div (add 1 x) (morp s (add x -1))))))
  41.     ((memq f '(%asec %acsc %asech %acsch))
  42.      (logarc (oldget (oldget (get f '$inverse) 'recip) '$inverse) (inv x)))
  43.     (t (merror "Bad argument to Logarc")))))
  44.  
  45. (defmfun halfangle (f a)
  46.        (and (mtimesp a)
  47.         (ratnump (cadr a))
  48.         (equal (caddr (cadr a)) 2)
  49.         (halfangleaux f (mul 2 a))))
  50.  
  51. (defun halfangleaux (f a)  ;; f=function; a=twice argument
  52.    (let ((sw (memq f '(%cos %cot %coth %cosh))))
  53.      (cond ((memq f '(%sin %cos))
  54.         (power (div (add 1 (porm sw (take '(%cos) a))) 2) (1//2)))
  55.        ((memq f '(%tan %cot))
  56.         (div (add 1 (porm sw (take '(%cos) a))) (take '(%sin) a)))
  57.        ((memq f '(%sinh %cosh))
  58.         (power (div (add (take '(%cosh) a) (porm sw 1)) 2) (1//2)))
  59.        ((memq f '(%tanh %coth))
  60.         (div (add (take '(%cosh) a) (porm sw 1)) (take '(%sinh) a)))
  61.        ((memq f '(%sec %csc %sech %csch))
  62.         (inv (halfangleaux (get f 'recip) a))))))
  63.  
  64.