Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

 	(DEFPROP MLCOUNT T SPECIAL)
(DEFPROP VARLIST T SPECIAL)
(DEFPROP REPSWITCH T SPECIAL)
(DEFPROP SP T SPECIAL)
(DEFPROP FLIST T SPECIAL)


(SETQ MLCOUNT 0)

(DEFPROP SOLVE
 (LAMBDA (X Y)
  (PROG
   (SOLVEE IT
	   SHEEP
	   GOATS
	   WORK
	   FLIST
	   DESCRIMSQRT
	   FIRSTQUOT
	   SECONDQUOT
	   HOLDSYM
           REPSWITCH)
  (COND
    ((OR (NULL X) (NULL (CDR X)) (CDDR X))
     (ERLIST (QUOTE (SOLVE TAKES
			   TWO
			   ARGUMENTS)))))
   (SETQ X (MAPCAR (FUNCTION (LAMBDA (J) (BIN (UNQUOTE J)))) X))
   (COND
    ((OR (ATOM (CAR X))
	 (NOT (EQ (CAAR X) (QUOTE EQUAL))))
     (ERLIST (QUOTE (FIRST ARGUMENT
			   OF
			   SOLVE
			   MUST
			   BE
			   AN
			   EQUATION)))))
   (SETQ SOLVEE (LIST (QUOTE DIFFERENCE)
		      (CADAR X)
		      (CADDAR X)))
   (COND ((NOT (RFP SOLVEE(CADR X)))
	  (ERLIST (QUOTE (FIRST ARGUMENT
				OF
				SOLVE
				MUST
				BE
				RATIONAL
				IN
				SECOND)))))
   (SETQ VARLIST (CDR X))
   (NEWVAR SOLVEE)
   (SETQ REPSWITCH T)
   (SETQ SOLVEE (NUMERATORF (REP SOLVEE)))
   (COND ((LESSP (LENGTH SOLVEE) 2)
	  (ERLIST (QUOTE (CANNOT SOLVE)))))
   (COND((POLMINUSP SOLVEE)(SETQ SOLVEE(POLMINUS SOLVEE))))
   (SETQ SOLVEE (INTFACTOR SOLVEE))
   (SETQ SOLVEE (CONS (RCONFAC (CAR SOLVEE))
		      (CDR SOLVEE)))
SHEEPFROMGOATS
   (COND ((NULL SOLVEE)
	  (GO TOLDSHEEPFROMGOATS)))
   (COND ((LESSP (LENGTH (CAR SOLVEE)) 4)
	  (GO TOLDASHEEP)))
   (SETQ GOATS (CONS (CAR SOLVEE) GOATS))
   (SETQ SOLVEE (CDR SOLVEE))
   (GO SHEEPFROMGOATS)
TOLDASHEEP
   (SETQ SHEEP (CONS (CAR SOLVEE) SHEEP))
   (SETQ SOLVEE (CDR SOLVEE))
   (GO SHEEPFROMGOATS)
TOLDSHEEPFROMGOATS
   (SETQ
    SHEEP
    (MULTSORT
     (MAPCAR (FUNCTION (LAMBDA (J)
			       (CONS 1 J)))
	     SHEEP)))
   (SETQ
    GOATS
    (MULTSORT
     (MAPCAR (FUNCTION (LAMBDA (J)
			       (CONS 1 J)))
	     GOATS)))
   (PRINLIST (QUOTE (THE ROOTS ARE)))
   (COND ((NULL SHEEP) (GO NOSHEEP)))
MORESHEEP
   (SETQ WORK (CAR SHEEP))
   (COND ((NULL (CDDDR WORK)) (GO LINEAR)))
   (SETQ
    DESCRIMSQRT
    (SQRTF
     (DIFFERENCEF
      (TIMESF (CADDR WORK) (CADDR WORK))
      (TIMESF
       (TIMESF
	(FORMCONST 4 (RANK (CADR WORK)))
	(CADR WORK))
       (CADDDR WORK)))))
   (SETQ
    FIRSTQUOT
    (SIMPSIMP
     (TRANS
      (QUOTIENTF
       (MINUSF (CADDR WORK))
       (TIMESF
	(FORMCONST 2 (RANK (CADR WORK)))
	(CADR WORK))))))
   (SETQ
    SECONDQUOT
    (SIMPSIMP
     (TRANS
      (QUOTIENTF
       (CAR DESCRIMSQRT)
       (TIMESF
	(FORMCONST 2 (RANK (CADR WORK)))

	(CADR WORK))))))
   (SETQ
    IT
    (SIMPSIMP
     (LIST
      (QUOTE PLUS)
      FIRSTQUOT
      (LIST
       (QUOTE TIMES)
       SECONDQUOT
       (LIST
	(QUOTE EXPT)
	(SIMPSIMP (TRANS (CDR DESCRIMSQRT)))
	(QUOTE (QUOTIENT 1 2)))))))
   (MLABSET (SETQ HOLDSYM (MLGEN))
	    (SPT (REMDIF (CLEANR IT)))
	    NIL)
   (REPEAT1 (LIST (QUOTE SETQ)
		  HOLDSYM
		  (MGET HOLDSYM)))
   (MULTPRINT (CAR WORK))
   (PRINT (QUOTE AND))
   (TERPRI)
   (SETQ
    IT
    (SIMPSIMP
     (LIST
      (QUOTE DIFFERENCE)
      FIRSTQUOT
      (LIST
       (QUOTE TIMES)
       SECONDQUOT
       (LIST
	(QUOTE EXPT)
	(SIMPSIMP (TRANS (CDR DESCRIMSQRT)))
	(QUOTE (QUOTIENT 1 2)))))))
   (MLABSET (SETQ HOLDSYM (MLGEN))
	    (SPT (REMDIF (CLEANR IT)))
	    NIL)
   (REPEAT1 (LIST (QUOTE SETQ)
		  HOLDSYM
		  (MGET HOLDSYM)))
   (GO SHEEPCONT)
NOMORESHEEP
   (COND
    ((NULL GOATS)
     (RETURN (AND (PRINT (QUOTE FINISHED))
		    (TERPRI NIL)))))
   (PRINC SP)
   (PRINC (QUOTE AND))
(PRINC SP)
   (GO NOSHEEP)
LINEAR
   (SETQ
    IT
    (SIMPSIMP
     (TRANS
      (TIMESF (INVERTF (MINUSF (CADR WORK)))
	      (CADDR WORK)))))
   (MLABSET (SETQ HOLDSYM (MLGEN))
	    (SPT (REMDIF (CLEANR IT)))
	    NIL)
   (REPEAT1 (LIST (QUOTE SETQ)
		  HOLDSYM
		  (MGET HOLDSYM)))
SHEEPCONT
   (MULTPRINT (CAR WORK))
   (SETQ SHEEP (CDR SHEEP))
   (COND ((NULL SHEEP) (GO NOMORESHEEP)))
   (PRINC SP)
   (PRINC (QUOTE AND))
   (GO MORESHEEP)
NOSHEEP
   (SETQ WORK (CAR GOATS))
   (SETQ HOLDSYM (MLGEN))
   (MLABSET
    HOLDSYM
    (LIST
     (QUOTE EQUAL)
(SPT(REMDIF     (CLEANR (SIMPSIMP (TRANS (CDR WORK))))))
     0)
    NIL)
   (PRINLIST (QUOTE (THE ROOTS OF)))
   (REPEAT1 (LIST (QUOTE SETQ)
		  HOLDSYM
		  (MGET HOLDSYM)))
   (MULTPRINT (CAR WORK))
   (SETQ GOATS (CDR GOATS))
   (COND
    ((NULL GOATS)
     (RETURN
	     (AND(PRINT (QUOTE FINISHED))(TERPRI NIL)))))
   (PRINC SP)
   (PRINC (QUOTE AND))
   (GO NOSHEEP)))
 FEXPR)



 (DEFPROP MULTPRINT
 (LAMBDA(N)
  (COND

   ((ONEP N)(PRINT(QUOTE ONCE)))

   ((EQUAL N 2)(PRINT(QUOTE TWICE)))

   (T(PROG()

      (PRINC N)

      (PRINC SP)

      (PRINC (QUOTE TIMES))

      (RETURN NIL)))

 ))EXPR)

  

  

  

 (DEFPROP MULTSORT
 (LAMBDA(L)
  (COND

    ((NULL L)NIL)

    ((MULTSORTQUERY(CDAR L)(CDR L))(MULTSORT(MULTSORTELIM(CAR L)(CDR 

L)))

             )

    (T(CONS(CAR L)(MULTSORT(CDR L))))

    ))EXPR)

  

 (DEFPROP MULTSORTQUERY
 (LAMBDA(X L)
  (COND

    ((NULL L)NIL)

    ((EQUAL X(CDAR L))T)

    (T(MULTSORTQUERY X(CDR L)))

 ))EXPR)

  

 (DEFPROP MULTSORTELIM
 (LAMBDA(X L)
  (COND

    ((EQUAL(CDR X)(CDAR L))
    (CONS(CONS(PLUS(CAR X)(CAAR L))

                  (CDR X))(CDR L)))

    (T(CONS(CAR L)(MULTSORTELIM X(CDR L))))

 ))EXPR)

(DEFPROP MLGEN
 (LAMBDA ()
  (PROG2
   (SETQ MLCOUNT (ADD1 MLCOUNT))

   (READLIST (MCONS (Q M)
		     (Q L)
		      (EXPLODE MLCOUNT)))))
 EXPR)