(FILECREATED " 9-NOV-73  0:56:23" S-TOPLEVEL

     changes to:  ATTACHFVS,STRUCTURESWITHATOMS

     previous date: " 7-NOV-73  5:18:55")


  (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)
          (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 (U.CL.CL)
    (GROUPRADS (for UCLN in U.CL.CL 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)
    (SETQ VL (TRIMZEROS VL))
    (COND
      ((NULL (CDR VL))
        (SINGLERINGS (CAR VL)))
      ([EVERY (CDR VL)
              (FUNCTION (LAMBDA (X Y)
                  (OR (ZEROP X)
                      (AND (EQ X 1)
                           (NULL (CDR Y]
        (DAISIES VL))
      (T (FOR P FROM (MINLOOPS VL) TO (MAXLOOPS VL)
            JOIN (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])

(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])
)
(DEFINEQ

(ATTACHFVS
  [LAMBDA (FVP STRUC)
    (COND
      [(STRUCFORM? STRUC)
        (LIST (create FORM FN←(QUOTE ATTACHFVS)
                      ARGS←(LIST FVP STRUC]
      (T (for L in (LLABELNODES STRUC FVP)
            collect (PUTFVS (COPYSTRUC (fetch LSTRUC of L))
                            (fetch LABELED of L])

(ATTACHBIVALENTS
  [LAMBDA (PART STRUC)
    (COND
      [(STRUCFORM? STRUC)
        (LIST (create FORM FN←(QUOTE ATTACHBIVALENTS)
                      ARGS←(LIST PART STRUC]
      (T (for L in (LABELEDGES STRUC (CDRLIST PART))
            collect (PUTBIVS (COPYSTRUC (fetch LSTRUC of L))
                             (CARLIST PART)
                             (fetch LABELED of L])

(ATTACHBIVS&LOOPS
  [LAMBDA (EL LL STRUC)
    (COND
      [(STRUCFORM? STRUC)
        (LIST (create FORM FN←(QUOTE ATTACHBIVS&LOOPS)
                      ARGS←(LIST EL LL STRUC]
      [(NULL 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
      [(STRUCFORM? STRUC)
        (LIST (create FORM FN←(QUOTE STRUCTURESWITHATOMS)
                      ARGS←(LIST CLL STRUC]
      ([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 (SUB1 (NODEVALENCE X]
        (LIST STRUC))
      (T (for L in (LLABELNODES STRUC (LCDRLIST CLL))
            collect (INSERTMARKERS (COPYSTRUC (fetch LSTRUC of L))
                                   CLL
                                   (fetch LABELED of L])
)
STOP