(FILECREATED " 2-NOV-73  4:02:30" S-TOPLEVEL)


  (LISPXPRINT (QUOTE TOPLEVELVARS)
              T)
  (RPAQQ TOPLEVELVARS
         ((* This contains all of the "TOP LEVEL" functions; i.e. those 
             things that one might want to see as output, and might be 
             turned off, etc (except those in STRUCTURE))
          (FNS MOLECULES SUPERATOMS RINGS RINGSKELETONS NOFVRINGS 
               DAISIES NOLOOPEDRINGS SINGLERINGS KLOOPEDRINGS)
          (FNS ATTACHFVS ATTACHBIVALENTS ATTACHBIVS&LOOPS 
               STRUCTURESWITHATOMS)))

(* This contains all of the "TOP LEVEL" functions; i.e. those things
that one might want to see as output, and might be turned off, etc
(except those in STRUCTURE))

(DEFINEQ

(MOLECULES
  [LAMBDA (CL U)
    (COND
      ((ZEROP U)
        (GENMOL CL))
      (T (FOR SAP IN (SUPERATOMPARTITIONS CL U) FOR S
            IN (SUPERATOMS (fetch SUPERATOMPARTS of SAP))
            AS NEWCL IS (APPEND (CLCREATE S)
                                (fetch REMAININGATOMS of SAP))
            JOIN (COND
                   ((EQ (CLCOUNT NEWCL)
                        1)
                     (LIST (CAAR NEWCL)))
                   (T (GENMOL NEWCL])

(SUPERATOMS
  [LAMBDA (UCL-COMP)
    (GROUPRADS (FOR UCLN IN UCL-COMP COLLECT
                                      (CONS (RINGS (CAAR UCLN)
                                                   (CDAR UCLN))
                                            (CDR UCLN])

(RINGS
  [LAMBDA (U CL)
    (COND
      [(EQ 2 (CLCOUNT CL))
        (SETQ CL (CLEXPAND CL))
        (LIST (STRUCWITH2NODES (ADD1 U)
                               (CAR CL)
                               (CADR CL]
      (T (PROG (FV)
               (SETQ FV (COMPUTEFV U CL))
               (SETQ CL (CLBYVALENCE CL))
               (RETURN (FOR SKELETON
                          IN (RINGSKELETONS
                               FV
                               (MAPCAR CL (FUNCTION CLCOUNT)))
                          JOIN (STRUCTURESWITHATOMS CL SKELETON])

(RINGSKELETONS
  [LAMBDA (FV VL)
    (COND
      ((ZEROP FV)
        (NOFVRINGS VL))
      (T (FOR FVSECTION IN (GROUPBY (FUNCTION [LAMBDA (X)
                                        (FETCH NEWVL OF X])
                                    (FVPARTITIONS FV VL))
            AS STRUCLIST IS (NOFVRINGS (CAR FVSECTION)) FOR FVPART
            IN (CDR FVSECTION) FOR STRUC
            IN STRUCLIST
            JOIN (ATTACHFVS (FETCH FVR OF FVPART)
                            STRUC])

(NOFVRINGS
  [LAMBDA (VL)
    (PROG (SUMREST)
          (COND
            ([ZEROP (SETQ SUMREST (SUMOF (CDR VL]
              (SINGLERINGS (CAR VL)))
            ((EQ SUMREST 1)
              (DAISIES VL))
            (T (FOR P FROM (MINLOOPS VL) TO (MAXLOOPS VL)
                  JOIN (KLOOPEDRINGS P VL])

(DAISIES
  [LAMBDA (VL)
    (FOR P IN (NUMPARTITIONS (CAR VL)
                             (IQUOTIENT (FOR X IN (CDR VL)
                                           AS I
                                           FROM 3
                                           UNTIL (NOT (ZEROP X))
                                                 PROGN I)
                                        2)
                             1 NIL)
       JOIN (DAISY (CLCREATE P])

(NOLOOPEDRINGS
  [LAMBDA (VL)
    (COND
      ((ZEROP (CAR VL))
        (CATALOG (CDR VL)))
      (T (PROG (BP)
               (SETQ BP (BIVALENTPARTITIONS VL))
               (RETURN (FOR S IN (CATALOG (CDR VL)) FOR P IN BP
                          JOIN (ATTACHBIVALENTS (CLCREATE P)
                                                S])

(SINGLERINGS
  [LAMBDA (N)
    (LIST (SINGLERING N])

(KLOOPEDRINGS
  [LAMBDA (P VL)
    (COND
      ((ZEROP P)
        (NOLOOPEDRINGS VL))
      (T (FOR LPSECTION IN (LOOPPARTITIONS P VL)
            AS STRUCLIST IS (NOFVRINGS (FETCH LOOPVL OF (CAR LPSECTION))
                                       )
            WHEN STRUCLIST
            JOIN (FOR LOOPPART IN LPSECTION FOR STRUC IN STRUCLIST
                    JOIN (ATTACHBIVS&LOOPS (FETCH EDGELABELS OF 
                                                  LOOPPART)
                                           (FETCH LOOPLABELS OF 
                                                  LOOPPART)
                                           STRUC])
)
(DEFINEQ

(ATTACHFVS
  [LAMBDA (FVP STRUC)
    (FOR L IN (LLABELNODES STRUC FVP)
              XLIST
              (PUTFVS (COPYSTRUC (FETCH LSTRUC OF L))
                      (FETCH LABELED OF L])

(ATTACHBIVALENTS
  [LAMBDA (PART STRUC)
    (FOR L IN (LABELEDGES STRUC (CDRLIST PART))
              XLIST
              (PUTBIVS (COPYSTRUC (FETCH LSTRUC OF L))
                       (CARLIST PART)
                       (FETCH LABELED OF L])

(ATTACHBIVS&LOOPS
  [LAMBDA (EL LL STRUC)
    (COND
      [(NOT EL)
        (FOR L2 IN (LLABELNODES STRUC (LCDRLIST LL))
                   XLIST
                   (PUTLOOPS (COPYSTRUC (FETCH LSTRUC OF L2))
                             (LCARLIST LL)
                             (FETCH LABELED OF L2]
      (T (FOR L1 IN (LABELEDGES STRUC (CDRLIST EL)) FOR L2
            IN (LLABELNODES (FETCH LSTRUC OF L1)
                            (LCDRLIST LL))
               XLIST
               (PUTLOOPS (PUTBIVS (COPYSTRUC (FETCH LSTRUC OF L2))
                                  (CARLIST EL)
                                  (FETCH LABELED OF L1))
                         (LCARLIST LL)
                         (FETCH LABELED OF L2])

(STRUCTURESWITHATOMS
  [LAMBDA (CLL STRUC)
    [COND
      ([EVERY CLL (FUNCTION (LAMBDA (X)
                  (NULL (CDR X]
        (SETQ STRUC (COPYSTRUC STRUC))
        (FOR X IN (fetch CTABLE of STRUC)
           DO (replace ATOMTYPE of (fetch MARKERS of X)
                       with
                       (CAAAR (NTH CLL (NODEVALENCE X)
                                   1]
    (FOR L IN (LLABELNODES STRUC (LCDRLIST CLL))
       COLLECT (INSERTMARKERS (COPYSTRUC (FETCH LSTRUC OF L))
                              CLL
                              (FETCH LABELED OF L])
)
STOP