(FILECREATED " 6-APR-74 03:29:06" TREE

     changes to:  GENRADD, GENRAD, GENMOL

     previous date: "11-MAR-74  1:34:44")


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

(GENRADLIST
  [LAMBDA (CLCL)
    (GROUPRADS (MAPCAR CLCL (FUNCTION (LAMBDA (X)
                           (CONS (GENRAD (CAR X))
                                 (CDR X])

(GENRADS
  [LAMBDA (CL N)
    (COND
      ((NULL CL)
        (LIST NIL))
      (T (for PARTITION in (CLPARTITIONSN CL N 1 (CLCOUNT CL))
            join (GENRADLIST (CLCREATE PARTITION])

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

(GENRAD
  [LAMBDA (CL)
    (COND
      ((AND (NULL (CDR CL))
            (EQUAL (CDAR CL)
                   1))
        (PERMRADL (CAAR CL)
                  NIL T))
      (T (for OLDCL on CL join (GENRADD OLDCL:1:1 (CLDIFF CL <<OLDCL:1:1
                                                               ! 1>>])

(GENMOL
  [LAMBDA (CL)
    (COND
      [(STRUCINCL CL)
        (LIST (create FORM FN ←(QUOTE GENMOL)
                      ARGS ←(LIST CL]
      (T (PROG (MINDEG RESULT NATOMS)
               (COND
                 ((EQ (SETQ NATOMS (CLCOUNT CL))
                      1)
                   (RETURN (PERMRADL (CAAR CL)
                                     NIL NIL)))
                 ((EVENP NATOMS)
                   [for PART in (CLEQUALPARTS CL 2 (IQUOTIENT NATOMS 2))
                      do (for RADS in (GENRADLIST (CLCREATE PART))
                            do (SETQ RESULT (APPEND (PERMRADL NIL RADS NIL)
                                                    RESULT]
                   (SETQ MINDEG 3))
                 (T (SETQ MINDEG 2)))
               (SETQ NATOMS (SUB1 NATOMS))
               [for PAIR in CL bind NEWCL
                  eachtime [SETQ NEWCL (CLDIFF CL (LIST (CONS (CAR PAIR)
                                                              1]
                  do (for DEG from (IMIN (VALENCE (CAR PAIR))
                                         NATOMS)
                        to MINDEG by -1
                        do (for P in (CLPARTITIONSN NEWCL DEG 1 (IQUOTIENT
                                                      NATOMS 2))
                              do (for RADS in (GENRADLIST (CLCREATE P))
                                    do (SETQ RESULT (NCONC (PERMRADL
                                                             (CAR PAIR)
                                                             RADS NIL)
                                                           RESULT]
               (RETURN RESULT])

(PERMRADS
  [LAMBDA (CENT CLRADS FLAG)
    (COND
      [(OR (type? STRUCFORM CENT)
           (STRUCINCL CLRADS))
        (LIST (create FORM FN ←(QUOTE PERMRADS)
                      ARGS ←(LIST CENT CLRADS FLAG]
      ((ATOM CENT)
        (LIST (create RADICAL CENTER ← CENT ATTACHEDRADS ← CLRADS)))
      ((NOT (type? STRUCTURE CENT))
        (HELP "ERROR IN PERMRADS" "CENTER NOT ATOM AND NOT STRUCTURE"))
      (T (for ST in (LABELFV CENT ([LAMBDA (X)
                                 (COND
                                   (FLAG (CONS 1 X))
                                   (T X]
                               (CDRLIST CLRADS)))
            collect (create RADICAL CENTER ←[create
                              MAKECENTER AFFLINK ←(COND
                                (FLAG (CAAR (fetch LABELED of ST)))
                                (T NIL))
                              RADSTRUC ←(fetch LSTRUC of ST)
                              CUFFLINKS ←(COND
                                (FLAG (CDR (fetch LABELED of ST)))
                                (T (fetch LABELED of ST]
                            ATTACHEDRADS ← CLRADS])

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