(DEFPROP CYCOMAFNS
 (CYCOMAFNS MAXLIST
	    TWICE
	    CARLIST
	    CDRLIST
	    LCARLIST
	    LCDRLIST
	    DIFF
	    PLUSLIST
	    LMASSOC
	    NUMPARTITIONS
	    CLPARTITIONS
	    CLPARTS
	    CL=PARTS
	    CLDIFF
	    CLCOUNT
	    CLPARTITIONSN
	    CLCREATE
	    CLINSERT
	    CLEXPAND
	    GENRAD
	    GENRADS
	    GENRADLIST
	    GENRADLIST1
	    GROUPRADS
	    GROUPRADS1
	    VALENCE
	    GENMOL
	    NUMPARTITIONS*
	    GROUPBY
	    FVPARTITION1
	    FVPART1
	    MINLOOPS
	    MAXLOOPS)
VALUE)

(DEFPROP MAXLIST
 (LAMBDA (L) (FOR NEW X IN L MAX X))
EXPR)

(DEFPROP TWICE
 (LAMBDA (X) (PLUS X X))
EXPR)

(DEFPROP CARLIST
 (LAMBDA (L) (FOR NEW X IN L LIST (CAR X)))
EXPR)

(DEFPROP CDRLIST
 (LAMBDA (L) (FOR NEW X IN L LIST (CDR X)))
EXPR)

(DEFPROP LCARLIST
 (LAMBDA (L) (FOR NEW X IN L LIST (CARLIST X)))
EXPR)

(DEFPROP LCDRLIST
 (LAMBDA (L) (FOR NEW X IN L LIST (CDRLIST X)))
EXPR)

(DEFPROP DIFF
 (LAMBDA (L1 L2) (FOR NEW X IN L1 WHEN (NOT (MEMBER X L2)) XLIST X))
EXPR)

(DEFPROP PLUSLIST
 (LAMBDA (L) (FOR NEW X IN L PLUS X))
EXPR)

(DEFPROP LMASSOC
 (LAMBDA (X Y VAL) (PROG2 (FOR NEW PR IN Y DO (IF (EQUAL (CAR PR) X) THEN (RETURN (SETQ VAL (CDR PR))))) VAL))
EXPR)

(DEFPROP NUMPARTITIONS
 (LAMBDA(N NUMPARTS MINPART MAXPART)
  (IF (EQUAL NUMPARTS 1.)
      THEN
      (IF (OR (GREATERP MINPART N) (LESSP MAXPART N)) THEN NIL ELSE (LIST (LIST N)))
      ELSE
      (FOR NEW
	   I
	   :=
	   ((MAX MINPART (DIFFERENCE N (TIMES (SUB1 NUMPARTS) MAXPART))) (MIN MAXPART (QUOTIENT N NUMPARTS)))
	   FOR
	   NEW
	   RESTPART
	   IN
	   (NUMPARTITIONS (DIFFERENCE N I) (SUB1 NUMPARTS) I MAXPART)
	   LIST
	   (CONS I RESTPART))))
EXPR)

(DEFPROP CLPARTITIONS
 (LAMBDA(CL PARTSIZES)
  (IF (NULL PARTSIZES)
      THEN
      (LIST NIL)
      ELSEIF
      (NULL (CDR PARTSIZES))
      THEN
      (LIST (LIST CL))
      ELSEIF
      (ZEROP (CAR PARTSIZES))
      THEN
      (MAPCAR (FUNCTION (LAMBDA (X) (CONS NIL X))) (CLPARTITIONS CL (CDR PARTSIZES)))
      ELSEIF
      (EQUAL (CAR PARTSIZES) (CADR PARTSIZES))
      THEN
      (PROG (N THISPART)
	    (SETQ N 1.)
	    (SETQ THISPART (CAR PARTSIZES))
	    (FOR PARTSIZES ON (CDR PARTSIZES) WHILE (EQUAL (CAR PARTSIZES) THISPART) DO (SETQ N (ADD1 N)))
	    (IF (NULL PARTSIZES) THEN (RETURN (CL=PARTS CL N THISPART)))
	    (RETURN
	     (FOR NEW
		  BIGPART
		  IN
		  (CLPARTS CL (TIMES N THISPART))
		  AS
		  NEW
		  RESTPARTSLIST
		  IS
		  (CLPARTITIONS (CLDIFF CL BIGPART) PARTSIZES)
		  FOR
		  NEW
		  LITTLEPARTS
		  IN
		  (CL=PARTS BIGPART N THISPART)
		  FOR
		  NEW
		  RESTPARTS
		  IN
		  RESTPARTSLIST
		  XLIST
		  (APPEND LITTLEPARTS RESTPARTS))))
      ELSE
      (FOR NEW
	   PART
	   IN
	   (CLPARTS CL (CAR PARTSIZES))
	   FOR
	   NEW
	   PARTS
	   IN
	   (CLPARTITIONS (CLDIFF CL PART) (CDR PARTSIZES))
	   XLIST
	   (CONS PART PARTS))))
EXPR)

(DEFPROP CLPARTS
 (LAMBDA(CL PARTSIZE)
  (IF (ZEROP PARTSIZE)
      THEN
      (LIST NIL)
      ELSEIF
      (NULL (CDR CL))
      THEN
      (LIST (LIST (CONS (CAAR CL) PARTSIZE)))
      ELSE
      (PROG (SIZE)
	    (SETQ SIZE (DIFFERENCE PARTSIZE (CLCOUNT (CDR CL))))
	    (RETURN
	     (FOR NEW
		  X
		  :=
		  ((MAX SIZE 1.) (MIN PARTSIZE (CDAR CL)))
		  FOR
		  NEW
		  PART
		  IN
		  (CLPARTS (CDR CL) (DIFFERENCE PARTSIZE X))
		  XLIST
		  FIRST
		  (IF (LESSP 0. SIZE) THEN NIL ELSE (CLPARTS (CDR CL) PARTSIZE))
		  (CONS (CONS (CAAR CL) X) PART))))))
EXPR)

(DEFPROP CL=PARTS
 (LAMBDA(CL NPARTS PARTSIZE)
  (IF (NULL (CDR CL))
      THEN
      (SETQ CL (LIST (CONS (CAAR CL) PARTSIZE)))
      (LIST (FOR NEW I := (1. NPARTS) XLIST CL))
      ELSE
      (FOR NEW
	   X
	   IN
	   (NUMPARTITIONS (CDAR CL) NPARTS 0. PARTSIZE)
	   FOR
	   NEW
	   Y
	   IN
	   (CLPARTITIONS (CDR CL) (FOR NEW XX IN X LIST (DIFFERENCE PARTSIZE XX)))
	   XLIST
	   (FOR NEW XX IN X AS NEW YY IN Y LIST (IF (ZEROP XX) THEN YY ELSE (CONS (CONS (CAAR CL) XX) YY))))))
EXPR)

(DEFPROP CLDIFF
 (LAMBDA(CL1 CL2)
  (IF (NULL CL2)
      THEN
      CL1
      ELSEIF
      (EQUAL (CAR CL1) (CAR CL2))
      THEN
      (CLDIFF (CDR CL1) (CDR CL2))
      ELSEIF
      (EQ (CAAR CL1) (CAAR CL2))
      THEN
      (CONS (CONS (CAAR CL1) (DIFFERENCE (CDAR CL1) (CDAR CL2))) (CLDIFF (CDR CL1) (CDR CL2)))
      ELSE
      (CONS (CAR CL1) (CLDIFF (CDR CL1) CL2))))
EXPR)

(DEFPROP CLCOUNT
 (LAMBDA (CL) (FOR NEW X IN CL PLUS (CDR X)))
EXPR)

(DEFPROP CLPARTITIONSN
 (LAMBDA(CL N MINPARTSIZE MAXPARTSIZE)
  (FOR NEW
       PARTSIZES
       IN
       (NUMPARTITIONS (CLCOUNT CL) N MINPARTSIZE MAXPARTSIZE)
       NCONC
       FIRST
       NIL
       (CLPARTITIONS CL PARTSIZES)))
EXPR)

(DEFPROP CLCREATE
 (LAMBDA (L) (PROG (CL) (FOR NEW X IN L DO (SETQ CL (CLINSERT X CL))) (RETURN CL)))
EXPR)

(DEFPROP CLINSERT
 (LAMBDA(ITEM CL)
  (IF (NOT CL)
      THEN
      (LIST (CONS ITEM 1.))
      ELSEIF
      (EQUAL ITEM (CAAR CL))
      THEN
      (REPLACE (CDR (CAR CL)) (ADD1 (CDR (CAR CL))))
      CL
      ELSEIF
      (LEQ ITEM (CAAR CL))
      THEN
      (CONS (CONS ITEM 1.) CL)
      ELSE
      (REPLACE (CDR CL) (CLINSERT ITEM (CDR CL)))))
EXPR)

(DEFPROP CLEXPAND
 (LAMBDA (CL) (FOR NEW PR IN CL FOR NEW I := (1. (CDR PR)) LIST (CAR PR)))
EXPR)

(DEFPROP GENRAD
 (LAMBDA(CL)
  (IF (AND (NULL (CDR CL)) (EQUAL (CDAR CL) 1.))
      THEN
      (PERMRADS (CAAR CL) NIL T)
      ELSE
      (FOR NEW
	   OLDCL
	   ON
	   CL
	   AS
	   NEW
	   CENTER
	   IS
	   (CAAR OLDCL)
	   AS
	   NEW
	   NEWCL
	   IS
	   (CLDIFF CL (LIST (CONS CENTER 1.)))
	   FOR
	   NEW
	   DEGREE
	   :=
	   (1. (MIN (CLCOUNT NEWCL) (SUB1 (VALENCE CENTER))))
	   FOR
	   NEW
	   RADS
	   IN
	   (GENRADS NEWCL DEGREE)
	   NCONC
	   FIRST
	   NIL
	   (PERMRADS CENTER RADS T))))
EXPR)

(DEFPROP GENRADS
 (LAMBDA(CL N)
  (IF (NULL CL)
      THEN
      (LIST NIL)
      ELSE
      (FOR NEW PARTITION IN (CLPARTITIONSN CL N 1. (CLCOUNT CL)) NCONC FIRST NIL (GENRADLIST PARTITION))))
EXPR)

(DEFPROP GENRADLIST
 (LAMBDA (CLLIST) (GROUPRADS (GENRADLIST1 (CLCREATE CLLIST))))
EXPR)

(DEFPROP GENRADLIST1
 (LAMBDA (CLCL) (FOR NEW CLNUMPAIR IN CLCL LIST (CONS (GENRAD (CAR CLNUMPAIR)) (CDR CLNUMPAIR))))
EXPR)

(DEFPROP GROUPRADS
 (LAMBDA(RADCLIST)
  (IF (NULL RADCLIST)
      THEN
      (LIST NIL)
      ELSE
      (GROUPRADS1 (CAAR RADCLIST) (CDAR RADCLIST) (GROUPRADS (CDR RADCLIST)))))
EXPR)

(DEFPROP GROUPRADS1
 (LAMBDA(RADLIST N RADSLIST)
  (IF (ZEROP N)
      THEN
      RADSLIST
      ELSE
      (FOR RADLIST
	   ON
	   RADLIST
	   FOR
	   NEW
	   RADS
	   IN
	   (GROUPRADS1 RADLIST (SUB1 N) RADSLIST)
	   LIST
	   (CONS (CAR RADLIST) RADS))))
EXPR)

(DEFPROP VALENCE
 (LAMBDA (AT) (COND ((NUMBERP AT) AT) ((ATOM AT) (GET AT (QUOTE VALENCE))) (T (FREEVALENCESIZE AT))))
EXPR)

(DEFPROP GENMOL
 (LAMBDA(CL)
  (PROG	(MINDEG RESULT NATOMS)
	(IF (EQUAL 1. (SETQ NATOMS (CLCOUNT CL)))
	    THEN
	    (RETURN (PERMRADS (CAAR CL) NIL NIL))
	    ELSEIF
	    (ZEROP (REMAINDER NATOMS 2.))
	    THEN
	    (FOR NEW
		 PART
		 IN
		 (CL=PARTS CL 2. (QUOTIENT NATOMS 2.))
		 FOR
		 NEW
		 RADS
		 IN
		 (GENRADLIST PART)
		 DO
		 (SETQ RESULT (APPEND (PERMRADS NIL RADS NIL) RESULT)))
	    (SETQ MINDEG 3.)
	    ELSE
	    (SETQ MINDEG 2.))
	(SETQ NATOMS (SUB1 NATOMS))
	(FOR NEW
	     PAIR
	     IN
	     CL
	     AS
	     NEW
	     CENTER
	     IS
	     (CAR PAIR)
	     AS
	     NEW
	     NEWCL
	     IS
	     (CLDIFF CL (LIST (CONS CENTER 1.)))
	     FOR
	     NEW
	     DEG
	     :=
	     (MINDEG (MIN (VALENCE CENTER) NATOMS))
	     FOR
	     NEW
	     P
	     IN
	     (CLPARTITIONSN NEWCL DEG 1. (QUOTIENT NATOMS 2.))
	     FOR
	     NEW
	     RADS
	     IN
	     (GENRADLIST P)
	     DO
	     (SETQ RESULT (NCONC (PERMRADS CENTER RADS NIL) RESULT)))
	(RETURN RESULT)))
EXPR)

(DEFPROP NUMPARTITIONS*
 (LAMBDA(U MN MAXIMA OCCURLIST)
  (IF (NULL (CDR OCCURLIST))
      THEN
      (NUMPARTITIONS U (CAR OCCURLIST) MN (CAR MAXIMA))
      ELSE
      (FOR NEW
	   FIRST
	   :=
	   ((FIX+
	     (MAX MN
		  (DIFFERENCE
		   U
		   (FOR	NEW
			X
			IN
			(CDR MAXIMA)
			AS
			NEW
			Y
			IN
			(CDR OCCURLIST)
			PLUS
			FIRST
			(TIMES (SUB1 (CAR OCCURLIST)) (CAR MAXIMA))
			(TIMES X Y)))))
	    (MIN (CAR MAXIMA) (QUOTIENT (DIFFERENCE U (PLUSLIST (CDR OCCURLIST))) (CAR OCCURLIST))))
	   FOR
	   NEW
	   REST
	   IN
	   (IF (EQUAL (CAR OCCURLIST) 1.)
	       THEN
	       (NUMPARTITIONS* (DIFFERENCE U FIRST) 1. (CDR MAXIMA) (CDR OCCURLIST))
	       ELSE
	       (NUMPARTITIONS* (DIFFERENCE U FIRST) FIRST MAXIMA (CONS (SUB1 (CAR OCCURLIST)) (CDR OCCURLIST))))
	   XLIST
	   (CONS FIRST REST))))
EXPR)

(DEFPROP GROUPBY
 (LAMBDA(FN L)
  (IF (NULL L)
      THEN
      NIL
      ELSE
      (PROG (FNX GROUPCDR X)
	    (SETQ GROUPCDR (GROUPBY FN (CDR L)))
	    (IF	(NULL (SETQ X (LMASSOC (SETQ FNX (FN (CAR L))) GROUPCDR NIL)))
		THEN
		(RETURN (CONS (LIST FNX (CAR L)) GROUPCDR))
		ELSE
		(NCONC X (LIST (CAR L)))
		(RETURN GROUPCDR)))))
EXPR)

(DEFPROP FVPARTITION1
 (LAMBDA(N VL S)
  (COND	((NULL VL) (LIST NIL))
	(T
	 (PROG (SUMREST)
	       (SETQ SUMREST (FOR NEW X IN (CDR VL) AS NEW SP := ((ADD1 S) 9999999.) PLUS (TIMES SP X)))
	       (RETURN
		(FOR NEW
		     I
		     :=
		     ((MAX 0. (DIFFERENCE N SUMREST)) (MIN N (TIMES (CAR VL) S)))
		     AS
		     NEW
		     PARTREST
		     IS
		     (FVPARTITION1 (DIFFERENCE N I) (CDR VL) (ADD1 S))
		     FOR
		     NEW
		     FIRSTPART
		     IN
		     (FVPART1 I (CAR VL) S)
		     FOR
		     NEW
		     RESTPART
		     IN
		     PARTREST
		     XLIST
		     (CONS FIRSTPART RESTPART)))))))
EXPR)

(DEFPROP FVPART1
 (LAMBDA(N MAXSUM MAXOCCUR)
  (COND	((ZEROP MAXOCCUR) (LIST NIL))
	(T
	 (FOR NEW
	      I
	      :=
	      ((MAX 0. (DIFFERENCE N (TIMES MAXSUM (SUB1 MAXOCCUR)))) (MIN MAXSUM (QUOTIENT N MAXOCCUR)))
	      FOR
	      NEW
	      REST
	      IN
	      (FVPART1 (DIFFERENCE N (TIMES I MAXOCCUR)) (DIFFERENCE MAXSUM I) (SUB1 MAXOCCUR))
	      XLIST
	      (CONS I REST)))))
EXPR)

(DEFPROP MINLOOPS
 (LAMBDA(VALENCELIST)
  (MAX 0.
       (PROG (MXV TD)
	     (SETQ TD (SETQ MXV 0.))
	     (FOR NEW
		  X
		  IN
		  (CDR VALENCELIST)
		  AS
		  NEW
		  VALENCE
		  :=
		  (3. 999999.)
		  WHEN
		  (NOT (ZEROP X))
		  DO
		  (IF (GREATERP VALENCE MXV) THEN (SETQ MXV VALENCE))
		  (SETQ TD (PLUS (TIMES X VALENCE) TD)))
	     (RETURN (QUOTIENT (DIFFERENCE MXV TD) 2.)))))
EXPR)

(DEFPROP MAXLOOPS
 (LAMBDA(VALENCELIST)
  (MIN (CAR VALENCELIST) (FIX+ (FOR NEW W IN (CDDR VALENCELIST) AS NEW J := (2. 99999.) PLUS (TIMES 0.5 W J)))))
EXPR)