Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50216/lde6.l
Click 43,50216/lde6.l to see without markup as text/plain
There are 2 other files named lde6.l in the archive. Click here to see a list.
(DEFPROP CIRCFLAG T SPECIAL)
(DEFPROP TIME T SPECIAL)
(DEFPROP SS T SPECIAL)
(DEFPROP BIGY T SPECIAL)
(DEFPROP RSS T SPECIAL)
(DEFPROP RBIGY T SPECIAL)
(DEFPROP VARLIST T SPECIAL)
(DEFPROP VARNUM T SPECIAL)
(DEFPROP EXPOP T SPECIAL)
(DEFPROP SIMP T SPECIAL)
(DEFPROP *Y T SPECIAL)
(DEFPROP SP T SPECIAL)
(DEFPROP INIT T SPECIAL)
(DEFPROP REPSWITCH T SPECIAL)

 

      (QUOTE(FILE LDE))
(QUOTE(REALLY LDE7))

(DEFPROP LDESOLVE(LAMBDA(X)
   (PROG(Y CIRCFLAG INIT HOLDPOP TIME SS BIGY
    RSS RBIGY EQUAT REPSWITCH OLDEQUAT)
IDIOTTAG
   (COND((NOT(EQ(LENGTH X)3))(ERLIST(Q(LDESOLVE
    REQUIRES THREE ARGUMENTS)))))
   (SETQ X(MAPCAR(FUNCTION UNQUOTE)X))
   (SETQ EQUAT(CAR X))
   (COND
    ((OR(ATOM EQUAT)(NOT(EQ(CAR EQUAT)(Q EQUAL))))
     (ERLIST(Q(FIRST ARGUMENT OF LDESOLVE
          MUST BE AN EQUATION))))
    ((NOT(AND(LATOM(SETQ Y(CADR X)))(LATOM(SETQ TIME(CADDR X)))))
     (ERLIST(Q(SECOND AND THIRD ARGUMENTS OF
       LDESOLVE MUST BE ATOMS))))
    ((NOT(INN TIME EQUAT))(ERLIST(CONS TIME(Q(DOES NOT APPEAR)))))
    ((NOT(INN Y EQUAT))(ERLIST(CONS Y(QUOTE(DOES NOT APPEAR)))))
)
   (SETQ HOLDPOP EXPOP)
   (SETQ EXPOP 1000)
   (SETQ EQUAT(LIST(Q DIFFERENCE)(CADR EQUAT)(CADDR EQUAT)))
   (SETQ EQUAT(CLEANTALK(UNKLUDGE(SIMPLIFYA(KLUDGE(HYPERSUB EQUAT TIME))NIL))))
   (SETQ OLDEQUAT(SUMSPLIT EQUAT TIME))
   (COND(CIRCFLAG(SETQ OLDEQUAT(CLEANTALK(UNKLUDGE(SIMPLIFYA(KLUDGE OLDEQUAT) NIL))))))
   (SETQ EQUAT(LDEORDER OLDEQUAT Y))
   (SETQ INIT(INITQUERY Y(CAR EQUAT)))
   (SETQ SS(COND
      ((NOT(OR(INN(Q S)OLDEQUAT)(INN(Q S)INIT)))(Q S))
      ((NOT(OR(INN(Q SS)OLDEQUAT)(INN(Q SS)INIT)))(Q SS))
      (T(MLGEN)) ))
   (SETQ BIGY(GENSYM))
   (SETQ VARLIST(LIST SS BIGY))
   (VARWHOMP(SETQ EQUAT(CDR EQUAT))TIME)
(SETQ VARLIST(VLCUT VARLIST Y))
   (MAPC(FUNCTION(LAMBDA(J)(VARWHOMP J TIME)))INIT)
   (SETQ VARNUM(LENGTH(SETQ VARLIST(VLCUT VARLIST(Q LDED)))))
   (SETQ RSS(REP SS))
   (SETQ RBIGY(REP BIGY))
   (SETQ INIT(MAPCAR(FUNCTION(LAMBDA(J)(REP(BIN J))))INIT))
   (SETQ EQUAT(DELTX EQUAT Y))
   (SETQ VARLIST(WIPE BIGY VARLIST))
   (SETQ VARNUM(SUB1 VARNUM))
   (SETQ EQUAT(SIMPSIMP(ILTXF(MINUSF(QUOTIENTF(CADR(NUMERATORF EQUAT))(CAR(NUMERATORF EQUAT)))))))
   (SETQ EXPOP HOLDPOP)
   (RETURN(COND(SIMP EQUAT)(T(CLEANR EQUAT))))
))FEXPR)

(DEFPROP LDESOLVE LDESOLVE INTCOM)

(DEFPROP  LDESOLVE LDESOLVE SACRED)
(DEFPROP MAXL(LAMBDA(L)(PROG2(SETQ L(MAPCAR(FUNCTION EVAL)L))
(COND((CDR L)(MAX(CAR L)(EVAL(CONS(QUOTE MAXL)(CDR L)))))
(T(CAR L))
)))FEXPR)

(DEFPROP LDEORDER(LAMBDA(Z *Y)(COND
   ((EQ Z *Y)(CONS 0 *Y))
   ((EQ Z TIME)(CONS -1 Z))
   ((ATOM Z)(CONS -2 Z))
   ((AND(NOT(INN *Y Z))(NOT(INN TIME Z)))
    (CONS -2 Z))
   ((EQ(CAR Z)(Q PLUS))
    ((LAMBDA(J)(CONS(EVAL(CONS(Q MAXL)
      (MAPCAR(FUNCTION(LAMBDA(K)(CAR K)))J)))
       (CONS(Q PLUS)
        (MAPCAR(FUNCTION(LAMBDA(K)(CDR K)))J))))
     (MAPCAR(FUNCTION(LAMBDA(J)(LDEORDER J *Y)))
      (CDR Z))
))
   ((EQ(CAR Z)(Q TIMES))(LDETIMESORDER (CDR Z)*Y -2 NIL))
   ((EQ(CAR Z)(Q QUOTIENT))(CONS -2 Z))
   ((EQ(CAR Z)(Q DERIV))(COND
     ((AND(EQ(CADR Z)*Y)(EQ(CADDR Z)TIME)
       (NULL(CDDDDR Z)))
      (CONS(CADDDR Z)(LIST(Q LDED)(CADDDR Z))))
     ((ERLIST(Q(CANNOT SOLVE))))
   ))
   ((INN *Y Z)(ERLIST(Q(NOT LINEAR))))
   ((CONS -1 Z))
))EXPR)


(DEFPROP LDETIMESORDER(LAMBDA(Z Y ORD ANS)(COND
   ((NULL Z)(CONS ORD(CONS(Q TIMES)(REV ANS))))
   ((EQ(CAR Z)TIME)(COND
     ((MINUSP ORD)
      (LDETIMESORDER(CDR Z)Y -1(CONS TIME ANS)))
     ((ERLIST(Q(NOT LINEAR WITH CONSTANT COEFICIENTS))))))
   ((EQ(CAR Z)Y)(COND
     ((EQUAL ORD -2)
      (LDETIMESORDER(CDR Z)Y 0(CONS Y ANS)))
     ((ERLIST(Q(NOT LINEAR WITH CONSTANT COEFFICIENTS))))))
   ((OR(ATOM(CAR Z))(AND(NOT(INN TIME(CAR Z)))(NOT(INN Y(CAR Z)))))
    (LDETIMESORDER(CDR Z)Y ORD(CONS(CAR Z)ANS)))
   ((AND(EQ(CAAR Z)(Q DERIV))
        (EQ(CADAR Z)Y)
        (EQ(CADDAR Z)TIME)
        (NULL(CDDDDR(CAR Z)))
        (EQUAL ORD -2)
    )
    (LDETIMESORDER(CDR Z)Y(CADDDR(CAR Z))
    (CONS (LIST(Q LDED)(CADDDR(CAR Z)))ANS)))
   ((AND(INN TIME(CAR Z))(NOT(INN Y(CAR Z)))(MINUSP ORD))
    (LDETIMESORDER(CDR Z)Y -1(CONS(CAR Z)ANS)))
   ((ERLIST(Q(NOT LINEAR WITH CONSTANT COEFICIENTS))))
))EXPR)
(DEFPROP INITQUERY(LAMBDA(Y N)
   (PROG(K NAME FORMFLAG REPLY ANS)
   (COND((LESSP N 1)(RETURN NIL)))
   (SETQ K -1)
C   (PRINLIST(Q(NEED INITIAL CONDITIONS)))
A   (PRINC (QUOTE #))
  (SETQ REPLY(ERRSET(PRE)NIL))
   (COND((NOT REPLY)(GO C)))
   (SETQ REPLY(CAR REPLY))
   (COND((EQ REPLY(Q ASK))NIL)
        ((EQ REPLY(Q ALLFORMAL))(SETQ FORMFLAG T))
        ((GO DROP))
   )
LOOP (SETQ K(ADD1 K))
(COND((EQ K N)(RETURN(PROG2(TERPRI)(REVERSE ANS)))))
   (SETQ NAME(INITNAMEMAKE Y K))
   (COND(FORMFLAG(GO SKIP)))
B   (TERPRI)
  (CHARYBDIS(LIST(Q EQUAL)NAME SP)1 (LINELENGTH NIL))
   (PRINC(QUOTE #))
   (SETQ REPLY(ERRSET(UNQUOTE(PRE))ERTALK))
   (COND((NULL REPLY)(GO B)))
   (SETQ REPLY(CAR REPLY))
   (COND((EQ REPLY(Q ALLFORMAL))(SETQ FORMFLAG T)))
SKIP (SETQ ANS(CONS(COND((OR FORMFLAG(EQ REPLY(Q FORMAL)))NAME)(REPLY))ANS))
   (GO LOOP)
DROP (PRINLIST(Q(TYPE ASK OR ALLFORMAL)))
   (GO A)
))EXPR)

(DEFPROP INITNAMEMAKE(LAMBDA(Y N)(PROG(ANS K)
   (SETQ ANS(NCONS Y))
   (SETQ K 0)
LOOP (COND((EQ K N)(RETURN(LIST(READLIST(REVERSE ANS))0))))
   (SETQ ANS(CONS(Q ')ANS))
   (SETQ K(ADD1 K))
   (GO LOOP)
))EXPR)
(DEFPROP DELTX(LAMBDA(*Z *Y)(COND
   ((AND(NOT(INN(Q LDED)*Z))(NOT(INN *Y *Z)))
    (PROG(ANS)
     (SETQ VARLIST(WIPE BIGY VARLIST))
    (SETQ VARNUM(SUB1 VARNUM))
     (SETQ ANS((LAMBDA(J)(COND
     ((NULL J)J)
     ((POLP J)(NCONS J))
     ((CONS(NCONS(CAR J))(NCONS(CDR J))))
     ))
          (LAPTR5 *Z TIME SS T)))
     (SETQ VARLIST(APPEND VARLIST(NCONS BIGY)))
    (SETQ VARNUM(ADD1 VARNUM))
     (RETURN ANS) ))
   ((EQ *Z *Y)RBIGY)
   ((EQ(CAR *Z)(Q PLUS))
    (MULTPLUSF(MAPCAR(FUNCTION(LAMBDA(J)(DELTX J *Y)))(CDR *Z))))
   ((EQ(CAR *Z)(Q LDED))(DELTXDER(CADR *Z)))
   ((DELTXTIMES(CDR *Z)*Y))
))EXPR)

(DEFPROP MULTPLUSF(LAMBDA(X)(COND
   ((NULL X)NIL)
   ((PLUSF(CAR X)(MULTPLUSF(CDR X))))
))EXPR)

(DEFPROP DELTXDER(LAMBDA(N)(COND
   ((EQ N 1)(DIFFERENCEF(TIMESF RSS RBIGY)(CAR INIT)))
   ((DIFFERENCEF(TIMESF RSS(DELTXDER(SUB1 N)))
     (NNTH N INIT)))
))EXPR)

(DEFPROP NNTH(LAMBDA(N LIST)(COND
   ((EQ N 1)(CAR LIST))
   ((NNTH(SUB1 N)(CDR LIST)))
))EXPR)

(DEFPROP DELTXTIMES(LAMBDA(X Y)(COND
   ((NULL X)(REP 1))
   ((OR(EQ(CAR X)Y)(AND(NOT(ATOM(CAR X)))
      (EQ(CAAR X)(Q LDED))))
    (TIMESF(DELTX(CAR X)Y)(DELTXTIMES(CDR X)Y)))
   ((TIMESF(REP(CAR X))(DELTXTIMES(CDR X)Y)))
))EXPR)