(PRIN1 (QUOTE "
WRITEFILE OF {PHYLUM}<IDL>SOURCES>BENCHMARK.;4 MADE BY KAPLAN ON 19-Dec-84 14:46:03
")T)
(TERPRI T)
(PRIN1 "Must be connected to Eggs data directory" T)
(* Standard IDL Benchmark on Dempster Egg Data)
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(LOAD? (QUOTE <IDL>PERF.COM)
(QUOTE SYSLOAD)))
[D (PUTD (QUOTE INSTRS)
(QUOTE (LAMBDA ($$Q)
(APPLY* (QUOTE TIMEALL)
$$Q]
NIL)
(RESETLST (RESETSAVE S)
(RESETSAVE PROMPT#FLG)
(RESETSAVE BENCHTESTARITHFNS (QUOTE (PLUS TIMES DIFFERENCE QUOTIENT GREATERP LESSP)))
(* The fns on BENCHTESTARITHFNS must be redefined in TEST before the benchmark can run)
(AND TESTSYS (NEQ (SYSTEMTYPE)
(QUOTE D))
(PROGN [MAPC BENCHTESTARITHFNS (FUNCTION (LAMBDA (A)
(MOVD? A (PACK* A (QUOTE .LISP]
(LOADFNS BENCHTESTARITHFNS (PACKFILENAME (QUOTE DIRECTORY)
IDLDIRECTORY
(QUOTE NAME)
(QUOTE USERARITH)
(QUOTE EXTENSION)
COMPILE.EXT)
T)))
(LOAD (QUOTE EGGS.DATA))
(* Sets S)
(RESETSAVE (OUTPUT T))
[DRIBBLE (PACK* (QUOTE BENCHMARK.DRIBBLE-)
(if TESTSYS then (QUOTE TEST)
else
(QUOTE IDL]
(LINELENGTH 80)
[INSTRS (QUOTE (MAPC (QUOTE ((PPA S)
[PPA (MPROD (QUOTE ((2 -1 3)
(1 -2 -1)))
(QUOTE ((3 -1)
(1 2)
(-1 1]
[PPA (TRANSLATE [AT S (QUOTE ((FURROW]
(QUOTE ((NIL 2 1)
(3 4 2)
(5 NIL 3]
[SETQ TABLE (COUNTS (GROUP (AT S (QUOTE (ALL (ROW COLOR]
(PPA TABLE)
(SETQ ROWTOT (RPLUS (KEEP TABLE 1)))
(PPA ROWTOT)
(SETQ COLTOT (RPLUS (KEEP TABLE 2)))
(PPA COLTOT)
(PPA (QUOTIENT (KEEP TABLE 2)
COLTOT))
(SETQ D (DEAL 7))
(PPA D)
(SETQ L (GENVEC 1 13))
(PPA L)
[PPA (RESHAPE L (QUOTE (5 2 2]
(SETQ NEWS (COPY S))
(ASSIGN (AT NEWS (LABEL 2 (QUOTE FURROW)))
(QUOTE HALF))
[ASSIGN (AT NEWS (QUOTE (ALL HALF)))
([ELAMBDA ((A SCALAR))
(COND
((LESSP A 4)
1)
(T 2))]
(AT NEWS (QUOTE (ALL HALF]
[ASSIGN (AT NEWS (CODE (QUOTE HALF)))
(QUOTE ((1 LEFT)
(2 RIGHT]
(PPA NEWS)
[SETQ PAR (MOMENTS (GROUP [AT NEWS (QUOTE (ALL (ROW HALF]
(AT NEWS (QUOTE (ALL VOLUME]
(SETQQ PRECISION (3 7))
(PPA PAR)
(SETQQ PRECISION (4 3))
(SETQ AN.VAR (ANOVA PAR))
(PPA AN.VAR)
[PPA (QUOTIENT TABLE (RPLUS (KEEP TABLE 1]
[SETQ CR (COVAR (AT S (QUOTE (ALL (WIDTH LENGTH VOLUME]
(PPA CR)
(PPA (NORM CR))
(SETQ REGR (SWEEP CR 1))
(PPA REGR)
(SETQ REGR (SWEEP REGR (QUOTE LENGTH)))
(PPA REGR)
(SETQ REGR (SWEEP REGR NIL 2))
(PPA REGR)
[SETQ COEF (AT REGR (QUOTE (VOLUME WIDTH]
[SETQ CONST (AT REGR (QUOTE (VOLUME Constant]
(SETQ RESID (DIFFERENCE
(AT S (QUOTE (ALL VOLUME)))
(PLUS [TIMES COEF (AT S (QUOTE (ALL WIDTH]
CONST)))
(PPA RESID)
(PLOT RESID)
(HIST L)
(SETQ L (DIFFERENCE L 8))
(HIST L)))
(FUNCTION (LAMBDA (FORM)
(TERPRI)
(TERPRI)
(PRIN1 "←")
(PRINT (EVAL (PROGN (PRINTDEF FORM 2)
(TERPRI)
FORM)))
(TERPRI)
(TERPRI]
(PRINT (DRIBBLE))
[AND TESTSYS (NEQ (SYSTEMTYPE)
(QUOTE D))
(MAPC BENCHTESTARITHFNS (FUNCTION (LAMBDA (X)
(PUTD X (GETD (PACK* X (QUOTE .LISP]
(* Restore arithmetic functions if necessary))
STOP