(DEFPROP CYCOMBFNS
 (CYCOMBFNS MOLECULES
	    SUPERATOMPARTITIONS
	    MAXUNSATL
	    SUPERATOMS
	    COMPUTEFV
	    CLBYVALENCE
	    RINGS
	    FVPARTITIONS
	    RINGSKELETONS
	    NOFV-RINGS
	    DAISIES
	    NOLOOPEDRINGS
	    ROWS
	    BIVALENTPARTITIONS
	    FREEVALENCESIZE
	    NODES
	    COLLECTFV
	    TRIMZEROS
	    CATALOG
	    STRUCWITH2NODES
	    CATALOG3
	    DAISY
	    SINGLERING
	    BIVCHAIN
	    CONNECT
	    COPYSTRUC
	    DISCONNECT
	    FINDCTE
	    FIRSTOFNODES
	    LASTOFNODES
	    LISTBYVALENCE
	    PUTFVN
	    PUTFVS
	    PUTNEWNODE
	    PUTNEWNODEINCT
	    NODEVALENCE
	    VALENCETYPE
	    SINGLERINGS
	    INSERTMARKERS
	    DELETE)
VALUE)

(DEFPROP MOLECULES
 (LAMBDA(CL U)
  (IF (ZEROP U)
      THEN
      (GENMOL CL)
      ELSE
      (FOR NEW
	   SAP
	   IN
	   (SUPERATOMPARTITIONS CL U)
	   FOR
	   NEW
	   S
	   IN
	   (SUPERATOMS (SUPERATOMPARTS SAP))
	   NCONC
	   FIRST
	   NIL
	   (GENMOL (APPEND (CLCREATE S) (REMAININGATOMS SAP))))))
EXPR)

(DEFPROP SUPERATOMPARTITIONS
 (LAMBDA(CL U)
  (PROG	(CL1)
	(SETQ CL1 (FOR NEW PR IN CL WHEN (EQUAL (VALENCE (CAR PR)) 1.) LIST PR))
	(SETQ CL (CLDIFF CL CL1))
	(RETURN
	 (FOR NEW
	      PARTSIZE
	      :=
	      (2. (CLCOUNT CL))
	      FOR
	      NEW
	      VHAT
	      IN
	      (CLPARTS CL PARTSIZE)
	      AS
	      NEW
	      REMATS
	      IS
	      (APPEND CL1 (CLDIFF CL VHAT))
	      FOR
	      NEW
	      #PARTS
	      :=
	      (1. (QUOTIENT PARTSIZE 2.))
	      FOR
	      NEW
	      PARTITION
	      IN
	      (CLPARTITIONSN VHAT #PARTS 2. 9999.)
	      AS
	      NEW
	      VI
	      IS
	      (CLCREATE PARTITION)
	      AS
	      NEW
	      MXUI
	      IS
	      (MAXUNSATL VI (AND (NULL REMATS) (NULL (CDR VI)) (EQ (CDAR VI) 1.)))
	      WHEN
	      MXUI
	      FOR
	      NEW
	      UI
	      IN
	      (NUMPARTITIONS* U 1. MXUI (MAPCAR (QUOTE CDR) VI))
	      XLIST
	      (SUPERATOMPARTITION
	       REMAININGATOMS
	       =
	       REMATS
	       SUPERATOMPARTS
	       =
	       (PROG (CVI CVN M VI2 CUI VI3)
		     (SETQ VI3 VI)
		VILOOP
		     (IF (NULL VI3) THEN (RETURN VI2))
		     (SETQ CVI (CAAR VI3))
		     (SETQ CVN (CDAR VI3))
		     (SETQ VI3 (CDR VI3))
		LOOPM
		     (SETQ M 0.)
		LOOPCVN
		     (SETQ M (ADD1 M))
		     (SETQ CVN (SUB1 CVN))
		     (SETQ CUI (CAR UI))
		     (SETQ UI (CDR UI))
		     (IF (AND (NOT (ZEROP CVN)) (EQUAL CUI (CAR UI))) THEN (GO LOOPCVN))
		     (SETQ VI2 (CONS (CONS (CONS CUI CVI) M) VI2))
		     (IF (ZEROP CVN) THEN (GO VILOOP) ELSE (GO LOOPM))))))))
EXPR)

(DEFPROP MAXUNSATL
 (LAMBDA(PC FVCANBE0FLAG)
  (FOR NEW
       PART-NUM
       IN
       PC
       LIST
       (PROG (N TD M)
	     (SETQ N (SETQ TD (SETQ M 0.)))
	     (FOR NEW
		  PR
		  IN
		  (CAR PART-NUM)
		  DO
		  (SETQ N (PLUS N (CDR PR)))
		  (SETQ TD (PLUS TD (TIMES (CDR PR) (VALENCE (CAR PR)))))
		  (SETQ M (MAX M (VALENCE (CAR PR)))))
	     (RETURN
	      (FIX
	       (TIMES 0.5
		      (PLUS 2.
			    TD
			    (TIMES -2. N)
			    (MIN (COND (FVCANBE0FLAG 0.) (T -1.)) (DIFFERENCE TD (TWICE M))))))))))
EXPR)

(DEFPROP SUPERATOMS
 (LAMBDA(UCL-COMP)
  (GROUPRADS (FOR NEW UCLN IN UCL-COMP LIST (CONS (RINGS (CAAR UCLN) (CDAR UCLN)) (CDR UCLN)))))
EXPR)

(DEFPROP COMPUTEFV
 (LAMBDA(U CL)
  (PROG	(TD N)
	(SETQ TD (SETQ N 0.))
	(FOR NEW PR IN CL DO (SETQ TD (PLUS (TIMES (VALENCE (CAR PR)) (CDR PR)) TD)) (SETQ N (PLUS (CDR PR) N)))
	(RETURN (PLUS 2. TD (TIMES -2. (PLUS N U))))))
EXPR)

(DEFPROP CLBYVALENCE
 (LAMBDA(CL)
  (PROG2 (SETQ CL (GROUPBY (FUNCTION (LAMBDA (PR) (VALENCE (CAR PR)))) CL))
	 (FOR NEW I := (2. (MAXLIST (MAPCAR (QUOTE CAR) CL))) LIST (LMASSOC I CL NIL))))
EXPR)

(DEFPROP RINGS
 (LAMBDA(U CL)
  (PROG	(FV)
	(SETQ FV (COMPUTEFV U CL))
	(SETQ CL (CLBYVALENCE CL))
	(RETURN
	 (FOR NEW
	      SKELETON
	      IN
	      (RINGSKELETONS FV (MAPCAR (QUOTE CLCOUNT) CL))
	      NCONC
	      FIRST
	      NIL
	      (STRUCTURESWITHATOMS CL SKELETON)))))
EXPR)

(DEFPROP FVPARTITIONS
 (LAMBDA(FV VL)
  (FOR NEW
       FVP
       IN
       (FVPARTITION1 FV (CDR VL) 1.)
       AS
       NEW
       FVR
       IS
       (ROWS FVP)
       XLIST
       (FVPARTITION FVR
		    =
		    FVR
		    NEWVL
		    =
		    (FOR NEW
			 ROW
			 IN
			 FVR
			 AS
			 NEW
			 COL
			 IN
			 (CONS NIL FVP)
			 AS
			 NEW
			 V
			 IN
			 VL
			 LIST
			 (PLUS V (PLUSLIST ROW) (MINUS (PLUSLIST COL)))))))
EXPR)

(DEFPROP RINGSKELETONS
 (LAMBDA(FV VL)
  (FOR NEW
       FVPART
       IN
       (FVPARTITIONS FV VL)
       FOR
       NEW
       STRUC
       IN
       (NOFV-RINGS (NEWVL FVPART))
       NCONC
       FIRST
       NIL
       (ATTACHFVS (FVR FVPART) STRUC)))
EXPR)

(DEFPROP NOFV-RINGS
 (LAMBDA(VL)
  (PROG	(MNLPS MXLPS SUMREST)
	(SETQ SUMREST (PLUSLIST (CDR VL)))
	(IF (ZEROP SUMREST)
	    THEN
	    (RETURN (SINGLERINGS (CAR VL)))
	    ELSEIF
	    (EQUAL SUMREST 1.)
	    THEN
	    (RETURN (DAISIES VL)))
	(SETQ MNLPS (MINLOOPS VL))
	(SETQ MXLPS (MAXLOOPS VL))
	(RETURN (FOR NEW P := (MNLPS MXLPS) NCONC FIRST NIL (KLOOPEDRINGS P VL)))))
EXPR)

(DEFPROP DAISIES
 (LAMBDA(VL)
  (FOR NEW
       P
       IN
       (NUMPARTITIONS
	(CAR VL)
	(QUOTIENT (FOR NEW X IN (CDR VL) AS NEW I := (3. INFINITY) UNTIL (NOT (ZEROP X)) PROG2 I) 2.)
	1.
	99999999.)
       NCONC
       FIRST
       NIL
       (DAISY (CLCREATE P))))
EXPR)

(DEFPROP NOLOOPEDRINGS
 (LAMBDA(VL)
  (IF (ZEROP (CAR VL))
      THEN
      (CATALOG (CDR VL))
      ELSE
      (PROG (BP)
	    (SETQ BP (BIVALENTPARTITIONS VL))
	    (RETURN
	     (FOR NEW
		  S
		  IN
		  (CATALOG (CDR VL))
		  FOR
		  NEW
		  P
		  IN
		  BP
		  NCONC
		  FIRST
		  NIL
		  (ATTACHBIVALENTS (CLCREATE P) S))))))
EXPR)

(DEFPROP ROWS
 (LAMBDA (LL) (IF (NOT LL) THEN (QUOTE (NIL)) ELSE (CONS (CARLIST LL) (ROWS (CDRLIST (CDR LL))))))
EXPR)

(DEFPROP BIVALENTPARTITIONS
 (LAMBDA(VL)
  (NUMPARTITIONS (CAR VL)
		 (QUOTIENT (FOR NEW I := (3. INFINITY) AS NEW X IN (CDR VL) PLUS (TIMES I X)) 2.)
		 0.
		 (CAR VL)))
EXPR)

(DEFPROP FREEVALENCESIZE
 (LAMBDA(S)
  (IF (STRUCTURE? S)
      THEN
      (FOR NEW X IN (CTABLE S) FOR NEW Y IN (NBRS X) WHEN (EQ Y (QUOTE FV)) PLUS 1.)
      ELSEIF
      (STRUCFORM? S)
      THEN
      (IF (EQ (CAR (FORM S)) (QUOTE ATTACHFVS))
	  THEN
	  (FOR NEW FVL IN (CADR (FORM S)) FOR NEW X IN FVL AS NEW I := (1. INFINITY) PLUS (TIMES I X))
	  ELSE
	  (FREEVALENCESIZE (CADDR (FORM S))))
      ELSE
      (HELP "WHAT'S THE FREE VALNECE OF" S)))
EXPR)

(DEFPROP NODES
 (LAMBDA (STRUC) (FOR NEW CT IN (CTABLE STRUC) LIST (NODENUM CT)))
EXPR)

(DEFPROP COLLECTFV
 (LAMBDA (S) (FOR NEW CT IN (CTABLE S) FOR NEW X IN (NBRS CT) WHEN (EQ X (QUOTE FV)) XLIST (NODENUM CT)))
EXPR)

(DEFPROP TRIMZEROS
 (LAMBDA(L)
  (PROG	NIL
	(RETURN
	 (IF (NULL L) THEN NIL ELSEIF (ZEROP (PLUSLIST L)) THEN NIL ELSE (CONS (CAR L) (TRIMZEROS (CDR L)))))))
EXPR)

(DEFPROP CATALOG
 (LAMBDA(L)
  (IF (AND (EQUAL (PLUSLIST (SETQ L (TRIMZEROS L))) 2.) (EQUAL (CAR (LAST L)) 2.))
      THEN
      (LIST (STRUCWITH2NODES (PLUS 2. (LENGTH L))))
      ELSE
      (CATALOG3 L)))
EXPR)

(DEFPROP STRUCWITH2NODES
 (LAMBDA(N)
  (STRUCTURE UGRAPH
	     =
	     (CONS (QUOTE MBONDS) N)
	     CTABLE
	     =
	     (LIST (CTENTRY NODENUM = 1. NBRS = (FOR NEW I := (1. N) XLIST 2.))
		   (CTENTRY NODENUM = 2. NBRS = (FOR NEW I := (1. N) XLIST 1.)))
	     LASTNODE#
	     =
	     2.))
EXPR)

(DEFPROP CATALOG3
 (LAMBDA(TVL)
  (PROG	(C)
	(COND ((NOT (ZEROP (PLUSLIST (CDR TVL)))) NIL) (T (SETQ C (NTH CATALOG-LIST (QUOTIENT (CAR TVL) 2.)))))
	(RETURN (IF (AND C (CAR C)) THEN (CAR C) ELSE (LIST (STRUCFORM FORM = (CONS (QUOTE CATALOG) TVL)))))))
EXPR)

(DEFPROP DAISY
 (LAMBDA(PART)
  (PROG	(S C)
	(SETQ LASTNODE 1.)
	(SETQ S
	      (STRUCTURE UGRAPH
			 =
			 (CONS (QUOTE DAISY) PART)
			 CTABLE
			 =
			 (LIST (CTENTRY NODENUM = LASTNODE))
			 LASTNODE#
			 =
			 LASTNODE))
	(SETQ C LASTNODE)
	(FOR NEW PAIR IN PART FOR NEW I := (1. (CDR PAIR)) DO (SETQ S (PUTBIVN S C (CAR PAIR))))
	(RETURN (LIST S))))
EXPR)

(DEFPROP SINGLERING
 (LAMBDA(N)
  (PROG	(S)
	(SETQ LASTNODE 0.)
	(SETQ S (BIVCHAIN N))
	(CONNECT (CAR (CTABLE S)) (CAR (LAST (CTABLE S))))
	(RETURN (STRUCTURE FROM S UGRAPH = (CONS (QUOTE SINGLERING) N)))))
EXPR)

(DEFPROP BIVCHAIN
 (LAMBDA (N) (PROG (X) (FOR NEW I := (1. N) DO (SETQ X (PUTNEWNODE X))) (RETURN X)))
EXPR)

(DEFPROP CONNECT
 (LAMBDA(X Y)
  (PROG	NIL
	(REPLACE (NBRS X) (CONS (NODENUM Y) (NBRS X)))
	(COND ((NOT (EQ X Y)) (REPLACE (NBRS Y) (CONS (NODENUM X) (NBRS Y)))))))
EXPR)

(DEFPROP COPYSTRUC
 (LAMBDA (S) (PROG2 (SETQ LASTNODE (LASTNODE# S)) (COPY S)))
EXPR)

(DEFPROP DISCONNECT
 (LAMBDA(X Y)
  (PROG NIL (REPLACE (NBRS X) (DELETE (NODENUM Y) (NBRS X))) (REPLACE (NBRS Y) (DELETE (NODENUM X) (NBRS Y)))))
EXPR)

(DEFPROP FINDCTE
 (LAMBDA(N LST)
  (COND	((NUMBERP N) (COND ((STRUCTURE? LST) (SETQ LST (CTABLE LST))) (T NIL))
		     (FOR NEW L IN LST WHEN (EQUAL (NODENUM L) N) DO (RETURN L)))
	((NUMBERP LST) (FINDCTE LST N))
	(T (ERROR (QUOTE (BAD ARGUMENTS TO FINDCTE))))))
EXPR)

(DEFPROP FIRSTOFNODES
 (LAMBDA (X) (NODENUM (CAR (CTABLE X))))
EXPR)

(DEFPROP LASTOFNODES
 (LAMBDA (X) (NODENUM (CAR (LAST (CTABLE X)))))
EXPR)

(DEFPROP LISTBYVALENCE
 (LAMBDA(S)
  (PROG	(M V)
	(SETQ M (LENGTH (CTABLE S)))
	(RETURN
	 (FOR NEW
	      I
	      :=
	      (2. INFINITY)
	      WHILE
	      (GREATERP M 0.)
	      LIST
	      (SETQ V (VALENCETYPE S I))
	      (SETQ M (DIFFERENCE M (LENGTH V)))
	      V))))
EXPR)

(DEFPROP PUTFVN
 (LAMBDA(S N J)
  (PROG	NIL
	(SETQ N (FINDCTE N (CTABLE S)))
	(REPLACE (NBRS N) (NCONC (NBRS N) (FOR NEW I := (1. J) XLIST (QUOTE FV))))
	(RETURN S)))
EXPR)

(DEFPROP PUTFVS
 (LAMBDA(S FVP)
  (PROG2 (FOR NEW
	      NI
	      IN
	      FVP
	      FOR
	      NEW
	      NIJ
	      IN
	      NI
	      AS
	      NEW
	      J
	      :=
	      (1. 10.)
	      FOR
	      NEW
	      NODE
	      IN
	      NIJ
	      DO
	      (SETQ S (PUTFVN S NODE J)))
	 S))
EXPR)

(DEFPROP PUTNEWNODE
 (LAMBDA(STRUC)
  (COND	(STRUC
	 (PROG2	(SETQ LASTNODE (ADD1 (LASTNODE# STRUC)))
		(STRUCTURE FROM
			   STRUC
			   CTABLE
			   =
			   (PUTNEWNODEINCT (CTENTRY NODENUM = LASTNODE) (CTABLE OF STRUC))
			   LASTNODE#
			   =
			   LASTNODE)))
	(T
	 (PROG2	(SETQ LASTNODE (ADD1 LASTNODE))
		(STRUCTURE CTABLE = (LIST (CTENTRY NODENUM = LASTNODE)) LASTNODE# = LASTNODE)))))
EXPR)

(DEFPROP PUTNEWNODEINCT
 (LAMBDA(X Y)
  (PROG	(Z)
	(SETQ Z (CAR Y))
	(REPLACE (NBRS OF Z) (CONS (NODENUM X) (NBRS Z)))
	(REPLACE (NBRS OF X) (CONS (NODENUM Z) (NBRS X)))
	(RETURN (CONS X Y))))
EXPR)

(DEFPROP NODEVALENCE
 (LAMBDA(NODE)
  (COND	((NULL NODE) (ERROR (QUOTE (NULL NODE GIVEN TO NODEVALENCE))))
	((CTENTRY? NODE) (LENGTH (NBRS NODE)))
	(T (NODEVALENCE (FINDCTE (CAR NODE) (CDR NODE))))))
EXPR)

(DEFPROP VALENCETYPE
 (LAMBDA (S I) (FOR NEW NODE IN (CTABLE S) WHEN (EQUAL I (NODEVALENCE NODE)) XLIST (NODENUM NODE)))
EXPR)

(DEFPROP SINGLERINGS
 (LAMBDA (N) (LIST (SINGLERING N)))
EXPR)

(DEFPROP INSERTMARKERS
 (LAMBDA(STRUC CLL L)
  (PROG	NIL
	(FOR NEW
	     CL
	     IN
	     CLL
	     AS
	     NEW
	     NLL
	     IN
	     L
	     FOR
	     NEW
	     PAIR
	     IN
	     CL
	     AS
	     NEW
	     NL
	     IN
	     NLL
	     FOR
	     NEW
	     N
	     IN
	     NL
	     DO
	     (REPLACE (ATOMTYPE (MARKERS (FINDCTE N STRUC))) (CAR PAIR)))
	(RETURN STRUC)))
EXPR)

(DEFPROP DELETE
 (LAMBDA (I L) (COND ((NULL L) NIL) ((EQUAL (CAR L) I) (CDR L)) (T (CONS (CAR L) (DELETE I (CDR L))))))
EXPR)