perm filename CYCCAT.LSP[4,LMM] blob
sn#037485 filedate 1973-05-06 generic text, type T, neo UTF8
(DEFPROP CYCCATFNS
(CYCCATFNS MAKECAT
TRIVGRAPH
CHORDLENGTH
TRIVALENTCODES
(SETQ LASTNODE 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.) (GO RETURN)))
(SETQ FOR-VALUE (CONS I FOR-VALUE))
NEXT*1
NEXT*I
(SETQ I (PLUS I -1.))
(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.) (B . 2.) (C . 3.) (D . 4.) (E . 5.) (F . 6.) (G . 7.) (H . 8.) (I . 9.))) NIL)))
EXPR)
(DEFPROP TRIVALENTCODES
(TRIVALENTCODES
(2. (A))
(4. (B B) (A A))
(6. (B C B) (A A A) (A B B) (A C A) (C C C))
(8. (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.)
(AND LOADING (SETQ CATALOG-LIST (MAKECAT TRIVALENTCODES)))