perm filename CYCOMF.LSP[DEN,LMM] blob
sn#037468 filedate 1973-05-19 generic text, type T, neo UTF8
(DEFPROP CYCOMFFNS
(CYCOMFFNS ORDPAIR
EDGEMARK
LABEL1C
MAKEMULT
MAKENODES
MAKEEDGES
LABELMULT
LABEL0A
LABELN
LABELE
UNCLASS
LUNCLASS)
VALUE)
(DEFPROP ORDPAIR
(LAMBDA (X1 X2) (IF (LEQ X1 X2) THEN (CONS X1 X2) ELSE (CONS X2 X1)))
EXPR)
(DEFPROP EDGEMARK
(LAMBDA (EDG) (ORDPAIR (NODEMARK (NODE1 EDG)) (NODEMARK (NODE2 EDG))))
EXPR)
(DEFPROP LABEL1C
(LAMBDA(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)))
EXPR)
(DEFPROP MAKEMULT
(LAMBDA (M OBJ) (IF (ZEROP M) THEN NIL ELSEIF (EQUAL M 1.) THEN OBJ ELSE (MULTTYPE MULT = M UNMULTED = OBJ)))
EXPR)
(DEFPROP MAKENODES
(LAMBDA (NODES) (IF (NOT NODES) THEN NIL ELSE (NODETYPE NODENUMS = NODES)))
EXPR)
(DEFPROP MAKEEDGES
(LAMBDA (EDGES) (IF (NOT EDGES) THEN NIL ELSE (EDGETYPE NODEPRS = EDGES)))
EXPR)
(DEFPROP LABELMULT
(LAMBDA(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)))))
EXPR)
(DEFPROP LABEL0A
(LAMBDA(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)))))
EXPR)
(DEFPROP LABELN
(LAMBDA(NODENUMS LABELS STRUC)
(LABEL0A NODENUMS STRUC (FINDGROUPNODES NODENUMS STRUC) LABELS (FUNCTION MAKENODES)))
EXPR)
(DEFPROP LABELE
(LAMBDA (EDGES LABELS STRUC) (LABEL0A EDGES STRUC (FINDGROUPEDGES EDGES STRUC) LABELS (FUNCTION MAKEEDGES)))
EXPR)
(DEFPROP UNCLASS
(LAMBDA(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 (QUOTE (ERROR ARG TO UNCLASS))) NIL)))
EXPR)
(DEFPROP LUNCLASS
(LAMBDA (LOBJ) (MAPCAR (QUOTE UNCLASS) LOBJ))
EXPR)