perm filename CYCLIC.CLS[LST,LMM] blob
sn#060149 filedate 1973-08-24 generic text, type T, neo UTF8
(FILECREATED "24-AUG-73 02:51:19" CYCLIC.CLISP)
(LISPXPRINT (QUOTE CYCLICVARS)
T)
(RPAQQ CYCLICVARS
((FNS VALENCE FVPARTITION1 FVPART1 MINLOOPS MAXLOOPS
SUPERATOMPARTITIONS MAXUNSATL COMPUTEFV ROWS
BIVALENTPARTITIONS TRIMZEROS TD LOOPPARTITIONS1 JLIST
LPROWS LOOPPARTITIONS CLPARTLP1 STRUCTURESWITHATOMS
NUMPARTITIONS NUMPARTITIONS' FVPARTITIONS)
(PROP RECORD SUPERATOMPARTITION FVPARTITION LOOPPARTITION)
(P (RECORD 'SUPERATOMPARTITION)
(RECORD 'FVPARTTION)
(RECORD 'LOOPPARTITION))
(PROP VALENCE C H O N)))
(DEFINEQ
(VALENCE
[LAMBDA (X)
(if }X
then 2
elseif NUMBERP X
then X
elseif ATOM X
then GETP X 'VALENCE
else FREEVALENCESIZE X])
(FVPARTITION1
[LAMBDA (N VL S)
(if VL=NIL
then <NIL>
else (PROG (MAXI (SUMREST 0)
RESULT)
(for X in VL::1 as SP from S+1 do SUMREST←SUMREST+SP*X)
(MAXI←(MIN N VL:1*S))
(for I from (MAX 0 N-SUMREST) to MAXI bind PARTREST
do PARTREST←(FVPARTITION1 N-I VL::1 S+1)
(for FIRSTPART in (FVPART1 I VL:1 S)
do (for RESTPART in PARTREST
do RESULT← <<FIRSTPART ! RESTPART> !
RESULT>)))
(RETURN RESULT])
(FVPART1
[LAMBDA (N MAXSUM MAXOCCUR)
(if MAXOCCUR=0
then <NIL>
else (PROG (MAXI RESULT)
(MAXI←(MIN MAXSUM N/MAXOCCUR))
(for I from (MAX 0 N-MAXSUM*(MAXOCCUR-1))
to MAXI
do (for REST in (FVPART1 N-I*MAXOCCUR MAXSUM-I
MAXOCCUR-1)
do RESULT← < <I ! REST> ! RESULT>))
(RETURN RESULT])
(MINLOOPS
[LAMBDA (VALENCELIST)
(MAX 0
(PROG (MXV TD)
(TD←MXV←0)
(for X in VALENCELIST::1 as VALENCE from 3 when X}=0
do (if VALENCE GT MXV
then MXV←VALENCE)
TD←X*VALENCE+TD)
(RETURN (MXV-TD)/2])
(MAXLOOPS
[LAMBDA (VALENCELIST)
(MIN VALENCELIST:1 (MAXREST VALENCELIST::1 3])
(SUPERATOMPARTITIONS
[LAMBDA (CL U)
(PROG (CL1 SZ RESULTS REMATS VI)
(CL1←(for PR in CL when (VALENCE PR:1)=1 collect PR))
(CL←(CLDIFF CL CL1))
(SZ←(CLCOUNT CL))
[for
PARTSIZE from 2 to SZ
do
(for
VHAT in (CLPARTS CL PARTSIZE)
do
REMATS← <! CL1 ! (CLDIFF CL VHAT)>
(for
#PARTS from PARTSIZE/2 to 1 by -1
do
(for
PARTITION in (CLPARTITIONSN VHAT #PARTS 2
9999999)
do
(VI←(CLCREATE PARTITION))
(MXUI←(MAXUNSATL VI (AND }REMATS }(
PARTITION::1)
U)))
(if MXUI
then
(for UI in (NUMPARTITIONS' U 1 MXUI
(CDRLIST
VI))
do RESULTS ←
<(SUPERATOMPARTITION
REMAININGATOMS = REMATS
SUPERATOMPARTS =(CLCREATE
(for VIELT
in (CLEXPAND VI)
as UIELT
in UI
collect <UIELT ! VIELT>)))
! RESULTS >]
(RETURN RESULTS])
(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)
(N←TD←M←0)
(for PR in PARTNUM:1 do N←N+PR::1
TD←TD+PR::1*(VALENCE
PR:1)
M←(MAX M (VALENCE PR:1)))
(N←2+TD-2*N)
(RETURN (N+(MIN (if 2*U=N
then 0
else -1)
TD-2*M))/2])
(COMPUTEFV
[LAMBDA (U CL)
(PROG (TD N)
(TD←N←0)
(for PR in CL do TD←(VALENCE PR:1)*PR::1+TD N←PR::1+N)
(RETURN 2+TD-2*(N+U])
(ROWS
[LAMBDA (LL)
(if LL=NIL
then <NIL>
else <(for X in LL collect X:1)
!
(ROWS (for X in LL::1 collect X::1))>])
(BIVALENTPARTITIONS
[LAMBDA (VL)
(NUMPARTITIONS VL:1
(PROG ((SUM 0))
(for I from 3 as X in VL::1 do SUM←SUM+I*X)
(RETURN SUM/2))
0 VL:1])
(TRIMZEROS
[LAMBDA (L)
(if L=NIL or L EQUALS '(0)
then NIL
else L::1←(TRIMZEROS L::1])
(TD
[LAMBDA (VL J)
(if VL=NIL
then 0
else J*VL:1+(TD VL::1 J+1])
(LOOPPARTITIONS1
[LAMBDA (P VL J)
(if VL=NIL
then <NIL>
else (PROG (RESULTS MAXPJ RESTL)
(MAXPJ←(MIN P J/2-1*VL:1))
(for PJ from (MAX 0 P-(MAXREST VL J)) to MAXPJ
do RESTL←(LOOPPARTITIONS1 P-PJ VL::1 J+1)
(for THISPART in (FVPART1 PJ VL:1 J/2-1)
do (for RESTPART in RESTL
do RESULTS← <<THISPART ! RESTPART> !
RESULTS>)))
(RETURN RESULTS])
(JLIST
[LAMBDA (LL N)
(if LL=NIL
then NIL
elseif LL::1=NIL
then <(CAR (NTH LL:1 N))>
else <(CAR (NTH LL:1 N))
!
(JLIST LL::2 N+1)>])
(LPROWS
[LAMBDA (LPP VL)
LPP← <NIL ! LPP>
(for S from 4 as V
in <VL:1 ! (for V2 in VL::1 as PL in LPP collect V2-(SUM
PL))>
collect <V ! (JLIST LPP←LPP::1
S/2-1)>])
(LOOPPARTITIONS
[LAMBDA (P VL)
(for LPP in (LOOPPARTITIONS1 P VL::2 4)
collect (PROG ((ROWS (LPROWS LPP VL))
(NEWVL
<(SUM ROWS:1::1)
!
(for X in ROWS : : 1 collect SUM)>)
RESULTS MAXK CLBP)
(MAXK←(MIN VL:1-P (TD VL::1 3)/2))
[for K from 0 to MAXK
do (for BP in (NUMPARTITIONS VL:1 P+K 1 999999)
as
do (CLBP←(CLCREATE BP))
(for EL in (CLPARTS CLBP K)
do (for LPL
in (CLPARTITIONSL
(CLDIFF CLBP EL)
(CDRLIST ROWS))
do RESULTS←
<(LOOPPARTITION LOOPVL =
NEWVL
EDGELABELS =
EL
LOOPLABELS =
LPL)
! RESULTS>]
(RETURN RESULTS])
(CLPARTLP1
[LAMBDA (CL ROW N)
(if ROW=NIL
then <NIL>
elseif ROW:1=0
then (CLPARTLP1 CL ROW::1 N+1)
else (PROG (RESULTS RPL)
(for EP in (CLPARTS CL N*ROW:1)
do (RPL ←(CLPARTLP1 (CLDIFF CL EP)
ROW::1 N+1))
(for EEP in (CL=PARTS EP ROW:1 N)
do (for RP in RPL do RESULTS←
< <! (CLCREATE EEP) !
RP>
! RESULTS>)))
(RETURN RESULTS])
(STRUCTURESWITHATOMS
[LAMBDA (CLL STRUC)
(FOR L IN (LLABELNODES STRUC (LCDRLIST CLL))
COLLECT (INSERTMARKERS (COPYSTRUC (LSTRUC L))
CLL
(LABELED L])
(NUMPARTITIONS
[LAMBDA (N NUMPARTS MINPART MAXPART)
(if NUMPARTS=1
then (if MINPART GT N or MAXPART LT N
then NIL
else <<N>>)
else (PROG (RESULTS MAXI)
(MAXI←(MIN MAXPART N/NUMPARTS))
(for I from (MAX MINPART N-(NUMPARTS-1)*MAXPART)
to MAXI
do (for RESTPART in (NUMPARTITIONS N-I NUMPARTS-1 I
MAXPART)
do RESULTS← < <I ! RESTPART> ! RESULTS>))
(RETURN RESULTS])
(NUMPARTITIONS'
[LAMBDA (U MN MAXIMA OCCURLIST)
(if OCCURLIST::1=NIL
then (NUMPARTITIONS U OCCURLIST:1 MN MAXIMA:1)
else (PROG (MINFIRST RESULTS)
(MINFIRST←(OCCURLIST:1-1)*MAXIMA:1)
(for X in MAXIMA::1 as Y in OCCURLIST::1
do (MINFIRST← X*Y+MINFIRST))
(MINFIRST←(MAX MN (FIX' U)
-MINFIRST))
(for FRST to MINFIRST
from (MIN MAXIMA:1 (U-(SUM OCCURLIST::1))
/OCCURLIST:1)
by -1
do (for REST
in (if OCCURLIST:1=1
then (NUMPARTITIONS' U-FRST 1
MAXIMA::1
OCCURLIST::1)
else (NUMPARTITIONS' U-FRST FRST MAXIMA
<OCCURLIST:1-1!
OCCURLIST::1>))
do (RESULTS← < <FRST ! REST> ! RESULTS>)))
(RETURN RESULTS])
(FVPARTITIONS
[LAMBDA (FV VL)
(for FVP in (FVPARTITION1 FV VL::1 1)
collect ([LAMBDA (FVR)
(FVPARTITION FVR = FVR NEWVL =(for ROW in FVR
as COL
in <NIL ! FVP>
as V
in VL
collect
V+(SUM ROW) -(SUM
COL]
(ROWS FVP])
)
(DEFLIST(QUOTE(
(SUPERATOMPARTITION (SUPERATOMPARTS . REMAININGATOMS))
(FVPARTITION NIL)
(LOOPPARTITION NIL)
))(QUOTE RECORD))
(RECORD 'SUPERATOMPARTITION)
(RECORD 'FVPARTTION)
(RECORD 'LOOPPARTITION)
(DEFLIST(QUOTE(
(C NIL)
(H NIL)
(O NIL)
(N NIL)
))(QUOTE VALENCE))
STOP