(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "14-APR-73 03:35:27")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE CATGENVARS)
              T)
  (RPAQQ CATGENVARS ((FNS MERGETRIVS NORMNUMBERING ELIMINATEISOMORPHS 
                          MERGEEDGELIST MAKEQUADS VALIDEDGELIST JLGEN)
          (VARS MATCHNUM STRUCTURE)))
(DEFINEQ

(MERGETRIVS
  [LAMBDA (N1 N2 STRUC)
    (PROG (X1 X2)
          (SETQ X2 (FINDCTE N2 STRUC))
          (SETQ X1 (FINDCTE N1 STRUC))
          (DISCONNECT X1 X2)
          (FOR NEW N IN (NBRS X2) DO (DISCONNECT (FINDCTE N STRUC)
                                                 X2)
                                     (CONNECT (FINDCTE N STRUC)
                                              X1))
          (RETURN (STRUCTURE
                     FROM STRUC CTABLE =(FOR NEW X
                                           IN (CTABLE STRUC)
                                           WHEN (NOT
                                                  (EQP (NODENUM X)
                                                       N2))
                                                XLIST X])

(NORMNUMBERING
  [LAMBDA (STRUC)
    (STRUCTURE CTABLE =(SUBLIS (FOR NEW N IN (NODES STRUC)
                                             AS NEW I :=(1 99)
                                             XLIST
                                             (CONS N I))
                               (CTABLE STRUC))
               LASTNODE# =(LENGTH (CTABLE STRUC))
               UGRAPH =(UGRAPH STRUC])

(ELIMINATEISOMORPHS
  [LAMBDA (LL UNIQUE)

          (* A list of already UNIQUE graphs may be supplied 
          -- as the second argument; if not supplied NIL is 
          assumed)


    (PROG (COUNT COUNT1)
          [PRINT (LIST (QUOTE (ELIMINATEISOMORPHS HAS RECEIVED))
                       (LENGTH LL)
                       (QUOTE (ITEMS AND))
                       (LENGTH UNIQUE)
                       (QUOTE (UNIQUE ITEMS]
          [FOR NEW S IN LL
             DO (COND
                  ((FOR NEW U IN UNIQUE AS NEW JJ :=(1 9000)
                      WHEN (ISIT U S) DO (SETQ COUNT1 JJ)
                                         (RETURN U)))
                  (T (SETQ COUNT (PLUS COUNT COUNT1))
                     (SETQ UNIQUE (CONS S UNIQUE]
          (PRINT (LIST (QUOTE RETURNING)
                       (LENGTH UNIQUE)
                       (QUOTE ENTRIES)))
          (PRINT COUNT)
          (PRINT (QUOTE (MATCHES TRIED)))
          (RETURN UNIQUE])

(MERGEEDGELIST
  [LAMBDA (EL STRUC)
    (PROGN (FOR NEW EDGE IN EL PROG2 (MAPRINT (LIST (QUOTE EL)
                                                    (QUOTE =)
                                                    EL))
                            (TERPRI)
                            (SETQ STRUC (MERGETRIVS (CAR EDGE)
                                                    (CDR EDGE)
                                                    STRUC])

(MAKEQUADS
  [LAMBDA (N STRUC)
    (FOR NEW LAB
       IN [[LAMBDA (X)
              (PRINT (QUOTE (# OF LABELLINGS)))
              (PRINT (LENGTH X))
              X]
            (LABELEDGES STRUC (LIST N (DIFFERENCE (LENGTH (EDGES STRUC))
                                                  N]
       WHEN (VALIDEDGELIST (CAAR LAB)
                           STRUC)
            LIST
            (NORMNUMBERING (MERGEEDGELIST (CAAR LAB)
                                          (COPYSTRUC STRUC])

(VALIDEDGELIST
  [LAMBDA (EL STRUC)
    (AND (FOR NEW E IN EL AND (EQP (CONNECTIVITY (CAR E)
                                                 (CDR E)
                                                 STRUC)
                                   1))
         (EQUAL (TWICE (LENGTH EL))
                (LENGTH ([LAMBDA (X)
                            (INTERSECTION X X]
                          (FOR NEW E IN EL APPEND (LIST (CAR E)
                                                        (CDR E])

(JLGEN
  [LAMBDA (N STRUC UNIQUE)
    (BREAK1 [PROGN (COND
                     ((STRUCTURE? STRUC)
                       (MAKEQUADS N STRUC))
                     (T (FOR NEW S IN STRUC APPEND (PRINT (UGRAPH
                                                            S))
                                      (TERPRI)
                                      (JLGEN N S]
            T JLGEN (GO])
)
  (RPAQQ MATCHNUM 0)
  (RPAQQ STRUCTURE ((CTENTRY 1 (NIL)
                             2 4 2 9)
          (CTENTRY 2 (NIL)
                   1 1 3)
          (CTENTRY 3 (NIL)
                   7 4 2)
          (CTENTRY 4 (NIL)
                   1 5 3)
          (CTENTRY 5 (NIL)
                   9 6 4)
          (CTENTRY 6 (NIL)
                   8 7 5)
          (CTENTRY 7 (NIL)
                   3 8 6)
          (CTENTRY 8 (NIL)
                   6 9 7)
          (CTENTRY 9 (NIL)
                   5 1 8)))
STOP