(DEFPROP CYCOMEFNS
           (CYCOMEFNS CLPARTITIONSL CLPARTLP1 KLOOPEDRINGS 
                      ATTACHBIVS&LOOPS PUTLOOPS PUTBIVN PUTBIVS PUTBIVE 
                      COMBINE CLASSES CLASSES2 CLASSIFY3 CLASSIFYNODES 
                      CLASSIFYEDGES NODEMARK)
           VALUE)
  (DEFPROP CLPARTITIONSL
           (LAMBDA
             (CL LL)
             (IF (NOT LL)
                 THEN
                 (LIST NIL)
                 ELSE
                 (FOR NEW FP IN (CLPARTS CL (PLUSLIST (CAR LL)))
                      AS NEW RPL IS (CLPARTITIONSL (CLDIFF CL FP)
                                                   (CDR LL))
                      FOR NEW TP IN (CLPARTLP1 FP (CAR LL)
                                               1.0)
                      FOR NEW RP IN RPL XLIST (CONS TP RP))))
           EXPR)
  (DEFPROP CLPARTLP1
           (LAMBDA
             (CL ROW N)
             (IF (NOT ROW)
                 THEN
                 (LIST NIL)
                 ELSEIF
                 (ZEROP (CAR ROW))
                 THEN
                 (CLPARTLP1 CL (CDR ROW)
                            (ADD1 N))
                 ELSE
                 (FOR NEW EP IN (CLPARTS CL (TIMES N (CAR ROW)))
                      AS NEW RPL IS (CLPARTLP1 (CLDIFF CL EP)
                                               (CDR ROW)
                                               (ADD1 N))
                      FOR NEW EEP IN (CL=PARTS EP (CAR ROW)
                                               N)
                      FOR NEW RP IN RPL XLIST (APPEND (CLCREATE EEP)
                                                      RP))))
           EXPR)
  (DEFPROP KLOOPEDRINGS
           (LAMBDA (P VL)
                   (IF (ZEROP P)
                       THEN
                       (NOLOOPEDRINGS VL)
                       ELSE
                       (FOR NEW LOOPPART IN (LOOPPARTITIONS P VL)
                            FOR NEW STRUC IN (NOFV-RINGS (LOOPVL 
                                                           LOOPPART))
                            NCONC FIRST NIL (ATTACHBIVS&LOOPS
                              (EDGELABELS LOOPPART)
                              (LOOPLABELS LOOPPART)
                              STRUC))))
           EXPR)
  (DEFPROP
    ATTACHBIVS&LOOPS
    (LAMBDA
      (EL LL STRUC)
      (IF (NOT EL)
          THEN
          (FOR NEW L2 IN (LLABELNODES STRUC (LCDRLIST LL))
               XLIST
               (PUTLOOPS (COPYSTRUC (LSTRUC L2))
                         (LCARLIST LL)
                         (LABELED L2)))
          ELSE
          (FOR NEW L1 IN (LABELEDGES STRUC (CDRLIST EL))
               FOR NEW L2 IN (LLABELNODES (LSTRUC L1)
                                          (LCDRLIST LL))
               XLIST
               (PUTLOOPS (PUTBIVS (COPYSTRUC (LSTRUC L2))
                                  (CARLIST EL)
                                  (LABELED L1))
                         (LCARLIST LL)
                         (LABELED L2)))))
    EXPR)
  (DEFPROP PUTLOOPS
           (LAMBDA (STRUC LPS LNODES)
                   (PROG2 (FOR NEW LOBJ IN LNODES AS NEW LLABS IN LPS 
                               FOR NEW OBJ IN LOBJ AS NEW LAB IN LLABS 
                               FOR NEW LPPR IN LAB FOR NEW I :=
                               (1.0 (CDR LPPR))
                               FOR NEW NODE IN OBJ DO
                               (SETQ STRUC (PUTBIVN STRUC NODE
                                                    (CAR LPPR))))
                          STRUC))
           EXPR)
  (DEFPROP PUTBIVN
           (LAMBDA
             (STRUC NODE NBIVS)
             (IF (ZEROP NBIVS)
                 THEN STRUC ELSE
                 (PROG (B)
                       (SETQ B (BIVCHAIN NBIVS))
                       (CONNECT (CAR (CTABLE B))
                                (SETQ NODE (FINDCTE NODE (CTABLE STRUC))
                                      ))
                       (CONNECT (CAR (LAST (CTABLE B)))
                                NODE)
                       (NCONC (CTABLE STRUC)
                              (CTABLE B))
                       (REPLACE (LASTNODE# STRUC)
                                (LASTNODE# B))
                       (RETURN STRUC))))
           EXPR)
  (DEFPROP PUTBIVS
           (LAMBDA (S L LST)
                   (PROG2 (FOR NEW X IN LST AS NEW N IN L FOR NEW E IN 
                               X DO (PUTBIVE S E N))
                          S))
           EXPR)
  (DEFPROP PUTBIVE
           (LAMBDA
             (S E N)
             (IF (ZEROP N)
                 THEN S ELSE (PROG (B N1 N2)
                                   (SETQ B (BIVCHAIN N))
                                   (CONNECT (CAR (CTABLE B))
                                            (SETQ N1
                                                  (FINDCTE
                                                    (CAR E)
                                                    (CTABLE S))))
                                   (CONNECT (CAR (LAST (CTABLE B)))
                                            (SETQ N2
                                                  (FINDCTE
                                                    (CDR E)
                                                    (CTABLE S))))
                                   (DISCONNECT N1 N2)
                                   (NCONC (CTABLE S)
                                          (CTABLE B))
                                   (REPLACE (LASTNODE# S)
                                            (LASTNODE# B))
                                   (RETURN S))))
           EXPR)
  (DEFPROP COMBINE (LAMBDA (O1 O2)
                           (IF (NOT O1)
                               THEN O2 ELSEIF (NOT O2)
                               THEN O1 ELSE
                               (COMBINATION OBJ1 = O1 OBJ2 = O2)))
           EXPR)
  (DEFPROP CLASSES (LAMBDA (OBJECTS STRUC)
                           (IF (COMBINATION? OBJECTS)
                               THEN
                               (NCONC (CLASSES (OBJ1 OBJECTS))
                                      (CLASSES (OBJ2 OBJECTS)))
                               ELSEIF
                               (NOT (UNCLASSED? OBJECTS))
                               THEN
                               (LIST OBJECTS)
                               ELSE
                               (CLASSES2 (OBJECTS OBJECTS)
                                         STRUC)))
           EXPR)
  (DEFPROP CLASSES2 (LAMBDA
             (OBJECTS STRUC)
             (PROG NIL (SETQ OBJECTS (GROUPCOUNT OBJECTS))
                   (RETURN (FOR NEW O IN (CDR OBJECTS)
                                AS NEW M := (2.0 999999.0)
                                FOR NEW O2 IN (CLASSIFY3 O STRUC)
                                XLIST FIRST (CLASSIFY3 (CAR OBJECTS)
                                                       STRUC)
                                (MAKEMULT M O2)))))
           EXPR)
  (DEFPROP
    CLASSIFY3
    (LAMBDA
      (OBJECTS STRUC)
      (PROG (N E OTH)
            (FOR NEW X IN OBJECTS DO
                 (IF (NUMBERP X)
                     THEN
                     (CONSTO N X)
                     ELSEIF
                     (AND (NUMBERP (CAR X))
                          (NUMBERP (CDR X)))
                     THEN
                     (CONSTO E X)
                     ELSE
                     (CONSTO OTH X)))
            (RETURN (NCONC (MAPCAR (QUOTE MAKENODES)
                                   (CLASSIFYNODES N STRUC))
                           (NCONC (MAPCAR (QUOTE MAKEEDGES)
                                          (CLASSIFYEDGES E STRUC))
                                  (IF OTH THEN
                                      (LIST (OTHERTYPE OTHOBJECTS = OTH)
                                            )
                                      ELSE NIL))))))
    EXPR)
  (DEFPROP CLASSIFYNODES (LAMBDA (NODES SSTRUC)
                                 (CDRLIST
                                   (GROUPBY (FUNCTION NODEMARK)
                                            NODES)))
           EXPR)
  (DEFPROP CLASSIFYEDGES (LAMBDA (EDGES SSTRUC)
                                 (CDRLIST
                                   (GROUPBY (FUNCTION EDGEMARK)
                                            EDGES)))
           EXPR)
  (DEFPROP NODEMARK (LAMBDA (NODE)
                            (PROG2 (SETQ NODE (FINDCTE NODE SSTRUC))
                                   (CONS (NODEVALENCE NODE)
                                         (MARKERS NODE))))
           EXPR)
STOP