(FILECREATED " 4-NOV-73  0:21:49" S-EXAMPLE)


  (LISPXPRINT (QUOTE EXAMPLEVARS)
              T)
  (RPAQQ EXAMPLEVARS
         ((* Stuff for doing examples - Again, this needs work. 
             Problems are vagaries of UNDONLSETQ's, and the use of 
             ADVISE by EXAMPLE to select how to selectively turn things 
             off)
          (FNS EXAMPLE SELECT SELECTL SELECTLL EDGES EXAMPLELLABELNODES 
               EXAMPLELABELFV EXAMPLELABELEDGES 1ATRAND SPLIT REXAMPLE 
               /RPLNODE2)
          (VARS (EXAMPLEFIXED))
          (USERMACROS DE)))

(* Stuff for doing examples - Again, this needs work. Problems are
vagaries of UNDONLSETQ's, and the use of ADVISE by EXAMPLE to select
how to selectively turn things off)

(DEFINEQ

(EXAMPLE
  [LAMBDA (X)
    (COND
      ((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 
                                                       KLOOPEDRINGS 
                                                           PERMRADS 
                                                           GENMOL)))
                             (OR (MEMB (CAR (fetch FORM of X))
                                       TEM)
                                 (SETQ TEM
                                   (CONS (CAR (fetch FORM of X))
                                         TEM)))
                             TEM)))
                [FOR X IN TEM AS NEWFN IS
                                 (COND
                                   ((CAR (SETQ GENSYMLST (CDR GENSYMLST)
                                           ))
                                     (NOT (GETD (CAR GENSYMLST)))
                                     (CAR GENSYMLST))
                                   (T (GENSYM)))
                   DO (/MOVD X NEWFN)
                      (/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!]
      ((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) FOR N
       IN (fetch NBRS of CT)
       WHEN (NOT (IGREATERP (fetch NODENUM of CT)
                            N))
            XLIST
            (CONS (fetch NODENUM of CT)
                  N])

(EXAMPLELLABELNODES
  [LAMBDA (STRUC LLABELS)
    (LIST (create LABELING LABELED←(SELECTLL (LISTBYVALENCE STRUC)
                                             LLABELS)
                  LSTRUC←(create STRUCTURE reusing STRUC (SETQ GROUP 
                                                     NIL])

(EXAMPLELABELFV
  [LAMBDA (STRUC LABELS)
    (LIST (create LABELING (SETQ LABELED (SELECTL (COLLECTFV STRUC)
                                                  LABELS))
                  LABELS
                  (SETQ 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)
           (STRUCTURE? X)))
      ((STRUCFORM? X)
        (/RPLNODE2 X (EXAMPLE X)))
      (T (REXAMPLE (CAR X))
         (REXAMPLE (CDR X])

(/RPLNODE2
  [LAMBDA (OLD NEW)
    (/RPLNODE OLD (CAR NEW)
                  (CDR NEW])
)
  (RPAQ EXAMPLEFIXED)
  [ADDTOVAR USERMACROS (DE NIL (ORR ((E (DRAW (EXAMPLE (##))
                                              T)
                                        T))
                                    ((E (QUOTE (can't draw]
  (ADDTOVAR EDITCOMSA DE)
STOP