perm filename EXAMPL[PAT,LMM] blob
sn#097626 filedate 1974-04-15 generic text, type T, neo UTF8
(FILECREATED " 6-APR-74 07:17:19" EXAMPLE)
(LISPXPRINT (QUOTE EXAMPLEVARS)
T)
(RPAQQ EXAMPLEVARS
((FNS EXAMPLE SELECT SELECTL SELECTLL EDGES EXAMPLELLABELNODES
EXAMPLELABELFV EXAMPLELABELEDGES 1ATRAND SPLIT REXAMPLE)
(VARS (EXAMPLEFIXED))
(USERMACROS DE)))
(DEFINEQ
(EXAMPLE
[LAMBDA (X)
(COND
((type? STRUCTURE X)
X)
[(STRUCLIST? X)
(EXAMPLE (1ATRAND (CDDR X]
((NOFORMIN X)
X)
[(NOT EXAMPLEFIXED)
(UNDONLSETQ
(PROG (Y (EXAMPLEFIXED T)
(GENSYMLST (QUOTE ($$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10
$$11 $$12 $$13 $$14 $$15)))
TEM)
(SETQ TEM
(OR (GETP (CAR (fetch FORM of X))
(QUOTE DESCENDANTS))
(PROGN (SETQ TEM
(QUOTE (SUPERATOMPARTITIONS MOLECULES SUPERATOMS
RINGS RINGSKELETONS
NOFVRINGS DAISIES
NUMPARTITIONS
BIVALENTPARTITIONS
NOLOOPEDRINGS
PERMRADS GENMOL)))
(OR (MEMB (CAR (fetch FORM of X))
TEM)
(SETQ TEM (CONS (CAR (fetch FORM of X))
TEM)))
TEM)))
[for X IN TEM BIND NEWFN
DO
[/MOVD
X
(SETQ NEWFN
(COND
((CAR (SETQ GENSYMLST (CDR GENSYMLST)))
(AND
(GETD (CAR GENSYMLST))
(HELP "ERROR IN EXAMPLE"
"FUNCTION DEFINITIONS MAY HAVE BEEN SMASHED"))
(CAR GENSYMLST))
(T (GENSYM]
(/PUTD X (LIST (QUOTE LAMBDA)
(SETQ TEM (ARGLIST X))
(LIST (QUOTE LIST)
(LIST (QUOTE 1ATRAND)
(CONS NEWFN TEM]
(/MOVD (QUOTE EXAMPLELABELEDGES)
(QUOTE LABELEDGES))
(/MOVD (QUOTE EXAMPLELABELFV)
(QUOTE LABELFV))
(/MOVD (QUOTE EXAMPLELLABELNODES)
(QUOTE LLABELNODES))
[SETQ X (CONS (QUOTE DONE)
(COPY (EXAMPLE X]
(ERROR!)))
(COND
((EQ (CAR X)
(QUOTE DONE))
(CDR X))
(T (ERROR!]
((type? STRUCFORM X)
(REXAMPLE (CDDR X))
(SETQ X (GENAPPLY X FIXEDFNLIST T))
(COND
((STRUCLIST? X)
(1ATRAND (CDR X)))
(T X)))
(T (REXAMPLE X])
(SELECT
[LAMBDA (L N)
(NLEFT L N])
(SELECTL
[LAMBDA (OBJ LNUM)
(PROG (X)
(AND LNUM (CONS [CAR (SETQ X (SPLIT OBJ (CAR LNUM]
(SELECTL (CDR X)
(CDR LNUM])
(SELECTLL
[LAMBDA (LOBJ LLNUM)
(AND LOBJ LLNUM (CONS (SELECTL (CAR LOBJ)
(CAR LLNUM))
(SELECTLL (CDR LOBJ)
(CDR LLNUM])
(EDGES
[LAMBDA (STRUC)
(for CT in (fetch CTABLE of STRUC)
join (for N in (fetch NBRS of CT)
when (AND (SMALLP N)
(NOT (IGREATERP (fetch NODENUM of CT)
N)))
rcollect (CONS (fetch NODENUM of CT)
N])
(EXAMPLELLABELNODES
[LAMBDA (STRUC LLABELS)
(LIST (create LABELING LABELED ←(SELECTLL (LISTBYVALENCE STRUC)
LLABELS)
LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])
(EXAMPLELABELFV
[LAMBDA (STRUC LABELS)
(LIST (create LABELING LABELED ←(SELECTL (COLLECTFV STRUC)
LABELS)
LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])
(EXAMPLELABELEDGES
[LAMBDA (STRUC LABELS)
(LIST (create LABELING LABELED ←(SELECTL (EDGES STRUC)
LABELS)
LSTRUC ←(create STRUCTURE reusing STRUC GROUP ← NIL])
(1ATRAND
[LAMBDA (L)
(CAR (NTH L (RAND 1 (LENGTH L])
(SPLIT
[LAMBDA (L N)
(* Returns a pair of lists, (l1 . l2) WHERE l1 is a list of
elements of L, of length N, and l2 is the REMAINDER)
(COND
((NULL L)
(LIST NIL))
((ZEROP N)
(CONS NIL L))
((EQ N (LENGTH L))
(LIST L))
[(NOT (IGREATERP (RAND 1 (LENGTH L))
N))
([LAMBDA (Z)
(RPLACA Z (CONS (CAR L)
(CAR Z]
(SPLIT (CDR L)
(SUB1 N]
(T ([LAMBDA (Z)
(RPLACD Z (CONS (CAR L)
(CDR Z]
(SPLIT (CDR L)
N])
(REXAMPLE
[LAMBDA (X) (* Replaces any STRUCFORMs with
examples of them)
(COND
((OR (NLISTP X)
(type? STRUCTURE X)))
((type? STRUCFORM X)
(/RPLNODE2 X (EXAMPLE X)))
(T (REXAMPLE (CAR X))
(REXAMPLE (CDR X])
)
(RPAQ EXAMPLEFIXED)
[ADDTOVAR USERMACROS (DE NIL (ORR ((E (DRAW (EXAMPLE (##))
T)
T))
((E (QUOTE (can't draw]
(ADDTOVAR EDITCOMSA DE)
STOP