perm filename NEWEXP.LSP[NIH,LMM] blob
sn#040791 filedate 1973-05-19 generic text, type T, neo UTF8
(DEFPROP NEWEXPFNS
(NEWEXPFNS EXPLAINGENMOL
PRINCL
EXPLAINMOLECULES
EXPLAINRINGS
EXPLAINNOFV-RINGS
EXPLAINVL
VALENTNODE
EXPLAINCATALOG
EXPLAINNOLOOPEDRINGS
EXPLAINSTRUCTURESWITHATOMS
EXPLAINRINGSKELETONS
EXPLAINATTACHFVS
EXPLAINATTACHBIVALENTS
EXPLAINATTACHBIVS&LOOPS
EXPLAINPERMRADS)
VALUE)
(DEFPROP EXPLAINGENMOL
(LAMBDA (CL) (BOX (PRINCL CL)))
EXPR)
(DEFPROP PRINCL
(LAMBDA(CL)
(PROG (BIGLIST RSLT)
(NILL COLLECT A LINE OF TEXT (WITH POSSIBLE DOWN ARROWS))
(SETQ RSLT
(FOR NEW
X
IN
CL
AS
NEW
NUMITEMS
IS
(CDR X)
AS
NEW
ITEM
IS
(COND ((ATOM (CAR X)) (CAR X))
((AND (ATOM (CAAR X)) (NOT (CDAR X))) (CAAR X))
((EQ (CAAR X) (QUOTE VALENTNODE)) (CAR X))
((AND (ATOM (CAAR X)) (GET (CAAR X) (QUOTE VALENCE)))
(HELP HERE)
(CONCAT (CAAR X) (PRINCL2 (CDAR X))))
(T (SETQ BIGLIST (CONS X BIGLIST)) NIL))
WHEN
ITEM
NCONC
(CONS ITEM (COND ((LESSP NUMITEMS 2.) NIL) (T (LIST DOWNVEC NUMITEMS UPVEC))))))
(RETURN
(COND ((NULL BIGLIST) (OUTTEXT RSLT))
(T (EXPLAINLIST (COND (RSLT (CONS RSLT (CLEXPAND BIGLIST))) (T (CLEXPAND BIGLIST)))))))))
EXPR)
(DEFPROP EXPLAINMOLECULES
(LAMBDA (CL U) (BOX (PRINCL (CONS (CONS (QUOTE U) U) CL))))
EXPR)
(DEFPROP EXPLAINRINGS
(LAMBDA(U CL)
(COND ((EQUAL (CLCOUNT CL) 2.) (SETQ CL (CLEXPAND CL)) (EXPLAINMULTBOND (CAR CL) (ADD1 U) (CADR CL)))
(T (CURLYCIRCLE (PRINCL (CONS (CONS (QUOTE U) U) CL))))))
EXPR)
(DEFPROP EXPLAINNOFV-RINGS
(LAMBDA (VL) (CURLYCIRCLE (EXPLAINVL VL 2.)))
EXPR)
(DEFPROP EXPLAINVL
(LAMBDA(VL START)
(PRINCL (FOR NEW X IN VL AS NEW I := (START INFINITY) WHEN (NOT (ZEROP X)) XLIST (CONS (VALENTNODE I) X))))
EXPR)
(DEFPROP VALENTNODE
(LAMBDA (N) (CONS (QUOTE VALENTNODE) N))
EXPR)
(DEFPROP EXPLAINCATALOG
(LAMBDA (TVL) (EXPLAINNOLOOPEDRINGS (CONS 0. TVL)))
EXPR)
(DEFPROP EXPLAINNOLOOPEDRINGS
(LAMBDA (VL) (CIRCLE (EXPLAINVL VL)))
EXPR)
(DEFPROP EXPLAINSTRUCTURESWITHATOMS
(LAMBDA (CLL STRUC) (ABOVE (PRINCL (FOR NEW X IN CLL APPEND X)) (EXPLAIN STRUC)))
EXPR)
(DEFPROP EXPLAINRINGSKELETONS
(LAMBDA(FV VL)
(CURLYCIRCLE
(PRINCL
(FOR NEW
X
IN
VL
AS
NEW
I
:=
(2. INFINITY)
WHEN
(NOT (ZEROP X))
LIST
FIRST
(COND (FV (LIST (CONS FREEVALENCE FV))) (T NIL))
(CONS (VALENTNODE I) X)))))
EXPR)
(DEFPROP EXPLAINATTACHFVS
(LAMBDA(FVL STRUC)
(ABOVE (PRINCL
(FOR NEW
FVR
IN
FVL
AS
NEW
VALNODE
:=
(2. INFINITY)
FOR
NEW
FVI
IN
FVR
AS
NEW
NUMFV
:=
(1. INFINITY)
WHEN
(NOT (ZEROP FVI))
LIST
(CONS (FVVALENTNODE VALNODE NUMFV) FVI)))
(EXPLAIN STRUC)))
EXPR)
(DEFPROP EXPLAINATTACHBIVALENTS
(LAMBDA(BVP STRUC)
(ABOVE (PRINCL (FOR NEW PR IN BVP WHEN (NOT (ZEROP (CAR PR))) LIST (CONS (BIVLIST (CAR PR)) (CDR PR))))
(EXPLAIN STRUC)))
EXPR)
(DEFPROP EXPLAINATTACHBIVS&LOOPS
(LAMBDA(BVP STRUC)
(ABOVE (PRINCL (FOR NEW PR IN BVP WHEN (NOT (ZEROP (CAR PR))) LIST (CONS (BIVLIST (CAR PR)) (CDR PR))))
(EXPLAIN STRUC)))
EXPR)