perm filename CYCOMF[1,LMM]1 blob
sn#031708 filedate 1973-03-27 generic text, type T, neo UTF8
(DE ORDPAIR (X1 X2)
(IF (LEQ X1 X2) THEN (CONS X1 X2) ELSE (CONS X2 X1))))
))))))))
(DE EDGEMARK (EDG)
(ORDPAIR (NODEMARK (NODE1 EDG)) (NODEMARK (NODE2 EDG)))))
))))))))))))
(DE LABEL1C (OBJECTS LABELS STRUC)
(IF (ZEROP LABELS)
THEN (LIST (LABELING UNLABELED = OBJECTS LSTRUC = STRUC))
ELSEIF (EQUAL LABELS (SIZE OBJECTS))
THEN (LIST (LABELING LABELED = OBJECTS LSTRUC = STRUC))
ELSEIF (NODES? OBJECTS)
THEN (LABELN (NODENUMS OBJECTS) LABELS STRUC)
ELSEIF (EDGES? OBJECTS)
THEN (LABELE (NODEPRS OBJECTS) LABELS STRUC)
ELSEIF (MULTTYPE? OBJECTS)
THEN (LABELMULT
(MULT OBJECTS)
(UNMULTED OBJECTS)
LABELS
STRUC)
ELSE (LABELUNDEFINEDSTRUC OBJECTS LABELS STRUC))))
))))))))
(DE MAKEMULT (M OBJ)
(IF (ZEROP M) THEN NIL
ELSEIF (EQUAL M 1) THEN OBJ
ELSE (MULTTYPE MULT = M UNMULTED = OBJ))))
))
(DE MAKENODES (NODES)
(IF (NOT NODES) THEN NIL ELSE (NODETYPE NODENUMS = NODES))))
))
(DE MAKEEDGES (EDGES)
(IF (NOT EDGES) THEN NIL ELSE (EDGETYPE NODEPRS = EDGES))))
))
(DE LABELMULT (MULTS UNMULTED LABELS STRUC)
(FOR NEW P
IN (NUMPARTITIONS LABELS (SIZE UNMULTED) 0 MULTS)
AS NEW CLP IS (CLCREATE P)
FOR NEW L IN (LABELM UNMULTED (CDRLIST CLP) STRUC)
XLIST (LABELING
FROM
L
LABELED
=
(FOR NEW X IN ** AS NEW PR IN CLP
COMBINE FIRST NIL
(MAKEMULT (CAR PR) X))
UNLABELED
=
(FOR NEW X IN (LABELED L) AS NEW PR IN CLP
COMBINE FIRST NIL
(MAKEMULT (DIFFERENCE MULTS (CAR PR)) X)))))
)
))
(DE LABEL0A (OBJECTS STRUC NPL LABELS MAKEFN)
(FOR NEW L
IN (IF (NOT (REMPERMS NPL))
THEN (COMB1 OBJECTS NIL NIL (OKPERMS NPL) LABELS)
ELSE (COMB
OBJECTS
NIL
(DIFF (OBJ (CAR (REMPERMS NPL))) OBJECTS)
NPL
LABELS))
XLIST (LABELING
FROM
L
LABELED
=
(MAKEFN **)
UNLABELED
=
(MAKEFN (DIFF OBJECTS (LABELED L)))
LSTRUC
=
(STRUCTURE FROM STRUC GROUP = (LSTRUC L))))))
))
(DE LABELN (NODENUMS LABELS STRUC)
(LABEL0A
NODENUMS
STRUC
(FINDGROUPNODES NODENUMS STRUC)
LABELS
(FUNCTION MAKENODES))))
))
(DE LABELE (EDGES LABELS STRUC)
(LABEL0A
EDGES
STRUC
(FINDGROUPEDGES EDGES STRUC)
LABELS
(FUNCTION MAKEEDGES))))
))
(DE UNCLASS (OBJECTS)
(IF (NOT OBJECTS) THEN NIL
ELSEIF (UNCLASSED? OBJECTS) THEN (OBJECTS OBJECTS)
ELSEIF (NODES? OBJECTS) THEN (NODENUMS OBJECTS)
ELSEIF (EDGES? OBJECTS) THEN (NODEPRS OBJECTS)
ELSEIF (MULTTYPE? OBJECTS)
THEN (FOR NEW M := (1 (MULT OBJECTS))
APPEND (UNCLASS (UNMULTED OBJECTS)))
ELSEIF (COMBINATION? OBJECTS)
THEN (APPEND
(UNCLASS (OBJ1 OBJECTS))
(UNCLASS (OBJ2 OBJECTS)))
ELSE (PRINT (CONS OBJECTS @(ERROR ARG TO UNCLASS))
NIL)))
))
(DE LUNCLASS (LOBJ)
(MAPCAR @ UNCLASS LOBJ))))
))