(FILECREATED "24-AUG-73 20:06:01" TREE.CLISP)


  (LISPXPRINT (QUOTE TREEVARS)
              T)
  (RPAQQ TREEVARS ((FNS GENRADLIST GENRADS GENRADD GENRAD GENMOL 
                        PERMRADS PERMRADL)))
(DEFINEQ

(GENRADLIST
  [LAMBDA (CLCL)
    (GROUPRADS (for X in CLCL collect <(GENRAD X:1)
                                        ! X::1>])

(GENRADS
  [LAMBDA (CL N)
    (if CL=NIL
        then <NIL>
      else (for PARTITION in (CLPARTITIONSN CL N 1 (CLCOUNT CL))
              join (GENRADLIST (CLCREATE PARTITION])

(GENRADD
  [LAMBDA (CENTER NEWCL)
    (for DEGREE from 1 to (MIN (CLCOUNT NEWCL)
                               (VALENCE CENTER)+ -1)
       join (for RADCL in (GENRADS NEWCL DEGREE)
               join (PERMRADL CENTER RADCL T])

(GENRAD
  [LAMBDA (CL)
    (if CL::1=NIL and CL:1::1=1
        then (PERMRADL CL:1:1 NIL T)
      else (for PR in CL join (GENRADD PR:1 (CLDIFF CL <<PR:1 ! 1>>])

(GENMOL
  [LAMBDA (CL)
    (PROG (MINDEG RESULT NATOMS)
          (if 1=NATOMS←(CLCOUNT CL)
              then (RETURN (PERMRADL CL:1:1 NIL NIL))
            elseif NATOMS/2*2=NATOMS
              then (for PART in (CLEQUALPARTS CL 2 NATOMS/2)
                      do (for RADS in (GENRADLIST (CLCREATE PART))
                            do RESULT← <! (PERMRADL NIL RADS NIL)
                                          ! RESULT>))
                   MINDEG←3
            else MINDEG←2)
          (NATOMS←NATOMS-1)
          [for PAIR in CL bind NEWCL
             do (NEWCL←(CLDIFF CL <<PAIR:1 ! 1>>))
                (for DEG from MINDEG to (MIN (VALENCE PAIR:1)
                                             NATOMS)
                   do (for P in (CLPARTITIONSN NEWCL DEG 1 NATOMS/2)
                         do (for RADS in (GENRADLIST (CLCREATE P))
                               do RESULT← <!! (PERMRADL PAIR:1 RADS NIL)
                                              ! RESULT>]
          (RETURN RESULT])

(PERMRADS
  [LAMBDA (CENT CLRADS FLAG)
    (if (ATOM CENT)
        then <(RADICAL CENTER = CENT ATTACHEDRADS = CLRADS)>
      elseif }(STRUCTURE? CENT)
        then <(RADICAL CENTER =(MAKECENTER RADSTRUC = CENT)
                       ATTACHEDRADS = CLRADS)>
      else (for ST
              in (LABELFV CENT
                          ([LAMBDA (X)
                              (if FLAG
                                  then <1 ! X>
                                else X]
                            (CDRLIST CLRADS)))
              collect (RADICAL CENTER =(MAKECENTER
                                 AFFLINK =(if FLAG
                                              then (CAAR (LABELED
                                                           ST))
                                            else NIL)
                                 RADSTRUC =(LSTRUC ST)
                                 CUFFLINKS =(if FLAG
                                                then
                                                 (CDR (LABELED ST))
                                              else (LABELED ST)))
                               ATTACHEDRADS = CLRADS])

(PERMRADL
  [LAMBDA (CENT LRADS FLAG)
    (PERMRADS CENT (CLCREATE LRADS)
              FLAG])
)
STOP