perm filename CYCLIC[DEN,LMM] blob sn#070829 filedate 1973-11-11 generic text, type T, neo UTF8

(FILECREATED "11-NOV-73 09:25:52" S-CYCLIC changes to: MAXREST,LPROWS,NEWNODES,NEWNODES1,FVPART1,TRIMZEROS, LOOPPARTITIONS1,LOOPPARTITIONS,TRIM,MAXLOOPS,GRAPHON,CYCLICVARS previous date: " 8-NOV-73 14:36:23") (LISPXPRINT (QUOTE CYCLICVARS) T) (RPAQQ CYCLICVARS ((* Unfortunately, this file is a catch-all for not-easy-to-classify files) (FNS VALENCE FVPARTITION1 FVPART1 MINLOOPS MAXLOOPS SUPERATOMPARTITIONS MAXUNSATL COMPUTEFV ROWS BIVALENTPARTITIONS TRIMZEROS TD LOOPPARTITIONS1 NEWNODES NEWNODES1 LPROWS CLPARTLP1 NUMPARTITIONS NUMPARTITIONS' FVPARTITIONS EVENP LOOPPARTITIONS MAXREST CLBYVALENCE TRIM GRAPHON) (RECORDS SUPERATOMPARTITION FVPARTITION LOOPPARTITION) (PROP VALENCE C H O N CH CH2 CH3 W OH CHOH COH Y #))) (* Unfortunately, this file is a catch-all for not-easy-to-classify files) (DEFINEQ (VALENCE [LAMBDA (X) (PROG (TEM) [SETQ TEM (COND ((NULL X) 2) ((NUMBERP X) X) ((ATOM X) (GETP X (QUOTE VALENCE))) (T (FREEVALENCESIZE X] [COND ((NOT (AND (NUMBERP TEM) (IGREATERP TEM 0))) (SETQ TEM (HELP "WHAT IS VALENCE OF" X)) (AND (LITATOM X) (/PUT X (QUOTE VALENCE) TEM] (RETURN TEM]) (FVPARTITION1 [LAMBDA (N VL S) (* Partition N into as many parts as length VL; with the Ith part having at most VL:I* (S+I) - Then partition the ith part according to FVPART1) (COND ((NULL VL) (LIST NIL)) (T (FOR I FROM [MAX 0 (IDIFFERENCE N (TD (CDR VL) (ADD1 S] TO (MIN N (ITIMES (CAR VL) S)) AS PARTREST IS (FVPARTITION1 (IDIFFERENCE N I) (CDR VL) (ADD1 S)) FOR FIRSTPART IN (FVPART1 I (CAR VL) S) FOR RESTPART IN PARTREST XLIST (CONS FIRSTPART RESTPART]) (FVPART1 [LAMBDA (N MAXSUM MAXOCCUR) (* Partition N into parts of the form MAXOCCUR * I1 , MAXOCCUR-1 * I2 , MAXOCCUR-2 * I3 ... where the SUM of the I's is less than or equal to MAXSUM) (* WARNING: value may be RPLAC'ed) (COND ((ZEROP MAXOCCUR) (LIST NIL)) ((ZEROP N) (LIST (FOR I FROM 1 TO MAXOCCUR COLLECT 0))) (T (FOR I FROM [MAX 0 (IDIFFERENCE N (ITIMES MAXSUM (SUB1 MAXOCCUR] TO (MIN MAXSUM (IQUOTIENT N MAXOCCUR)) FOR REST IN (FVPART1 (IDIFFERENCE N (ITIMES I MAXOCCUR)) (IDIFFERENCE MAXSUM I) (SUB1 MAXOCCUR)) XLIST (CONS I REST]) (MINLOOPS [LAMBDA (VALENCELIST) (SETQ VALENCELIST (TRIMZEROS VALENCELIST)) (MAX 0 (IDIFFERENCE (ADD1 (LENGTH VALENCELIST)) (IQUOTIENT (TD (CDR VALENCELIST) 3) 2]) (MAXLOOPS [LAMBDA (VALENCELIST) (MIN (CAR VALENCELIST) (MAXREST (CDDR VALENCELIST) 4]) (SUPERATOMPARTITIONS [LAMBDA (CL U) (PROG (CL1 SZ MXUI VI) (SETQ CL1 (for PR in CL when (EQ (VALENCE (CAR PR)) 1) collect PR)) (SETQ CL (CLDIFF CL CL1)) (SETQ SZ (CLCOUNT CL)) (FOR PARTSIZE FROM 2 TO SZ FOR VHAT IN (CLPARTS CL PARTSIZE) AS REMATS IS (APPEND CL1 (CLDIFF CL VHAT)) FOR #PARTS FROM 1 TO (IQUOTIENT PARTSIZE 2) FOR PARTITION IN (CLPARTITIONSN VHAT #PARTS 2) AS VI IS (CLCREATE PARTITION) AS MXUI IS (MAXUNSATL VI (COND ((AND (NULL REMATS) (NULL (CDR PARTITION))) U))) FOR UI IN (NUMPARTITIONS' U 1 MXUI (collect CDR in VI)) XLIST (create SUPERATOMPARTITION SUPERATOMPARTS←(CLCREATE (collect (CONS Y X) for X in (CLEXPAND VI) as Y in UI)) REMAININGATOMS← REMATS]) (MAXUNSATL [LAMBDA (PC U) (* Note U is either NIL (normal) or it is equal to the unsaturation in the case where remats is NIL and there is only one part here) (FOR PARTNUM IN PC COLLECT (PROG (N TD M) (SETQ N (SETQ TD (SETQ M 0))) [for PR in (CAR PARTNUM) do (SETQ N (IPLUS N (CDR PR))) [SETQ TD (IPLUS TD (ITIMES (CDR PR) (VALENCE (CAR PR] (SETQ M (MAX M (VALENCE (CAR PR] (SETQ N (IDIFFERENCE (IPLUS 2 TD) (ITIMES 2 N))) (RETURN (IQUOTIENT [IPLUS N (MIN (COND ((AND U (EQ (ITIMES U 2) N)) 0) (T -1)) (IDIFFERENCE TD (ITIMES 2 M] 2]) (COMPUTEFV [LAMBDA (U CL) (IDIFFERENCE [IPLUS 2 (for PR in CL sum (ITIMES (VALENCE (CAR PR)) (CDR PR] (ITIMES 2 (IPLUS (CLCOUNT CL) U]) (ROWS [LAMBDA (LL) (COND ((NULL LL) (QUOTE (NIL))) (T (CONS (CARLIST LL) (ROWS (CDRLIST (CDR LL]) (BIVALENTPARTITIONS [LAMBDA (VL) (* Number of parts LE number of bivalents and number of edges) (FOR I FROM 1 TO (MIN (CAR VL) (IQUOTIENT (TD (CDR VL) 3) 2)) JOIN (NUMPARTITIONS (CAR VL) I 1 NIL]) (TRIMZEROS [LAMBDA (L) (* Returns NIL if L is all zeros , and the tail of L which is not all zeros otherwise) (PROG ((TRIMVAL 0)) (TRIM L]) (TD [LAMBDA (VL J) (for I from J as X in VL sum (ITIMES I X]) (LOOPPARTITIONS1 [LAMBDA (P VL J) (* P is a number of loops; VL is a valencelist starting with J-valents; returns the partitions of number of loops among these nodes - a partition is of the form (j-valentpart j+1-valentpart ...) where each part is (number of single loops, number of double loops, ...)) (COND ((NULL VL) (LIST NIL)) (T (* PJ is the number of loops allocated to J-valents; MAXREST is the max number of loops that can go on the rest) (FOR PJ FROM [MAX 0 (IDIFFERENCE P (MAXREST (CDR VL) (ADD1 J] TO (MIN P (ITIMES (SUB1 (IQUOTIENT J 2)) (CAR VL))) AS RESTL IS (LOOPPARTITIONS1 (IDIFFERENCE P PJ) (CDR VL) (ADD1 J)) FOR THISPART1 IN (FVPART1 PJ (CAR VL) (SUB1 (IQUOTIENT J 2))) AS THISPART IS (TRIMZEROS (DREVERSE THISPART1)) FOR RESTPART IN RESTL XLIST (CONS THISPART RESTPART]) (NEWNODES [LAMBDA (LPP) (* LPP is a list: LPP:i-2 is a list for the old i+VALENCE nodes of the (number of single loops, number of double loops, ...); this function returns (number of VALENCE+2 nodes getting 1 loop, number of VALENCE+4 nodes getting 2 loops, ...)) (NEWNODES1 LPP 1]) (NEWNODES1 [LAMBDA (LPP J) (COND ((NULL LPP) NIL) (T (PROG [(TEM (NEWNODES1 (CDDR LPP) (ADD1 J))) (TEM2 (CAR (NTH (CAR LPP) J] (COND ((AND (NULL TEM) (OR (NULL TEM2) (ZEROP TEM2))) NIL) (T (CONS (OR TEM2 0) TEM]) (LPROWS [LAMBDA (LPP VL) (* VL is a valencelist starting with bivalents - LPP is an output from LOOPPARTITIONS1: LPP:i+2 corresponds to VL:i, and is the list (number of single loops, number of double loops, ... for the i-valent nodes)) [SETQ VL (CONS (CAR VL) (CONS (CADR VL) (FOR V2 IN (CDDR VL) AS LOOPLST IN LPP COLLECT (IDIFFERENCE V2 (SUMOF LOOPLST] (* This VL is now the valence list with the looped nodes removed) (FOR V IN VL COLLECT (CONS V (NEWNODES (PROG1 LPP (SETQ LPP (CDR LPP]) (CLPARTLP1 [LAMBDA (CL ROW N) (COND ((NULL ROW) (LIST NIL)) ((ZEROP (CAR ROW)) (CLPARTLP1 CL (CDR ROW) (ADD1 N))) (T (FOR EP IN (CLPARTS CL (ITIMES N (CAR ROW))) AS RPL IS (CLPARTLP1 (CLDIFF CL EP) (CDR ROW) (ADD1 N)) FOR EEP IN (CLEQUALPARTS EP (CAR ROW) N) FOR RP IN RPL XLIST (APPEND (CLCREATE EEP) RP]) (NUMPARTITIONS [LAMBDA (N NUMPARTS MINPART MAXPART) (* NEW FEATURE: MAXPART NIL MEANS MAXPART INFINITY) (COND [(EQ NUMPARTS 1) (COND ((OR (IGREATERP MINPART N) (AND MAXPART (ILESSP MAXPART N))) NIL) (T (LIST (LIST N] (T (FOR I FROM (COND [MAXPART (MAX MINPART (IDIFFERENCE N (ITIMES (SUB1 NUMPARTS) MAXPART] (T MINPART)) TO (COND (MAXPART (MIN MAXPART (IQUOTIENT N NUMPARTS))) (T (IQUOTIENT N NUMPARTS))) FOR RESTPART IN (NUMPARTITIONS (IDIFFERENCE N I) (SUB1 NUMPARTS) I MAXPART) XLIST (CONS I RESTPART]) (NUMPARTITIONS' [LAMBDA (U MN MAXIMA OCCURLIST) (COND ((NULL (CDR OCCURLIST)) (NUMPARTITIONS U (CAR OCCURLIST) MN (CAR MAXIMA))) (T (FOR FIRSTPART FROM [MAX MN (IDIFFERENCE (IDIFFERENCE (CIELING U) (ITIMES (SUB1 (CAR OCCURLIST)) (CAR MAXIMA))) (sum (ITIMES X Y) for X in (CDR MAXIMA) as Y in (CDR OCCURLIST] TO (MIN (CAR MAXIMA) (IQUOTIENT (IDIFFERENCE U (SUMOF (CDR OCCURLIST))) (CAR OCCURLIST))) FOR RESTPART IN [COND ((EQ (CAR OCCURLIST) 1) (NUMPARTITIONS' (IDIFFERENCE U FIRSTPART) 1 (CDR MAXIMA) (CDR OCCURLIST))) (T (NUMPARTITIONS' (IDIFFERENCE U FIRSTPART) FIRSTPART MAXIMA (CONS (SUB1 (CAR OCCURLIST)) (CDR OCCURLIST] XLIST (CONS FIRSTPART RESTPART]) (FVPARTITIONS [LAMBDA (FV VL) (FOR FVP IN (FVPARTITION1 FV (CDR VL) 1) AS FVR IS (ROWS FVP) COLLECT (create FVPARTITION NEWVL←(collect (IDIFFERENCE (IPLUS V (SUMOF ROW)) (SUMOF COL)) for ROW in FVR as COL in (CONS NIL FVP) as V in VL) FVR← FVR]) (EVENP [LAMBDA (X) (ZEROP (IREMAINDER X 2]) (LOOPPARTITIONS [LAMBDA (P VL) (* Returns a list of lists of LOOPPARTITIONs, sorted by NEWVL, for P loops among the valence list VL; a LOOPPARTITION consists of a NEWVL (new valence list), EDGELABELS (a composition list of number-of-bivalents), and LOOPLABELS (a composition list of loop-types, where a loop-type is a composition list of number-of-bivalents). For example, the looplabels: ((((5 . 2) (3 . 2)) . 1) (((1 . 2)) . 3)) means that 1 node gets two loops with 5 bivalents and two loops with 3; and that three nodes get two loops with 1 bivalent (e.g. O=X=O)) (* LOOPPARTITIONS1 determines where the loops will go; ROWS is a list ROWS:2 ROWS:3 ROWS:4 ... , where ROWS:i is a list: ((number of i valent nodes with no loops) (number of i valent nodes getting 1 loop) (number of i valent nodes getting 2 loops) ...) where the valence refers to the valence in the NEW graph) (FOR LPP IN (LOOPPARTITIONS1 P (CDDR VL) 4) AS ROWS IS (LPROWS LPP VL) AS NEWVL IS (CONS (SUMOF (CDAR ROWS)) (MAPCAR (CDR ROWS) (FUNCTION SUMOF))) WHEN (GRAPHON (TRIMZEROS NEWVL)) XLIST (FOR K FROM 0 TO (MIN (IDIFFERENCE (CAR VL) P) (IQUOTIENT (TD NEWVL 2) 2)) FOR BP IN (NUMPARTITIONS (CAR VL) (IPLUS P K) 1 NIL) AS CLBP IS (CLCREATE BP) FOR EL IN (CLPARTS CLBP K) FOR LPL IN [CLPARTITIONSL (CLDIFF CLBP EL) (PROG (TRIMVAL) (TRIM (CDRLIST ROWS] XLIST (create LOOPPARTITION LOOPVL← NEWVL EDGELABELS← EL LOOPLABELS← LPL]) (MAXREST [LAMBDA (VL J) (* VL is a valencelist starting at J-valents - returns the maximum number of loops that can be put on nodes with VL as valence list) (FOR OLD J FROM J TO 4 DO (SETQ VL (CDR VL))) (FOR OLD VL ON VL AS OLD J FROM J SUM (ITIMES (CAR VL) (SUB1 (IQUOTIENT J 2]) (CLBYVALENCE [LAMBDA (CL) (SETQ CL (GROUPBY [FUNCTION (LAMBDA (PR) (VALENCE (CAR PR] CL)) (FOR I FROM 2 TO (FOR X IN CL MAXIMUM (CAR X)) COLLECT (CDR (ASSOC I CL]) (TRIM [LAMBDA (LST) (AND (LISTP LST) (COND ((TRIM (CDR LST)) LST) ((EQ (CAR LST) TRIMVAL) NIL) (T (RPLACD LST NIL) LST]) (GRAPHON [LAMBDA (VL) (AND (EVENP (TD VL 2)) (ILESSP (LENGTH (TRIMZEROS VL)) (IDIFFERENCE (IQUOTIENT (TD VL 2) 2) (SUMOF VL]) ) (RECORD SUPERATOMPARTITION (SUPERATOMPARTS . REMAININGATOMS)) (RECORD FVPARTITION (NEWVL . FVR)) (RECORD LOOPPARTITION (LOOPVL EDGELABELS . LOOPLABELS)) (DEFLIST(QUOTE( (C 4) (H 1) (O 2) (N 3) (CH 3) (CH2 2) (CH3 1) (W 2) (OH 1) (CHOH 2) (COH 3) (Y 3) (# 2) ))(QUOTE VALENCE)) STOP