/*-*-MACSYMA-*-*/
/*Code added 7/5/80 by ELL for mapping all trig and hyper trig functions
into sin and cos (in lower case)*/
/* 4:00pm  Tuesday, 11 August 1981 -GJC
   Added more eval_when conditionals to complement the improvement
   in Defrule translation and to invoke TRANSCOMPILE.
11/20/83 11:08:42
  reformatting and some streamlining for translation. -asb
*/

EVAL_WHEN([TRANSLATE],
	  TRANSCOMPILE:TRUE,
          TR_BOUND_FUNCTION_APPLYP:FALSE,
          MODE_DECLARE(FUNCTION(EXPNLENGTH,ARGSLENGTH),FIXNUM))$

/* Variable definitions */

DEFINE_VARIABLE(BESTLENGTH,0,FIXNUM)$
DEFINE_VARIABLE(TRYLENGTH,0,FIXNUM)$

/* Properties */

/* The following properties are used to implement the four identities:

     FOO^2=GET(FOO,'UNITCOF)
           +GET(FOO,'COMPLEMENT_COF)*GET(FOO,'COMPLEMENT_FUNCTION)^2*/

PUT('SIN,'COS,'COMPLEMENT_FUNCTION)$
PUT('COS,'SIN,'COMPLEMENT_FUNCTION)$
PUT('SINH,'COSH,'COMPLEMENT_FUNCTION)$
PUT('COSH,'SINH,'COMPLEMENT_FUNCTION)$
PUT('COS,1,'UNITCOF)$
PUT('SIN,1,'UNITCOF)$
PUT('COSH,1,'UNITCOF)$
PUT('SINH,-1,'UNITCOF)$
PUT('COS,-1,'COMPLEMENT_COF)$
PUT('SIN,-1,'COMPLEMENT_COF)$
PUT('COSH,1,'COMPLEMENT_COF)$
PUT('SINH,1,'COMPLEMENT_COF)$

PUT('SIN,'TRIGONOMETRIC,'TYPE)$
PUT('COS,'TRIGONOMETRIC,'TYPE)$
PUT('SINH,'HYPER_TRIGONOMETRIC,'TYPE)$
PUT('COSH,'HYPER_TRIGONOMETRIC,'TYPE)$

/* Declarations */

EVAL_WHEN([TRANSLATE,BATCH,DEMO],
	  MATCHDECLARE(A,TRUE))$

/* Predicates */

TRIGONOMETRICP(EXP):=
  IS(GET(INPART(EXP,0),'TYPE)='TRIGONOMETRIC
     OR GET(PIECE,'TYPE)='HYPER_TRIGONOMETRIC)$

/* Rules */

DEFRULE(TRIGRULE1,TAN(A),SIN(A)/COS(A))$
DEFRULE(TRIGRULE2,SEC(A),1/COS(A))$
DEFRULE(TRIGRULE3,CSC(A),1/SIN(A))$
DEFRULE(TRIGRULE4,COT(A),COS(A)/SIN(A))$
DEFRULE(HTRIGRULE1,TANH(A),SINH(A)/COSH(A))$
DEFRULE(HTRIGRULE2,SECH(A),1/COSH(A))$
DEFRULE(HTRIGRULE3,CSCH(A),1/SINH(A))$
DEFRULE(HTRIGRULE4,COTH(A),COSH(A)/SINH(A))$

/* Functions */

TRIGSIMP(X):=
  TRIGSIMP3(RADCAN(APPLY1(X,
                          TRIGRULE1,TRIGRULE2,TRIGRULE3,TRIGRULE4,
			  HTRIGRULE1,HTRIGRULE2,HTRIGRULE3,HTRIGRULE4)))$

TRIGSIMP3(EXPN):=
   (EXPN:TOTALDISREP(EXPN),
    RATSIMP(TRIGSIMP1(NUM(EXPN))/TRIGSIMP1(DENOM(EXPN)))) $

TRIGSIMP1(EXPN):=BLOCK(
   [LISTOFTRIGSQ, BESTLENGTH, TRYLENGTH],
   LISTOFTRIGSQ: LISTOFTRIGSQ(EXPN),
   BESTLENGTH: 999999,
   IF LISTOFTRIGSQ#[]
   THEN IMPROVE(EXPN,EXPN,LISTOFTRIGSQ)
   ELSE EXPN)$

IMPROVE(EXPN,SUBSOFAR,LISTOFTRIGSQ):=
  IF LISTOFTRIGSQ=[]
  THEN (IF (TRYLENGTH:EXPNLENGTH(SUBSOFAR))<BESTLENGTH
	THEN (BESTLENGTH:TRYLENGTH,SUBSOFAR)
        ELSE EXPN)
  ELSE (SUBSOFAR:IMPROVE(EXPN,SUBSOFAR,REST(LISTOFTRIGSQ)),
	FOR ALT IN FIRST(LISTOFTRIGSQ) DO 
            SUBSOFAR:
	    IMPROVE(SUBSOFAR,
		    RATSUBST(GET(INPART(ALT,0),'UNITCOF)
           		     +GET(PIECE,'COMPLEMENT_COF)
			      *GET(PIECE,'COMPLEMENT_FUNCTION)(FIRST(ALT))^2,
                             ALT^2,SUBSOFAR),
		    REST(LISTOFTRIGSQ)),
	SUBSOFAR)$

LISTOFTRIGSQ(EXPN):=
  IF ATOM(EXPN)
  THEN []
  ELSE BLOCK([INFLAG, ANS:[]],
             DECLARE(ANS,SPECIAL),
             IF INPART(EXPN,0)="^" AND INTEGERP(INPART(EXPN,2))
                AND PIECE>=2
             THEN IF ATOM(EXPN:INPART(EXPN,1))
                  THEN RETURN([])
	          ELSE IF TRIGONOMETRICP(EXPN)
                       THEN RETURN([[EXPN]]),
             INFLAG:TRUE,
             FOR ARG IN EXPN DO
                 ANS:SPECIALUNION(LISTOFTRIGSQ(ARG),ANS),
             ANS)$

SPECIALUNION(LIST1,LIST2):=
  IF LIST1=[]
  THEN LIST2
  ELSE IF LIST2=[]
       THEN LIST1
       ELSE BLOCK([ALTERNATES:FIRST(LIST1)],
                  FOR ALT IN ALTERNATES DO
                      LIST2:UPDATE(ALT,GET(INPART(ALT,0),'COMPLEMENT_FUNCTION)),
                  SPECIALUNION(REST(LIST1),LIST2))$

DECLARE(LIST2,SPECIAL)$

UPDATE(FORM, COMPLEMENT):=BLOCK(
   [ANS],
   DECLARE(ANS,SPECIAL),
   COMPLEMENT: APPLY(COMPLEMENT,[INPART(FORM,1)]),
   ANS: FOR ELEMENT IN LIST2 DO
      IF MEMBER(FORM, ELEMENT) THEN RETURN('FOUND)
      ELSE IF MEMBER(COMPLEMENT,ELEMENT) THEN RETURN(
         CONS([FORM,COMPLEMENT], DELETE(ELEMENT,LIST2))),
   IF ANS='FOUND
   THEN LIST2
   ELSE IF ANS='DONE
        THEN CONS([FORM],LIST2)
        ELSE ANS)$

EXPNLENGTH(EXPR):=BLOCK(
  [INFLAG:TRUE],
  IF ATOM(EXPR)
  THEN 1
  ELSE 1+ARGSLENGTH(ARGS(EXPR)))$

ARGSLENGTH(ARGS):=
  APPLY("+",MAP('EXPNLENGTH,ARGS))$