perm filename CYCOMG.PRT[4,LMM] blob
sn#037537 filedate 1973-04-23 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.0 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)
STOP