% File SOLVE.EQN	(c)	04/21/81	    The Soft Warehouse %


FUNCTION UNION (LEX1, LEX2),
  WHEN ATOM(LEX1), LEX2 EXIT,
  WHEN MEMBER (FIRST(LEX1), LEX2),  UNION (REST(LEX1), LEX2)  EXIT,
  ADJOIN (POP(LEX1), UNION (LEX1, LEX2)),
ENDFUN $

FUNCTION SOLF (EX1,
  % Local: %  EX3, EX4, EX5, EX6),
  % Fluid vars from SOLVE & SOLEXP:  INDET, EX2 %
  WHEN EX2 = INDET, LIST (INDET "==" EX1) EXIT,
  WHEN POWER (EX2),
    EX3: SECOND (EX2),
    EX4: THIRD (EX2),
    WHEN FREE (EX3, INDET),
      SOLEXP (EX4 - LOG(EX1,EX3))  EXIT,
    WHEN NUMBER (EX4),
      EX1: EX1 ^ (1/EX4),
      EX4: NUM (EX4),
      EX5: #E ^ (2*#I*#PI/EX4),
      LOOP
        EX6: UNION (SOLEXP(EX3-EX1), EX6),
        EX4: EX4 - 1,
        WHEN ZERO (EX4), EX6, EXIT,
        EX1: EX5 * EX1,
      ENDLOOP EXIT,
    WHEN FREE (EX4,INDET),
      SOLEXP (EX3 - EX1^(1/EX4))  EXIT,
    LIST (EX2 "==" EX1) EXIT,
  WHEN LOGARITHM (EX2)  AND  THIRD(EX2) EQ #E,
    SOLEXP (SECOND(EX2) - #E^EX1) EXIT,
  WHEN (EX6: GET(FIRST(EX2), 'INV)),
    SOLEXP (SECOND(EX2) - EVAL(LIST(EX6, EX1)))  EXIT,
  WHEN PBRCH AND (EX6: GET(FIRST(EX2), 'PINV)),
    SOLEXP (SECOND(EX2) - EVAL(LIST(EX6, EX1)))  EXIT,
  LIST (EX2 "==" EX1),
ENDFUN $

#ARB: 1 $

FUNCTION SOLEXP (EX1,
  % Local: % EX2, EX3, EX4, EX5, EX6, EX7, EX8, LEX1, LEX2, LEX3, LEX4),
  EX1: NUM (FCTR(EX1)),
  BLOCK WHEN SUM(EX1), EX1: NUM(EXPD(EX1))  EXIT,
  ENDBLOCK,
  WHEN ZERO(EX1), LIST(INDET "==" ARB(#ARB)) EXIT,
  WHEN FREE(EX1, INDET), FALSE EXIT,
  BLOCK WHEN PRODUCT(EX1), LEX1: REST(EX1) EXIT,
    LEX1: LIST(EX1)
  ENDBLOCK,
  LOOP
    EX1: NUM(EXPD(POP(LEX1))),
    BLOCK
      WHEN SUM(EX1),
        LEX3:REST(EX1), EX6:EX7:EX8:0, EX2:FALSE,
        LOOP
          EX3: POP(LEX3),
          BLOCK WHEN FREE(EX3,INDET), EX6: EX6+EX3 EXIT,
            EX4: EX5: 1,
            BLOCK WHEN PRODUCT(EX3), LEX4: REST(EX3) EXIT,
              LEX4: LIST(EX3)
            ENDBLOCK,
            LOOP
              EX3: POP(LEX4),
              BLOCK WHEN FREE(EX3, INDET), EX4: EX4*EX3 EXIT,
                EX5: EX5*EX3
              ENDBLOCK,
              WHEN ATOM(LEX4), EXIT
            ENDLOOP,
            WHEN EMPTY(EX2), EX7: EX4, EX2: EX5  EXIT,
            WHEN EX5 = EX2, EX7: EX7+EX4 EXIT,
            WHEN EX5 = EX2^2, EX8: EX8+EX4 EXIT,
            WHEN EX5^2 = EX2 AND ZERO(EX8), EX8:EX7, EX7:EX4, EX2:EX5 EXIT,
            EX2: 0
          ENDBLOCK,
          WHEN ZERO(EX2), EX1: LIST (EX1 "==" 0) EXIT,
          WHEN ATOM (LEX3),
            WHEN ZERO(EX8), EX1: SOLF (-EX6/EX7)  EXIT,
            EX7: -EX7/(2*EX8),
            EX6: EX6/EX8,
            EX8: (EX7^2 - EX6)^(1/2),
            EX1: UNION (SOLF(EX7+EX8), SOLF(EX7-EX8)) EXIT
        ENDLOOP EXIT,
      WHEN NOT FREE(EX1,INDET),
        EX2: EX1,
        EX1: SOLF(0) EXIT,
      EX1: FALSE,
    ENDBLOCK,
    LEX2: UNION(EX1, LEX2),
    WHEN ATOM (LEX1), LEX2 EXIT,
  ENDLOOP,
ENDFUN $

PROPERTY PRTMATH, {, FUNCTION (LEX1, EX1),
  PRINT ('{),
  WHEN ATOM (LEX1), PRINT ('}) EXIT,
  EX1: SPACES (),
  LOOP
    PRTMATH (POP(LEX1),  0, 0, TRUE),
    WHEN ATOM (LEX1) EXIT,
    PRINTLINE (COMMA),
    SPACES (EX1),
  ENDLOOP,
  PRINT ('}),
ENDFUN $

FUNCTION SOLVE (EX1, INDET, TRGSQ, TRGEXPD, LOGEXPD),
  TRGEXPD: LOGEXPD: -30,
  TRGSQ: 1,
  WHEN EMPTY(EX1) OR EMPTY(INDET),
    ? (LIST(SOLVE, EX1, INDET)) EXIT,
  WHEN FIRST(EX1) EQ '"==",
    ADJOIN ('{, SOLEXP (SECOND(EX1)-THIRD(EX1)))  EXIT,
  ADJOIN ('{, SOLEXP(EX1)),
ENDFUN $

PROPERTY ATAN, INV, TAN $
PROPERTY ASIN, INV, SIN $
PROPERTY ACOS, INV, COS $
PROPERTY ACOT, INV, COT $
PROPERTY ASEC, INV, SEC $
PROPERTY ACSC, INV, CSC $

PROPERTY TAN, PINV, ATAN $
PROPERTY SIN, PINV, ASIN $
PROPERTY COS, PINV, ACOS $
PROPERTY COT, PINV, ACOT $
PROPERTY SEC, PINV, ASEC $
PROPERTY CSC, PINV, ACSC $

RDS() $