perm filename CYCCAT.PRT[4,LMM] blob sn#037518 filedate 1973-04-23 generic text, type T, neo UTF8
  (DEFPROP CYCCATFNS (CYCCATFNS MAKECAT TRIVGRAPH CHORDLENGTH 
                                TRIVALENTCODES (SETQ LASTNODE 0.0)
                                (AND LOADING (SETQ CATALOG-LIST
                                                   (MAKECAT 
                                                     TRIVALENTCODES))))
           VALUE)
  (DEFPROP MAKECAT (LAMBDA (TVC)
                           (FOR NEW X IN TVC AS NEW J IS (CAR X)
                                LIST
                                (FOR NEW Y IN (CDR X)
                                     LIST
                                     (TRIVGRAPH J Y))))
           EXPR)
  (DEFPROP TRIVGRAPH (LAMBDA
             (J L)
             (PROG (S X Y LL N)
                   (SETQ LL L)
                   (SETQ S (SINGLERING J))
                   (SETQ X (PROG (FOR-VALUE I)
                                 (SETQ I J)
                                 LOOP*1
                                 (COND ((LESSP I 1.0)
                                        (GO RETURN)))
                                 (SETQ FOR-VALUE (CONS I FOR-VALUE))
                                 NEXT*1 NEXT*I (SETQ I (PLUS I -1.0))
                                 (GO LOOP*1)
                                 RETURN
                                 (RETURN FOR-VALUE)))
                   (PROG (FOR-VALUE)
                         NIL NIL LOOP*1 (COND ((NOT X)
                                               (GO RETURN)))
                         (COND ((NOT L)
                                (GO RETURN)))
                         (SETQ N (PLUS (CHORDLENGTH (CAR L))
                                       (CAR X)))
                         (CONNECT (FINDCTE (CAR X)
                                           S)
                                  (FINDCTE N S))
                         (SETQ X (DELETE N X))
                         NEXT*1 NEXT*L (SETQ L (CDR L))
                         NEXT*X
                         (SETQ X (CDR X))
                         (GO LOOP*1)
                         RETURN
                         (RETURN FOR-VALUE))
                   (RETURN (STRUCTURE FROM S UGRAPH = (CONS J LL)))))
           EXPR)
  (DEFPROP CHORDLENGTH (LAMBDA (X)
                               (CDR (SASSOC X (QUOTE ((A . 1.0)
                                                      (B . 2.0)
                                                      (C . 3.0)
                                                      (D . 4.0)
                                                      (E . 5.0)
                                                      (F . 6.0)
                                                      (G . 7.0)
                                                      (H . 8.0)
                                                      (I . 9.0)))
                                            NIL)))
           EXPR)
  (DEFPROP TRIVALENTCODES (TRIVALENTCODES (2.0 (A))
                                          (4.0 (B B)
                                               (A A))
                                          (6.0 (B C B)
                                               (A A A)
                                               (A B B)
                                               (A C A)
                                               (C C C))
                                          (8.0 (B C C B)
                                               (B D D B)
                                               (C E C C)
                                               (A A A A)
                                               (A A B B)
                                               (A A C A)
                                               (A B C B)
                                               (A B D A)
                                               (A C D B)
                                               (A D D A)
                                               (A E B B)
                                               (A E C A)
                                               (B B B B)))
           VALUE)
  (SETQ LASTNODE 0.0)
  (AND LOADING (SETQ CATALOG-LIST (MAKECAT TRIVALENTCODES)))
STOP