perm filename CYCOMG[1,LMM] blob
sn#031707 filedate 1973-03-27 generic text, type T, neo UTF8
(DE LLUNCLASS (LLOBJ)
(MAPCAR @LUNCLASS LLOBJ))))
)))))))
(DE PERMRADS (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))))))
))
(DE LABEEDGES (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 **)))))
))
(DE LABELFV (STRUC LABELS)
(FOR NEW L
IN (LABELM
(UNCLASSED OBJECTS = (COLLECTFV STRUC))
LABELS
STRUC)
XLIST (LABELING FROM L LABELED = (LUNCLASS **)))))
))
(DE STRUCTURESWITHATOMS (CLL STRUC)
(FOR NEW L IN (LLABELNODES STRUC (LCDRLIST CLL))
XLIST (INSERTMARKERS
(COPYSTRUC (LSTRUC L))
CLL
(LABELED L)))))
))
(DE ATTACHFVS (FVP STRUC)
(FOR NEW L IN (LLABELNODES STRUC FVP)
XLIST (PUTFVS (COPYSTRUC (LSTRUC L)) (LABELED L)))))
))
(DE ATTACHBIVALENTS (PART STRUC)
(FOR NEW L IN (LABELEDGES STRUC (CDRLIST PART))
XLIST (PUTBIVS
(COPYSTRUC (LSTRUC L))
(CARLIST PART)
(LABELED L)))))
))
(DE LLABELNODES (STRUC LLABELS)
(FOR NEW L
IN (LLABEL
(MAPCAR @MAKEUNCLASSED(LISTBYVALENCE STRUC) )
LLABELS
STRUC)
XLIST (LABELING FROM L LABELED = (LLUNCLASS **)))))
))
(DE MAKEUNCLASSED (X)
(IF (NOT X) THEN NIL ELSE (UNCLASSED OBJECTS = X))))
))