perm filename CYCOMG.LSP[3,LMM] blob
sn#037469 filedate 1973-04-21 generic text, type T, neo UTF8
(DEFPROP CYCOMGFNS
(CYCOMGFNS LLUNCLASS
PERMRADS
LABEEDGES
LABELFV
STRUCTURESWITHATOMS
ATTACHFVS
ATTACHBIVALENTS
LLABELNODES
MAKEUNCLASSED)
VALUE)
(DEFPROP LLUNCLASS
(LAMBDA (LLOBJ) (MAPCAR (QUOTE LUNCLASS) LLOBJ))
EXPR)
(DEFPROP PERMRADS
(LAMBDA(CENT CLRADS FLAG)
(PROG2 (SETQ CLRADS (CLCREATE CLRADS))
(IF (ATOM CENT)
THEN
(LIST (RADICAL CENTER = CENT ATTACHEDRADS = CLRADS))
ELSEIF
(STRUCFORM? CENT)
THEN
(LIST (RADICAL CENTER = (MAKECENTER RADSTRUC = CENT) ATTACHEDRADS = CLRADS))
ELSE
(FOR NEW
L
IN
(LABELFV CENT ((LAMBDA (X) (IF FLAG THEN (CONS 1. X) ELSE X)) (CDRLIST CLRADS)))
XLIST
(RADICAL CENTER
=
(MAKECENTER AFFLINK
=
(IF FLAG THEN (CAAR (LABELED L)) ELSE NIL)
RADSTRUC
=
(LSTRUC L)
CUFFLINKS
=
(IF FLAG THEN (CDR (LABELED L)) ELSE (LABELED L)))
ATTACHEDRADS
=
CLRADS)))))
EXPR)
(DEFPROP LABEEDGES
(LAMBDA(STRUC LABELS)
(FOR NEW
L
IN
(LABELM (UNCLASSED OBJECTS
=
(FOR NEW
CT
IN
(CTABLE STRUC)
FOR
NEW
N
IN
(NBRS CT)
WHEN
(LEQ (NODENUM CT) N)
XLIST
(CONS (NODENUM CT) N)))
LABELS
STRUC)
XLIST
(LABELING FROM L LABELED = (LUNCLASS **))))
EXPR)
(DEFPROP LABELFV
(LAMBDA(STRUC LABELS)
(FOR NEW
L
IN
(LABELM (UNCLASSED OBJECTS = (COLLECTFV STRUC)) LABELS STRUC)
XLIST
(LABELING FROM L LABELED = (LUNCLASS **))))
EXPR)
(DEFPROP STRUCTURESWITHATOMS
(LAMBDA(CLL STRUC)
(FOR NEW
L
IN
(LLABELNODES STRUC (LCDRLIST CLL))
XLIST
(INSERTMARKERS (COPYSTRUC (LSTRUC L)) CLL (LABELED L))))
EXPR)
(DEFPROP ATTACHFVS
(LAMBDA (FVP STRUC) (FOR NEW L IN (LLABELNODES STRUC FVP) XLIST (PUTFVS (COPYSTRUC (LSTRUC L)) (LABELED L))))
EXPR)
(DEFPROP ATTACHBIVALENTS
(LAMBDA(PART STRUC)
(FOR NEW
L
IN
(LABELEDGES STRUC (CDRLIST PART))
XLIST
(PUTBIVS (COPYSTRUC (LSTRUC L)) (CARLIST PART) (LABELED L))))
EXPR)
(DEFPROP LLABELNODES
(LAMBDA(STRUC LLABELS)
(FOR NEW
L
IN
(LLABEL (MAPCAR (QUOTE MAKEUNCLASSED) (LISTBYVALENCE STRUC)) LLABELS STRUC)
XLIST
(LABELING FROM L LABELED = (LLUNCLASS **))))
EXPR)
(DEFPROP MAKEUNCLASSED
(LAMBDA (X) (IF (NOT X) THEN NIL ELSE (UNCLASSED OBJECTS = X)))
EXPR)