perm filename CYCDRJ.LSP[3,LMM] blob
sn#038916 filedate 1973-05-01 generic text, type T, neo UTF8
(DEFPROP CYCDRJFNS
(CYCDRJFNS ISOMERS RING DRAW LABELLER DRAWS)
VALUE)
(DEFPROP ISOMERS
(LAMBDA NIL
(PROG (CL U)
CLLP (PRINT (QUOTE CL?))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((FOR NEW
PR
IN
CL
OR
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (MOLECULES CL U))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)
(DEFPROP RING
(LAMBDA NIL
(PROG (CL U)
CLLP (PRINT (QUOTE CL?))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((FOR NEW
PR
IN
CL
OR
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (RINGS U CL))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)
(DEFPROP DRAW
(LAMBDA(N)
(PROG (S)
(COND ((GREATERP N (LENGTH RESULTS)) (PRINT (QUOTE (NOT THAT MANY STRUCTURES -- TRY AGAIN!!!))))
((STRUCTURE? (SETQ S (CAR (NTH RESULTS N)))) (DRAWS S NIL))
(T (SETQ TITLE (LIST (QUOTE STRUCTURE#) N)) (PRINRAD S)))))
EXPR)
(DEFPROP LABELLER
(LAMBDA NIL
(PROG (CL U)
CLLP (TERPRI)
(PRINC (QUOTE "ATOMS TO BE LABELLED?"))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((FOR NEW
PR
IN
CL
OR
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (MOLECULES CL U))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)
(DEFPROP DRAWS
(LAMBDA(STRUC ID)
(LAYOUT
(CONS (OR# ID (UGRAPH STRUC))
(FOR NEW
X
IN
(CTABLE STRUC)
XLIST
(CONS (NODENUM X)
(CONS (ATOMTYPE (MARKERS X)) (FOR NEW Y IN (NBRS X) WHEN (NUMBERP Y) XLIST Y)))))))
EXPR)