% File ALGEBRA.ARI  (c)		09/16/80	The Soft Warehouse %


PROPERTY PRTMATH, +, FUNCTION (LEX1,
  % Local: %  EX1),
  PRTPAREN (LPAR),
  PRTMATH (POP(LEX1), 0, GET ('LBP, LOP1)),
  LOOP
    PRTSPACE (),
    BLOCK
      WHEN NEGCOEF (EX1:POP(LEX1)),
        PRINT ('-),
        EX1: -EX1 EXIT,
      PRINT (LOP1),
    ENDBLOCK,
    PRTSPACE (),
    WHEN ATOM (LEX1) EXIT,
    PRTMATH (EX1, GET ('RBP, LOP1), GET ('LBP, LOP1)),
  ENDLOOP,
  PRTMATH (EX1, GET ('RBP, LOP1), 0),
  PRTPAREN (RPAR),
ENDFUN $

FUNCTION SQUARE (EX1,
  % Local: %  LEX1, LEX2, LEX3),
  WHEN SUM (EX1),
    LEX1: REVERSE (REST(EX1)),
    LOOP
      LEX2: MERGESUM ((EX1:POP(LEX1))^2, LEX2),
      WHEN ATOM (LEX3:LEX1), MKSUM (LEX2) EXIT,
      EX1: 2*EX1,
      LOOP
	LEX2: MERGESUM (EX1*POP(LEX3), LEX2),
        WHEN ATOM (LEX3) EXIT,
      ENDLOOP,
    ENDLOOP EXIT,
  EX1*EX1,
ENDFUN $



NUMNUM: 6 $

PUSH ('NUMNUM, FLAGS) $

FUNCTION NUMNUM (EX1),
  WHEN INTEGER (EX1), MULTIPLE (NUMNUM, 2) EXIT,
  WHEN SUM (EX1), MULTIPLE (NUMNUM, 5) EXIT,
  MULTIPLE (NUMNUM, 3),
ENDFUN $

DENNUM: 6 $

PUSH ('DENNUM, FLAGS) $

FUNCTION DENNUM (EX1),
  WHEN INTEGER (EX1), MULTIPLE (DENNUM, 2) EXIT,
  WHEN SUM (EX1), MULTIPLE (DENNUM, 5) EXIT,
  MULTIPLE (DENNUM, 3),
ENDFUN $

FUNCTION DISTRIB (EX1, LEX1,
  % Local: %  NUMNUM, DENNUM, LEX2),
  LOOP
    LEX2: MERGESUM (EX1*POP(LEX1), LEX2),
    WHEN ATOM (LEX1), LEX2 EXIT,
  ENDLOOP,
ENDFUN $

PROPERTY *, +, FUNCTION (EX1, LEX4,
  % Local: %  LEX1, LEX2, LEX3),
  WHEN POSITIVE (NUMNUM) OR POSITIVE (DENNUM),
    WHEN PRODUCT (EX1),
      LEX1: REST (EX1),
      LOOP
        EX1: POP(LEX1),
        BLOCK
          WHEN DENOM (EX1),
            WHEN POSITIVE (DENNUM) AND DENNUM (EX1^-1),
              PUSH (EX1, LEX2) EXIT,
            PUSH (EX1, LEX3) EXIT,
          WHEN POSITIVE (NUMNUM) AND NUMNUM (EX1),
            PUSH (EX1, LEX2) EXIT,
          PUSH (EX1, LEX3),
        ENDBLOCK,
        WHEN ATOM (LEX1) EXIT,
      ENDLOOP,
      MERGEFACT (MKSUM (DISTRIB (MKPROD (REVERSE(LEX2)), LEX4,
	NUMNUM, DENNUM)),  REVERSE (LEX3)) EXIT,
    WHEN DENOM (EX1),
      WHEN POSITIVE (DENNUM) AND DENNUM (EX1^-1),
        MKSUM (DISTRIB (EX1, LEX4, NUMNUM, DENNUM)) EXIT,
      EXIT,
    WHEN POSITIVE (NUMNUM) AND NUMNUM (EX1),
      MKSUM (DISTRIB (EX1, LEX4, NUMNUM, DENNUM)) EXIT,
  EXIT,
ENDFUN $


DENDEN: 6 $

PUSH ('DENDEN, FLAGS) $

FUNCTION DENDEN (EX1),
  WHEN INTEGER (EX1), MULTIPLE (DENDEN, 2) EXIT,
  WHEN SUM (EX1), MULTIPLE (DENDEN, 5) EXIT,
  MULTIPLE (DENDEN, 3),
ENDFUN $

NUMDEN: 0 $

PUSH ('NUMDEN, FLAGS) $

FUNCTION NUMDEN (EX1),
  WHEN INTEGER (EX1), MULTIPLE (NUMDEN, 2) EXIT,
  WHEN SUM (EX1), MULTIPLE (NUMDEN, 5) EXIT,
  MULTIPLE (NUMDEN, 3),
ENDFUN $

PROPERTY *, ^, FUNCTION (EX1, EX2, EX3,
  % Local: %  LEX1, LEX2, LEX3),
  WHEN NEGATIVE(BASEXP) AND BASEXP(EX2) AND BASE(EX1) = EX2,
    EX2 ^ (EXPON(EX1) + EX3) EXIT,
  WHEN NEGATIVE(EXPBAS) AND EXPBAS(EX3) AND EXPON(EX1) = EX3,
    (BASE(EX1) * EX2) ^ EX3 EXIT,
  WHEN EX3 EQ -1,
    WHEN INTEGER (EX2),
      WHEN INTEGER (EX1),
	EX3: GCD (EX1, EX2),
	WHEN EX3 EQ 1, FALSE EXIT,
	EX1: QUOTIENT (EX1, EX3),
	EX2: QUOTIENT (EX2, EX3),
	WHEN EX2 EQ 1, EX1 EXIT,
	EX2: LIST ('^, EX2, -1),
	WHEN EX1 EQ 1, EX2 EXIT,
	LIST ('*, EX1, EX2) EXIT,
      WHEN RECIP (EX1),
	LIST ('^, TIMES (EX2, SECOND(EX1)), -1) EXIT EXIT,
    WHEN SUM (EX2),
      WHEN POSITIVE (DENDEN) OR POSITIVE (NUMDEN),
        EX2: REST (EX2),
        WHEN PRODUCT (EX1),
          LEX1: REST (EX1),
          LOOP
            EX1: POP(LEX1),
            BLOCK
              WHEN DENOM (EX1),
                EX3: EX1^-1,
                WHEN POSITIVE (DENDEN) AND DENDEN (EX3),
                  LEX2: ADJOIN (EX3, LEX2) EXIT,
                LEX3: ADJOIN (EX1, LEX3) EXIT,
              WHEN POSITIVE (NUMDEN) AND NUMDEN (EX1),
                LEX2: ADJOIN (EX1^-1, LEX2) EXIT,
              LEX3: ADJOIN (EX1, LEX3),
            ENDBLOCK,
            WHEN ATOM (LEX1) EXIT,
          ENDLOOP,
          MERGEFACT (LIST ('^, MKSUM (
	    DISTRIB (MKPROD(REVERSE(LEX2)), EX2, DENDEN, NUMDEN)),
              -1),  REVERSE (LEX3)) EXIT,
        WHEN DENOM (EX1),
          EX3: EX1^-1,
          WHEN POSITIVE (DENDEN) AND DENDEN (EX3),
            LIST ('^, MKSUM (DISTRIB (EX3, EX2, DENDEN, NUMDEN)), -1)
	      EXIT,
          EXIT,
        WHEN POSITIVE (NUMDEN) AND NUMDEN (EX1),
          LIST ('^, MKSUM (
	    DISTRIB (EX1^-1, EX2, DENDEN, NUMDEN)), -1) EXIT,
      EXIT,
    EXIT,
  EXIT,
ENDFUN $


EXPBAS: 30 $

PUSH ('EXPBAS, FLAGS) $

FUNCTION EXPBAS (EX1),
  WHEN NUMBER (EX1), MULTIPLE (EXPBAS, 2) EXIT,
  WHEN SUM (EX1), MULTIPLE (EXPBAS, 5) EXIT,
  MULTIPLE (EXPBAS, 3),
ENDFUN $

PROPERTY BASE, *, FUNCTION (EX1, EX2, EX3),
  WHEN POSITIVE (EXPBAS) AND EXPBAS (EX1),
    EX2^EX1 * EX3^EX1 EXIT,
ENDFUN $


BASEXP: -30 $

PUSH ('BASEXP, FLAGS) $

FUNCTION BASEXP (EX1),
  WHEN NUMBER (EX1), MULTIPLE (BASEXP, 2) EXIT,
  WHEN PRODUCT (EX1), MULTIPLE (BASEXP, 5) EXIT,
  MULTIPLE (BASEXP, 3),
ENDFUN $

PROPERTY EXPON, +, FUNCTION (EX1, EX2, EX3),
  WHEN POSITIVE (BASEXP) AND BASEXP (EX1),
    EX1^EX2 * EX1^EX3 EXIT,
ENDFUN $


PWREXPD: 0 $

PUSH ('PWREXPD, FLAGS) $

PROPERTY BASE, +, FUNCTION (EX1, EX2, EX3,
  % Local: %  NUMNUM, DENNUM),
  WHEN INTEGER (EX1),
    BLOCK
      WHEN SUM (EX3),
        EX2: ADJOIN ('+, ADJOIN (EX2, REST(EX3))) EXIT,
      EX2: LIST ('+, EX2, EX3),
    ENDBLOCK,
    WHEN EX1 EQ -1,
      WHEN NEGATIVE (DENDEN) OR NEGATIVE (NUMDEN),
        NUMNUM: DENDEN,
        DENNUM: NUMDEN,
        EX2: EVAL (EX2),
        WHEN SUM (EX2), FALSE EXIT,
        EX2^-1 EXIT EXIT,
    WHEN POSITIVE (PWREXPD),
      NUMNUM: 30,
      DENNUM: 30,
      WHEN POSITIVE (EX1),
        WHEN MULTIPLE (PWREXPD, 2), EXPT (EX2, EX1) EXIT,
        EXIT,
      WHEN MULTIPLE (PWREXPD, 3), EXPT (EX2, -EX1) ^ -1 EXIT,
    EXIT,
  EXIT,
ENDFUN $


FUNCTION EXPAND (EX1,
  % Local: %  PWREXPD, NUMNUM, DENDEN, DENNUM, NUMDEN, BASEXP, EXPBAS),
  PWREXPD: 6,
  NUMNUM: DENDEN: DENNUM: BASEXP: EXPBAS: 30,
  NUMDEN: 0,
  EVAL (EX1),
ENDFUN $


%**** optional content factorization & common denominator pkg. ****%


FUNCTION CONTENT (LEX1, LEX2),
  WHEN ATOM (LEX1),
    WHEN ATOM (LEX2), FALSE EXIT,
    WHEN DENOM (FIRST(LEX2)) AND
      NEGATIVE (DENNUM) AND DENNUM (FIRST(LEX2)^-1),
        ADJOIN (POP(LEX2), CONTENT (FALSE, LEX2)) EXIT,
    CONTENT (FALSE, REST(LEX2)) EXIT,
  CONTENT1 (BASE(FIRST(LEX1)), LEX1, LEX2),
ENDFUN $

FUNCTION CONTENT1 (EX1, LEX1, LEX2,
  % Local: %  EX2),
  WHEN ATOM (LEX2), CONTENT (LEX2, LEX1) EXIT,
  EX2: BASE (FIRST(LEX2)),
  WHEN EX1 = EX2,
    EX1: MIN (EXPON(POP(LEX1)), EXPON(POP(LEX2))),
    WHEN FIRST(EX1) EQ 'MIN, CONTENT (LEX1, LEX2) EXIT,
    EX2: EX2^EX1,
    WHEN DENOM (EX2),
      WHEN NEGATIVE (DENNUM) AND DENNUM (EX2^-1),
        ADJOIN (EX2, CONTENT (LEX1, LEX2)) EXIT,
      CONTENT (LEX1, LEX2) EXIT,
    WHEN NEGATIVE (NUMNUM) AND NUMNUM (EX2),
      ADJOIN (EX2, CONTENT (LEX1, LEX2)) EXIT,
    CONTENT (LEX1, LEX2) EXIT,
  WHEN ORDERED (EX1, EX2),
    EX1: POP(LEX1),
    WHEN DENOM (EX1) AND NEGATIVE (DENNUM) AND DENNUM (EX1^-1),
      ADJOIN (EX1, CONTENT1 (EX2, LEX2, LEX1)) EXIT,
    CONTENT1 (EX2, LEX2, LEX1) EXIT,
  EX2: POP(LEX2),
  WHEN DENOM (EX2) AND NEGATIVE (DENNUM) AND DENNUM (EX2^-1),
    ADJOIN (EX2, CONTENT1 (EX1, LEX1, LEX2)) EXIT,
  CONTENT1 (EX1, LEX1, LEX2),
ENDFUN $

FUNCTION CANCEL (LEX1, LEX2),
  WHEN ATOM (LEX1), LEX2 EXIT,
  CANCEL1 (BASE(FIRST(LEX1)), LEX1, LEX2),
ENDFUN $

FUNCTION CANCEL1 (EX1, LEX1, LEX2,
  % Local: %  EX2),
  WHEN ATOM (LEX2),
    ADJOIN (EX1^-EXPON(POP(LEX1)), CANCEL (LEX1, LEX2))  EXIT,
  WHEN EX1 = (EX2:BASE(FIRST(LEX2))),
    WHEN ZERO (EX1: EXPON (POP(LEX2)) - EXPON (POP(LEX1))),
      CANCEL (LEX1, LEX2) EXIT,
    ADJOIN (EX2^EX1, CANCEL (LEX1, LEX2)) EXIT,
  WHEN ORDERED (EX1, EX2),
    ADJOIN (EX1^-EXPON(POP(LEX1)), CANCEL (LEX1, LEX2)) EXIT,
  ADJOIN (POP(LEX2), CANCEL1 (EX1, LEX1, LEX2)),
ENDFUN $

FUNCTION FACTOR (LEX1, LEX2,
  % Local: %  LEX3, LEX4, EX1),
  EX1: 1,
  LEX3: LEX1,
  LEX4: LEX2,
  BLOCK
    WHEN INTEGER (FIRST(LEX1)),
      WHEN INTEGER (FIRST(LEX2)),
        BLOCK
          WHEN NEGATIVE (NUMNUM) AND NUMNUM (FIRST(LEX1)),
            EX1: GCD (FIRST(LEX1), FIRST(LEX2)),
	    WHEN NEGATIVE (FIRST (LEX1))  AND  NEGATIVE (FIRST (LEX2)),
	      EX1: MINUS(EX1)  EXIT EXIT,
        ENDBLOCK,
        LEX1: REST (LEX1),
        LEX2: REST (LEX2) EXIT,
      LEX1: REST (LEX1) EXIT,
    WHEN INTEGER (FIRST(LEX2)),  LEX2: REST (LEX2) EXIT,
  ENDBLOCK,
  BLOCK
    WHEN RECIP (FIRST(LEX1)),
      WHEN RECIP (FIRST(LEX2)),
        BLOCK
          WHEN NEGATIVE (DENNUM) AND DENNUM (SECOND(FIRST(LEX1))),
            EX1: EX1 *
              LCM (SECOND(FIRST(LEX1)), SECOND(FIRST(LEX2)))^-1  EXIT,
        ENDBLOCK,
        LEX1: REST (LEX1),
        LEX2: REST (LEX2)  EXIT,
      BLOCK
        WHEN NEGATIVE (DENNUM) AND DENNUM (SECOND(FIRST(LEX1))),
          EX1: EX1 * FIRST(LEX1)  EXIT,
      ENDBLOCK,
      LEX1: REST (LEX1)  EXIT,
    WHEN RECIP (FIRST(LEX2)),
      BLOCK
        WHEN NEGATIVE (DENNUM) AND DENNUM (SECOND(FIRST(LEX2))),
          EX1: EX1 * FIRST(LEX2)  EXIT,
      ENDBLOCK,
      LEX2: REST (LEX2)  EXIT,
  ENDBLOCK,
  LEX1: CONTENT (LEX1, LEX2),
  WHEN EX1 EQ 1 AND ATOM (LEX1), FALSE EXIT,
  MKPROD (MERGEPROD (EX1,
    MERGEPROD (PRODLEX (ADJOIN (EX1^-1, CANCEL(LEX1,LEX3)))  +
      PRODLEX (ADJOIN (EX1^-1, CANCEL(LEX1,LEX4))), LEX1))),
ENDFUN $

PROPERTY +, *, FUNCTION (EX1, LEX1),
  WHEN NEGATIVE (NUMNUM) OR NEGATIVE (DENNUM),
    WHEN EX1 EQ 1,  FACTOR(LEX1)  EXIT,
    WHEN PRODUCT(EX1),  FACTOR (LEX1, REST(EX1))  EXIT,
    FACTOR (LEX1, LIST(EX1)) EXIT,
ENDFUN $

PROPERTY +, ^, FUNCTION (EX1, EX2, EX3),
  WHEN NEGATIVE (NUMNUM) OR NEGATIVE (DENNUM),
    EX2: LIST ('^, EX2, EX3),
    WHEN EX1 EQ 1,  FACTOR (LIST(EX2))  EXIT,
    WHEN PRODUCT (EX1),  FACTOR (LIST(EX2), REST(EX1))  EXIT,
    FACTOR (LIST(EX2), LIST(EX1)) EXIT,
ENDFUN $


FUNCTION EXPD (EX1,
  % Local: %  PWREXPD, NUMNUM, DENDEN, DENNUM, NUMDEN, BASEXP, EXPBAS),
  PWREXPD: 6,
  NUMNUM: DENDEN: EXPBAS: 30,
  DENNUM: BASEXP: -30,
  NUMDEN: 0,
  EVAL (EX1),
ENDFUN $

FUNCTION FCTR (EX1,
  % Local: %  PWREXPD, NUMNUM, DENDEN, DENNUM, NUMDEN, BASEXP, EXPBAS),
  NUMNUM: DENDEN: -6,
  PWREXPD: NUMDEN: 0,
  DENNUM: BASEXP: -30,
  EXPBAS: 30,
  EVAL (EX1),
ENDFUN $


%****************** optional flags package ***************************%

FUNCTION FLAGS (
    % Local: % LEX1, EX1),
  EX1: LINELENGTH()-18,
  LEX1: FLAGS,
  NEWLINE (),
  LOOP
    WHEN ATOM (LEX1) EXIT,
    BLOCK
      WHEN GREATER (SPACES(), EX1),
	NEWLINE () EXIT,
    ENDBLOCK,
    PRINT (FIRST(LEX1)),
    PRINT (" = "),
    PRINT (EVAL(POP(LEX1))),
    SPACES (18 - MOD(SPACES(),18)),
  ENDLOOP,
  NEWLINE (),
  "",
ENDFUN $

RDS () $