;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     The data in this file contains enhancments.                    ;;;;;
;;;                                                                    ;;;;;
;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
;;;     All rights reserved                                            ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "MAXIMA")
(macsyma-module logarc)

;;;  Logarc and Halfangles

(defmfun $logarc (exp)
	 (cond ((atom exp) exp)
	       ((arcp (caar exp)) (logarc (caar exp) ($logarc (cadr exp))))
	       ((eq (caar exp) '$atan2)
		(logarc '%atan ($logarc (div (cadr exp) (caddr exp)))))
	       (t (recur-apply #'$logarc exp))))

(defmfun logarc (f x)
  ;;Gives logarithmic form of arc trig and hyperbolic functions
 (let ((s (memq f '(%acos %atan %asinh %atanh))))
   (cond 
    ((memq f '(%acos %asin))
     (mul (min%i)
	  (take '(%log)
		(add (mul (if s '$%i 1)
			   (root (add 1 (neg (power x 2))) 2))
		     (mul (if s 1 '$%i) x)))))
    ((memq f '(%atan %acot))
     (mul (i//2)
	  (take '(%log) (div (add 1 (morp s (mul '$%i x)))
			     (add (mul '$%i x) (porm s 1))))))
    ((memq f '(%asinh %acosh))
     (take '(%log) (add x (root (add (power x 2) (porm s 1)) 2))))
    ((memq f '(%atanh %acoth))
     (mul (half) (take '(%log) (div (add 1 x) (morp s (add x -1))))))
    ((memq f '(%asec %acsc %asech %acsch))
     (logarc (oldget (oldget (get f '$inverse) 'recip) '$inverse) (inv x)))
    (t (merror "Bad argument to Logarc")))))

(defmfun halfangle (f a)
       (and (mtimesp a)
	    (ratnump (cadr a))
	    (equal (caddr (cadr a)) 2)
	    (halfangleaux f (mul 2 a))))

(defun halfangleaux (f a)  ;; f=function; a=twice argument
   (let ((sw (memq f '(%cos %cot %coth %cosh))))
     (cond ((memq f '(%sin %cos))
	    (power (div (add 1 (porm sw (take '(%cos) a))) 2) (1//2)))
	   ((memq f '(%tan %cot))
	    (div (add 1 (porm sw (take '(%cos) a))) (take '(%sin) a)))
	   ((memq f '(%sinh %cosh))
	    (power (div (add (take '(%cosh) a) (porm sw 1)) 2) (1//2)))
	   ((memq f '(%tanh %coth))
	    (div (add (take '(%cosh) a) (porm sw 1)) (take '(%sinh) a)))
	   ((memq f '(%sec %csc %sech %csch))
	    (inv (halfangleaux (get f 'recip) a))))))