(DEFPROP CYCOMDFNS
 (CYCOMDFNS CHECKL
	    COMB
	    COMBCHECK
	    CHECK
	    LLABEL
	    LABELM
	    LABEL1
	    LABEL1L
	    COMB1
	    FIXUPGROUP
	    FINDNEWGROUP
	    FINDNEWGROUP1
	    FINDPERMS
	    POSSIMS
	    CONNECTIVITY
	    GROUPCOUNT
	    FOUND?
	    FINDGROUPEDGES
	    IMAGE
	    FINDGROUPNODES
	    SIZE
	    TD
	    M22
	    MAXREST
	    LOOPPARTITIONS1
	    JLIST
	    LPROWS
	    LOOPPARTITIONS)
VALUE)

(DEFPROP CHECKL
 (LAMBDA(S SB NPL)
  (IF (SETQ NPL (CHECK S SB NPL 0.))
      THEN
      (IF (REMPERMS (NPLLEFT NPL))
	  THEN
	  (PRINT (LIST (QUOTE CHECKL) (QUOTE ERROR:) S SB NPL))
	  NIL
	  ELSE
	  (LIST (LABELING LABELED = S UNLABELED = SB LSTRUC = (REVERSE (OKPERMS (NPLLEFT NPL))))))
      ELSE
      NIL))
EXPR)

(DEFPROP COMB
 (LAMBDA(OBJ S SB NPL LABELS)
  (IF (ZEROP LABELS)
      THEN
      (CHECKL S (APPEND SB OBJ) NPL)
      ELSEIF
      (EQUAL LABELS (LENGTH OBJ))
      THEN
      (CHECKL (APPEND OBJ S) SB NPL)
      ELSEIF
      (GREATERP LABELS (LENGTH OBJ))
      THEN
      NIL
      ELSE
      (APPEND (COMBCHECK (CDR OBJ) (CONS (CAR OBJ) S) SB NPL (SUB1 LABELS))
	      (COMBCHECK (CDR OBJ) S (CONS (CAR OBJ) SB) NPL LABELS))))
EXPR)

(DEFPROP COMBCHECK
 (LAMBDA(OBJ S SB NPL LABELS)
  (IF (SETQ NPL (CHECK S SB NPL LABELS))
      THEN
      (COMB (DIFF OBJ (LABELEDSOFAR NPL)) (LABELEDSOFAR NPL) SB (NPLLEFT NPL) (LABELSLEFT NPL))
      ELSE
      NIL))
EXPR)

(DEFPROP CHECK
 (LAMBDA(S SB NPL LABELS)
  (PROG	(NEWNPL OBJ POBJ OK)
	(SETQ OK (OKPERMS NPL))
	(SETQ NPL (REMPERMS NPL))
   L1	(IF (NULL NPL)
	    THEN
	    (RETURN
	     (CHECKVAL LABELEDSOFAR = S NPLLEFT = (NPL OKPERMS = OK REMPERMS = NEWNPL) LABELSLEFT = LABELS)))
	(SETQ OBJ (OBJ (CAR NPL)))
	(SETQ POBJ (POBJ (CAR NPL)))
   L3	(IF (NULL OBJ)
	    THEN
	    (GO L8)
	    ELSEIF
	    (MEMBER (CAR OBJ) S)
	    THEN
	    (GO L4)
	    ELSEIF
	    (MEMBER (CAR OBJ) SB)
	    THEN
	    (GO L5))
   L6	(SETQ NEWNPL (CONS (CHECKPERM FROM (CAR NPL) OBJ = OBJ POBJ = POBJ) NEWNPL))
   L2	(SETQ NPL (CDR NPL))
	(GO L1)
   L9	(SETQ NEWNPL NIL)
   L8	(SETQ OK (CONS (ORIGPERM (CAR NPL)) OK))
	(GO L2)
   L4	(IF (MEMBER (CAR POBJ) S)
	    THEN
	    (GO L7)
	    ELSEIF
	    (MEMBER (CAR POBJ) SB)
	    THEN
	    (RETURN NIL)
	    ELSEIF
	    (MINUSP (SETQ LABELS (SUB1 LABELS)))
	    THEN
	    (RETURN NIL))
	(SETQ S (CONS (CAR POBJ) S))
	(SETQ NPL (APPEND NEWNPL NPL))
	(IF (NULL (CDR OBJ)) THEN (GO L9))
	(SETQ NEWNPL (LIST (CHECKPERM FROM (CAR NPL) OBJ = (CDR OBJ) POBJ = (CDR POBJ))))
	(GO L2)
   L7	(SETQ OBJ (CDR OBJ))
	(SETQ POBJ (CDR POBJ))
	(GO L3)
   L5	(IF (MEMBER (CAR POBJ) S) THEN (GO L2) ELSEIF (MEMBER (CAR POBJ) SB) THEN (GO L7))
	(GO L6)))
EXPR)

(DEFPROP LLABEL
 (LAMBDA(OBJECTS LABELS STRUC)
  (IF (NULL LABELS)
      THEN
      (LIST (LABELING LSTRUC = STRUC))
      ELSE
      (FOR NEW
	   L1
	   IN
	   (LABELM (CAR OBJECTS) (CAR LABELS) STRUC)
	   FOR
	   NEW
	   L2
	   IN
	   (LLABEL (CDR OBJECTS) (CDR LABELS) (LSTRUC L1))
	   XLIST
	   (LABELING FROM L2 LABELED = (CONS (LABELED L1) **)))))
EXPR)

(DEFPROP LABELM
 (LAMBDA(OBJECTS LABELS STRUC)
  (IF (NULL LABELS)
      THEN
      (LIST (LABELING UNLABELED = OBJECTS LSTRUC = STRUC))
      ELSE
      (FOR NEW
	   L1
	   IN
	   (LABEL1 OBJECTS (CAR LABELS) STRUC)
	   FOR
	   NEW
	   L2
	   IN
	   (LABELM (UNLABELED L1) (CDR LABELS) (LSTRUC L1))
	   XLIST
	   (LABELING FROM L2 LABELED = (CONS (LABELED L1) **)))))
EXPR)

(DEFPROP LABEL1
 (LAMBDA(OBJECTS LABELS STRUC)
  (PROG	(SZ)
	(RETURN
	 (IF (ZEROP LABELS)
	     THEN
	     (LIST (LABELING UNLABELED = OBJECTS LSTRUC = STRUC))
	     ELSEIF
	     (EQUAL LABELS (SETQ SZ (SIZE OBJECTS)))
	     THEN
	     (LIST (LABELING LABELED = OBJECTS LSTRUC = STRUC))
	     ELSEIF
	     (GREATERP LABELS SZ)
	     THEN
	     NIL
	     ELSEIF
	     (NULL (CDR (SETQ OBJECTS (CLASSES OBJECTS STRUC))))
	     THEN
	     (LABEL1C (CAR OBJECTS) LABELS STRUC)
	     ELSE
	     (LABEL1L OBJECTS LABELS STRUC)))))
EXPR)

(DEFPROP LABEL1L
 (LAMBDA(OBJL LABELS STRUC)
  (IF (NULL OBJL)
      THEN
      (IF (ZEROP LABELS) THEN (LIST (LABELING LSTRUC = STRUC)) ELSE NIL)
      ELSEIF
      (ZEROP LABELS)
      THEN
      (LIST
       (LABELING LSTRUC
		 =
		 STRUC
		 UNLABELED
		 =
		 (PROG (R) (FOR NEW O IN OBJL DO (SETQ R (COMBINE O R))) (RETURN R))))
      ELSE
      (PROG (SZ SZC)
	    (SETQ SZ (PLUS (SETQ SZC (SIZE (CAR OBJL))) (FOR NEW O IN (CDR OBJL) PLUS (SIZE O))))
	    (RETURN
	     (FOR NEW
		  I
		  :=
		  ((MAX 0. (DIFFERENCE LABELS (DIFFERENCE SZ SZC))) (MIN LABELS SZC))
		  FOR
		  NEW
		  L1
		  IN
		  (LABEL1C (CAR OBJL) I STRUC)
		  FOR
		  NEW
		  L2
		  IN
		  (LABEL1L (CDR OBJL) (DIFFERENCE LABELS I) (LSTRUC L1))
		  XLIST
		  (LABELING FROM
			    L2
			    LABELED
			    =
			    (COMBINE (LABELED L1) **)
			    UNLABELED
			    =
			    (COMBINE (UNLABELED L1) **)))))))
EXPR)

(DEFPROP COMB1
 (LAMBDA(OBJ LAB UNL PERMS LABELS)
  (IF (ZEROP LABELS)
      THEN
      (LIST (LABELING LABELED = LAB UNLABELED = UNL LSTRUC = PERMS))
      ELSEIF
      (EQUAL LABELS (LENGTH OBJ))
      THEN
      (LIST (LABELING LABELED = (APPEND OBJ LAB) UNLABELED = UNL LSTRUC = PERMS))
      ELSE
      (NCONC (COMB1 (CDR OBJ) (CONS (CAR OBJ) LAB) UNL PERMS (SUB1 LABELS))
	     (COMB1 (CDR OBJ) LAB (CONS (CAR OBJ) UNL) PERMS LABELS))))
EXPR)

(DEFPROP FIXUPGROUP
 (LAMBDA(STRUC)
  (REPLACE (GROUP STRUC)
	   (FINDNEWGROUP STRUC
			 (CLASSIFYNODES
			  (PROG	(X)
				(SETQ X (NODES STRUC))
				(FOR NEW NL IN (CAR (GROUP STRUC)) DO (SETQ X (DIFF X NL)))
				(RETURN X))
			  STRUC))))
EXPR)

(DEFPROP FINDNEWGROUP
 (LAMBDA(STRUC NEWORBITS)
  (PROG	(NEWOBJ)
	(SETQ NEWOBJ (FOR NEW ORB IN NEWORBITS XLIST FIRST (CAR (GROUP STRUC)) (REVERSE ORB)))
	(RETURN
	 (CONS NEWOBJ
	       (FOR NEW
		    P
		    IN
		    (FINDNEWGROUP1 STRUC NEWORBITS)
		    WHEN
		    (NOT (EQUAL NEWOBJ (CDR P)))
		    XLIST
		    (CDR P))))))
EXPR)

(DEFPROP FINDNEWGROUP1
 (LAMBDA(STRUC NEWORBITS)
  (FOR NEW
       P
       IN
       (GROUP STRUC)
       NCONC
       FIRST
       NIL
       (FINDPERMS (CAR NEWORBITS) NEWORBITS (CONS NIL P) (CONS NIL (CAR (GROUP STRUC))) STRUC)))
EXPR)

(DEFPROP FINDPERMS
 (LAMBDA(NODES CLASSES IMS MAPPED STRUC)
  (IF (NULL CLASSES)
      THEN
      (LIST IMS)
      ELSEIF
      (NULL NODES)
      THEN
      (FINDPERMS (CADR CLASSES) (CDR CLASSES) (CONS NIL IMS) (CONS NIL MAPPED) STRUC)
      ELSE
      (FOR NEW
	   Y
	   IN
	   (POSSIMS (CAR NODES) (CAR CLASSES) IMS MAPPED STRUC)
	   NCONC
	   FIRST
	   NIL
	   (FINDPERMS (CDR NODES)
		      CLASSES
		      (CONS (CONS Y (CAR IMS)) (CDR IMS))
		      (CONS (CONS (CAR NODES) (CAR MAPPED)) (CDR MAPPED))
		      STRUC))))
EXPR)

(DEFPROP POSSIMS
 (LAMBDA(X CLASS IMS MAPPED STRUC)
  (FOR NEW
       Y
       IN
       CLASS
       WHEN
       (NOT (MEMBER Y (CAR IMS)))
       WHEN
       (FOR NEW
	    ML
	    IN
	    MAPPED
	    AS
	    NEW
	    IL
	    IN
	    IMS
	    FOR
	    NEW
	    M
	    IN
	    ML
	    AS
	    NEW
	    I
	    IN
	    IL
	    AND
	    (EQUAL (CONNECTIVITY Y I STRUC) (CONNECTIVITY X M STRUC)))
       XLIST
       Y))
EXPR)

(DEFPROP CONNECTIVITY
 (LAMBDA (X Y STRUC) (FOR NEW Z IN (NBRS (FINDCTE X STRUC)) WHEN (EQUAL Z Y) PLUS 1.))
EXPR)

(DEFPROP GROUPCOUNT
 (LAMBDA(L)
  (PROG	NIL
	(SETQ L (GROUPBY (QUOTE CDR) (CLCREATE L)))
	(RETURN (FOR NEW I := ((FOR NEW X IN L MAX (CAR X)) 1. -1.) XLIST (CARLIST (LMASSOC I L NIL))))))
EXPR)

(DEFPROP FOUND?
 (LAMBDA(NODE GROUP)
  (FOR NEW NL IN (CAR GROUP) AS NEW N := (1. INFINITY) DO (IF (MEMBER NODE NL) THEN (RETURN (CONS N NL)))))
EXPR)

(DEFPROP FINDGROUPEDGES
 (LAMBDA(EDGES STRUC)
  (PROG	(G)
	(IF (NOT
	     (FOR NEW
		  EDGE
		  IN
		  EDGES
		  AND
		  (AND (FOUND? (NODE1 EDGE) (GROUP STRUC)) (FOUND? (NODE2 EDGE) (GROUP STRUC)))))
	    THEN
	    (FIXUPGROUP STRUC)
	    ELSE
	    NIL)
	(SETQ G (GROUP STRUC))
	(RETURN
	 (NPL OKPERMS
	      =
	      (LIST (CAR G))
	      REMPERMS
	      =
	      (FOR NEW
		   P
		   IN
		   (CDR G)
		   XLIST
		   (CHECKPERM ORIGPERM
			      =
			      P
			      OBJ
			      =
			      EDGES
			      POBJ
			      =
			      (FOR NEW
				   EDGE
				   IN
				   EDGES
				   LIST
				   (ORDPAIR (IMAGE (NODE1 EDGE) (CAR G) P)
					    (IMAGE (NODE2 EDGE) (CAR G) P)))))))))
EXPR)

(DEFPROP IMAGE
 (LAMBDA(NODE MAPPED IMAGES)
  (FOR NEW ML IN MAPPED AS NEW IL IN IMAGES FOR NEW M IN ML AS NEW I IN IL WHEN (EQUAL NODE M) DO (RETURN I)))
EXPR)

(DEFPROP FINDGROUPNODES
 (LAMBDA(OBJECTS STRUC)
  (PROG	(FOUND)
   L1	(SETQ FOUND (FOUND? (CAR OBJECTS) (GROUP STRUC)))
	(IF (NOT FOUND)
	    THEN
	    (FIXUPGROUP STRUC)
	    ELSE
	    (RETURN
	     (NPL OKPERMS
		  =
		  (LIST (CAR (GROUP STRUC)))
		  REMPERMS
		  =
		  (FOR NEW
		       P
		       IN
		       (CDR (GROUP STRUC))
		       XLIST
		       (CHECKPERM ORIGPERM = P OBJ = (CDR FOUND) POBJ = (CAR (NTH P (CAR FOUND))))))))
	(GO L1)))
EXPR)

(DEFPROP SIZE
 (LAMBDA(OBJECTS)
  (IF (MULTTYPE? OBJECTS)
      THEN
      (TIMES (MULT OBJECTS) (SIZE (UNMULTED OBJECTS)))
      ELSEIF
      (COMBINATION? OBJECTS)
      THEN
      (PLUS (SIZE (OBJ1 OBJECTS)) (SIZE (OBJ2 OBJECTS)))
      ELSEIF
      (OR (NODES? OBJECTS) (EDGES? OBJECTS) (UNCLASSED? OBJECTS))
      THEN
      (LENGTH (CDR OBJECTS))
      ELSE
      (PRINT (CONS OBJECTS (QUOTE (BAD ARG TO SIZE))) 0.)))
EXPR)

(DEFPROP TD
 (LAMBDA (VL J) (IF (NOT VL) THEN 0. ELSE (PLUS (TIMES J (CAR VL)) (TD (CDR VL) (ADD1 J)))))
EXPR)

(DEFPROP M22
 (LAMBDA (N) (SUB1 (QUOTIENT N 2.)))
EXPR)

(DEFPROP MAXREST
 (LAMBDA (VL J) (FOR NEW X IN (CDR VL) AS NEW K := ((ADD1 J) INFINITY) PLUS (TIMES X (M22 K))))
EXPR)

(DEFPROP LOOPPARTITIONS1
 (LAMBDA(P VL J)
  (IF (NOT VL)
      THEN
      (LIST NIL)
      ELSE
      (FOR NEW
	   PJ
	   :=
	   ((MAX 0. (DIFFERENCE P (MAXREST VL J))) (MIN P (TIMES (M22 J) (CAR VL))))
	   AS
	   NEW
	   RESTL
	   IS
	   (LOOPPARTITIONS1 (DIFFERENCE P PJ) (CDR VL) (ADD1 J))
	   FOR
	   NEW
	   THISPART
	   IN
	   (FVPART1 PJ (CAR VL) (M22 J))
	   FOR
	   NEW
	   RESTPART
	   IN
	   RESTL
	   XLIST
	   (CONS THISPART RESTPART))))
EXPR)

(DEFPROP JLIST
 (LAMBDA(LL N)
  (IF (NOT LL)
      THEN
      NIL
      ELSEIF
      (NOT (CDR LL))
      THEN
      (LIST (CAR (NTH (CAR LL) N)))
      ELSE
      (CONS (CAR (NTH (CAR LL) N)) (JLIST (CDDR LL) (ADD1 N)))))
EXPR)

(DEFPROP LPROWS
 (LAMBDA(LPP VL)
  (PROG2 (SETQ LPP (CONS NIL LPP))
	 (FOR NEW
	      S
	      :=
	      (4. INFINITY)
	      AS
	      NEW
	      V
	      IN
	      (CONS (CAR VL) (FOR NEW V2 IN (CDR VL) AS NEW PL IN LPP LIST (DIFFERENCE V2 (PLUSLIST PL))))
	      AS
	      LPP
	      IS
	      (IF LPP THEN (CDR LPP) ELSE NIL)
	      LIST
	      (CONS V (JLIST LPP (M22 S))))))
EXPR)

(DEFPROP LOOPPARTITIONS
 (LAMBDA(P VL)
  (FOR NEW
       LPP
       IN
       (LOOPPARTITIONS1 P (CDDR VL) 4.)
       AS
       NEW
       ROWS
       IS
       (LPROWS LPP VL)
       FOR
       NEW
       K
       :=
       (0. (TD (CDR VL) 3.))
       FOR
       NEW
       BP
       IN
       (NUMPARTITIONS (CAR VL) (PLUS P K) 1. 999999.)
       AS
       NEW
       CLBP
       IS
       (CLCREATE BP)
       FOR
       NEW
       EL
       IN
       (CLPARTS CLBP K)
       FOR
       NEW
       LPL
       IN
       (CLPARTITIONSL (CLDIFF CLBP EL) (CDRLIST ROWS))
       XLIST
       (LOOPPARTITION LOOPVL
		      =
		      (CONS (PLUSLIST (CDAR ROWS)) (MAPCAR (QUOTE PLUSLIST) (CDR ROWS)))
		      EDGELABELS
		      =
		      EL
		      LOOPLABELS
		      =
		      LPL)))
EXPR)