perm filename CYCLIC[1,LMM] blob sn#013281 filedate 1972-11-18 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ") T) (LISPXPRIN1 (QUOTE 
"17-NOV-72 23:33:50") T) (LISPXTERPRI T))
(LISPXPRINT (QUOTE CYCLICVARS) T)
(RPAQQ CYCLICVARS ((FNS VALENCE FVPARTITION1 FVPART1 MINLOOPS MAXLOOPS
SUPERATOMPARTITIONS MAXUNSATL COMPUTEFV ROWS BIVALENTPARTITIONS 
TRIMZEROS TD M2/2 LOOPPARTITIONS1 JLIST LPROWS LOOPPARTITIONS CLPARTLP1
STRUCTURESWITHATOMS NUMPARTITIONS NUMPARTITIONS* FVPARTITIONS) (VARS)
(RECORD SUPERATOMPARTITION) (RECORD FVPARTITION) (RECORD LOOPPARTITION)
(PROP VALENCE C H O N) (LMMMAC EVENP)))
(DEFINEQ

(VALENCE
(LAMBDA (AT) (COND ((NUMBERP AT) AT) ((ATOM AT) (GETP AT (QUOTE VALENCE)))
(T (FREEVALENCESIZE AT)))))

(FVPARTITION1
(LAMBDA (N VL S) (COND ((NULL VL) (LIST NIL)) (T (PROG (SUMREST) (SETQ
SUMREST (FOR NEW X IN (CDR VL) AS NEW SP := ((ADD1 S) 9999999) IPLUS
(ITIMES SP X))) (RETURN (FOR NEW I := ((MAX 0 (IDIFFERENCE N SUMREST))
(MIN N (ITIMES (CAR VL) S))) AS NEW PARTREST IS (FVPARTITION1 (
IDIFFERENCE N I) (CDR VL) (ADD1 S)) FOR NEW FIRSTPART IN (FVPART1
I (CAR VL) S) FOR NEW RESTPART IN PARTREST XLIST (CONS FIRSTPART 
RESTPART))))))))

(FVPART1
(LAMBDA (N MAXSUM MAXOCCUR) (COND ((ZEROP MAXOCCUR) (LIST NIL)) (T
(FOR NEW I := ((MAX 0 (IDIFFERENCE N (ITIMES MAXSUM (SUB1 MAXOCCUR))))
(MIN MAXSUM (IQUOTIENT N MAXOCCUR))) FOR NEW REST IN (FVPART1 (
IDIFFERENCE N (ITIMES I MAXOCCUR)) (IDIFFERENCE MAXSUM I) (SUB1 MAXOCCUR))
XLIST (CONS I REST))))))

(MINLOOPS
(LAMBDA (VALENCELIST) (MAX 0 (PROG (MXV TD) (SETQ TD (SETQ MXV 0))
(FOR NEW X IN (CDR VALENCELIST) AS NEW VALENCE := (3 999999) WHEN
(NOT (ZEROP X)) DO (IF (IGREATERP VALENCE MXV) THEN (SETQ MXV VALENCE))
(SETQ TD (IPLUS (ITIMES X VALENCE) TD))) (RETURN (IQUOTIENT (IDIFFERENCE
MXV TD) 2))))))

(MAXLOOPS
(LAMBDA (VALENCELIST) (MIN (CAR VALENCELIST) (IQUOTIENT (FOR NEW W
IN (CDDR VALENCELIST) AS NEW J := (2 99999) PLUS FIRST 1 (TIMES W
J)) 2))))

(SUPERATOMPARTITIONS
(LAMBDA (CL U) (PROG (CL1 SZ) (SETQ CL1 (FOR NEW PR IN CL WHEN (EQP
(VALENCE (CAR PR)) 1) LIST PR)) (SETQ CL (CLDIFF CL CL1)) (RETURN
(FOR NEW PARTSIZE := (2 (SETQ SZ (CLCOUNT CL))) FOR NEW VHAT IN (CLPARTS
CL PARTSIZE) AS NEW REMATS IS (APPEND CL1 (CLDIFF CL VHAT)) FOR NEW
#PARTS := (1 (IQUOTIENT PARTSIZE 2)) FOR NEW PARTITION IN (CLPARTITIONSN
VHAT #PARTS 2 9999999) AS NEW VI IS (CLCREATE PARTITION) AS NEW MXUI
IS (MAXUNSATL VI) WHEN MXUI FOR NEW UI IN (NUMPARTITIONS* U 1 MXUI
(CDRLIST VI)) XLIST (SUPERATOMPARTITION REMAININGATOMS = REMATS 
SUPERATOMPARTS = (PROG (CVI CVN M VI2 CUI VI3) (SETQ VI3 VI) VILOOP
(IF (NULL VI3) THEN (RETURN VI2)) (SETQ CVI (CAAR VI3)) (SETQ CVN
(CDAR VI3)) (SETQ VI3 (CDR VI3)) LOOPM (SETQ M 0) LOOPCVN (SETQ M
(ADD1 M)) (SETQ CVN (SUB1 CVN)) (SETQ CUI (CAR UI)) (SETQ UI (CDR
UI)) (IF (AND (NOT (ZEROP CVN)) (EQP CUI (CAR UI))) THEN (GO LOOPCVN))
(SETQ VI2 (CONS (CONS (CONS CUI CVI) M) VI2)) (IF (ZEROP CVN) THEN
(GO VILOOP) ELSE (GO LOOPM)))))))))

(MAXUNSATL
(LAMBDA (PC) (FOR NEW PART-NUM IN PC LIST (PROG (N TD M) (SETQ N (SETQ
TD (SETQ M 0))) (FOR NEW PR IN (CAR PART-NUM) DO (SETQ N (IPLUS N
(CDR PR))) (SETQ TD (IPLUS TD (ITIMES (CDR PR) (VALENCE (CAR PR)))))
(SETQ M (MAX M (VALENCE (CAR PR))))) (RETURN (IQUOTIENT (IPLUS 2 TD
(ITIMES -2 N) (MIN -1 (IDIFFERENCE TD (TWICE M)))) 2))))))

(COMPUTEFV
(LAMBDA (U CL) (PROG (TD N) (SETQ TD (SETQ N 0)) (FOR NEW PR IN CL
DO (SETQ TD (IPLUS (ITIMES (VALENCE (CAR PR)) (CDR PR)) TD)) (SETQ
N (IPLUS (CDR PR) N))) (RETURN (IPLUS 2 TD (ITIMES -2 (IPLUS N U)))))))

(ROWS
(LAMBDA (LL) (IF (NOT LL) THEN (QUOTE (NIL)) ELSE (CONS (*CARLIST
LL) (ROWS (CDRLIST (CDR LL)))))))

(BIVALENTPARTITIONS
(LAMBDA (VL) (NUMPARTITIONS (CAR VL) (IQUOTIENT (FOR NEW I := (3 9999)
AS NEW X IN (CDR VL) IPLUS (ITIMES I X)) 2) 0 (CAR VL))))

(TRIMZEROS
(LAMBDA (L) (PROG (N) (RETURN (IF (NULL L) THEN NIL ELSEIF (ZEROP
(SETQ N (*PLUS L))) THEN NIL ELSE (CONS (CAR L) (TRIMZEROS (CDR L)))))))
)

(TD
(LAMBDA (VL J) (IF (NOT VL) THEN 0 ELSE (IPLUS (ITIMES J (CAR VL))
(TD (CDR VL) (ADD1 J))))))

(M2/2
(LAMBDA (N) (SUB1 (IQUOTIENT N 2))))

(LOOPPARTITIONS1
(LAMBDA (P VL J) (IF (NOT VL) THEN (LIST NIL) ELSE (FOR NEW PJ :=
((MAX 0 (IDIFFERENCE P (MAXREST VL J))) (MIN P (ITIMES (M2/2 J) (CAR
VL)))) AS NEW RESTL IS (LOOPPARTITIONS1 (IDIFFERENCE P PJ) (CDR VL)
(ADD1 J)) FOR NEW THISPART IN (FVPART1 PJ (CAR VL) (M2/2 J)) FOR NEW
RESTPART IN RESTL XLIST (CONS THISPART RESTPART)))))

(JLIST
(LAMBDA (LL N) (IF (NOT LL) THEN NIL ELSEIF (NOT (CDR LL)) THEN (LIST
(CAR (NTH (CAR LL) N))) ELSE (CONS (CAR (NTH (CAR LL) N)) (JLIST (CDDR
LL) (ADD1 N))))))

(LPROWS
(LAMBDA (LPP VL) (PROGN (SETQ LPP (CONS NIL LPP)) (FOR NEW S := (4
999999) AS NEW V IN (CONS (CAR VL) (FOR NEW V2 IN (CDR VL) AS NEW
PL IN LPP LIST (DIFFERENCE V2 (*PLUS PL)))) AS LPP IS (IF LPP THEN
(CDR LPP) ELSE NIL) LIST (CONS V (JLIST LPP (M2/2 S)))))))

(LOOPPARTITIONS
(LAMBDA (P VL) (FOR NEW LPP IN (LOOPPARTITIONS1 P (CDDR VL) 4) AS
NEW ROWS IS (LPROWS LPP VL) FOR NEW K := (0 (TD (CDR VL) 3)) FOR NEW
BP IN (NUMPARTITIONS (CAR VL) (IPLUS P K) 1 999999) AS NEW CLBP IS
(CLCREATE BP) FOR NEW EL IN (CLPARTS CLBP K) FOR NEW LPL IN (
CLPARTITIONSL (CLDIFF CLBP EL) (CDRLIST ROWS)) XLIST (LOOPPARTITION
LOOPVL = (CONS (*PLUS (CDAR ROWS)) (MAPCAR (CDR ROWS) (FUNCTION *PLUS)))
EDGELABELS = EL LOOPLABELS = LPL))))

(CLPARTLP1
(LAMBDA (CL ROW N) (IF (NOT ROW) THEN (LIST NIL) ELSEIF (ZEROP (CAR
ROW)) THEN (CLPARTLP1 CL (CDR ROW) (ADD1 N)) ELSE (FOR NEW EP IN (
CLPARTS CL (ITIMES N (CAR ROW))) AS NEW RPL IS (CLPARTLP1 (CLDIFF
CL EP) (CDR ROW) (ADD1 N)) FOR NEW EEP IN (CL=PARTS EP (CAR ROW) N)
FOR NEW RP IN RPL XLIST (APPEND (CLCREATE EEP) RP)))))

(STRUCTURESWITHATOMS
(LAMBDA (CLL STRUC) (FOR NEW L IN (LLABELNODES STRUC (LCDRLIST CLL))
XLIST (INSERTMARKERS (COPYSTRUC (LSTRUC L)) CLL (LABELED L)))))

(NUMPARTITIONS
(LAMBDA (N NUMPARTS MINPART MAXPART) (IF (EQP NUMPARTS 1) THEN (IF
(OR (IGREATERP MINPART N) (ILESSP MAXPART N)) THEN NIL ELSE (LIST
(LIST N))) ELSE (FOR NEW I := ((MAX MINPART (IDIFFERENCE N (ITIMES
(SUB1 NUMPARTS) MAXPART))) (MIN MAXPART (IQUOTIENT N NUMPARTS))) FOR
NEW RESTPART IN (NUMPARTITIONS (IDIFFERENCE N I) (SUB1 NUMPARTS) I
MAXPART) LIST (CONS I RESTPART)))))

(NUMPARTITIONS*
(LAMBDA (U MN MAXIMA OCCURLIST) (IF (NULL (CDR OCCURLIST)) THEN (
NUMPARTITIONS U (CAR OCCURLIST) MN (CAR MAXIMA)) ELSE (FOR NEW FIRST
:= ((MAX MN (IDIFFERENCE (FIX+ U) (FOR NEW X IN (CDR MAXIMA) AS NEW
Y IN (CDR OCCURLIST) IPLUS FIRST (ITIMES (SUB1 (CAR OCCURLIST)) (CAR
MAXIMA)) (ITIMES X Y)))) (MIN (CAR MAXIMA) (IQUOTIENT (IDIFFERENCE
U (*PLUS (CDR OCCURLIST))) (CAR OCCURLIST)))) FOR NEW REST IN (IF
(EQP (CAR OCCURLIST) 1) THEN (NUMPARTITIONS* (IDIFFERENCE U FIRST)
1 (CDR MAXIMA) (CDR OCCURLIST)) ELSE (NUMPARTITIONS* (IDIFFERENCE
U FIRST) FIRST MAXIMA (CONS (SUB1 (CAR OCCURLIST)) (CDR OCCURLIST))))
XLIST (CONS FIRST REST)))))

(FVPARTITIONS
(LAMBDA (FV VL) (FOR NEW FVP IN (FVPARTITION1 FV (CDR VL) 1) AS NEW
FVR IS (ROWS FVP) XLIST (FVPARTITION FVR = FVR NEWVL = (FOR NEW ROW
IN FVR AS NEW COL IN (CONS NIL FVP) AS NEW V IN VL LIST (IPLUS V (*PLUS
ROW) (MINUS (*PLUS COL))))))))
)
(DEFLIST(QUOTE(
(SUPERATOMPARTITION (SUPERATOMPARTS . REMAININGATOMS))
))(QUOTE RECORD))

(RECORD (QUOTE SUPERATOMPARTITION))
(DEFLIST(QUOTE(
(FVPARTITION (NEWVL . FVR))
))(QUOTE RECORD))

(RECORD (QUOTE FVPARTITION))
(DEFLIST(QUOTE(
(LOOPPARTITION (LOOPVL EDGELABELS . LOOPLABELS))
))(QUOTE RECORD))

(RECORD (QUOTE LOOPPARTITION))
(DEFLIST(QUOTE(
(C 4)
(H 1)
(O 2)
(N 3)
))(QUOTE VALENCE))

(/PUTDQ EVENP (LAMBDA (X) (ZEROP (IREMAINDER X 2))))
STOP