perm filename TOPLEV.CLS[LST,LMM] blob
sn#060152 filedate 1973-08-24 generic text, type T, neo UTF8
(FILECREATED "24-AUG-73 20:25:51" TOPLEVEL)
(LISPXPRINT (QUOTE TOPLEVELVARS)
T)
(RPAQQ TOPLEVELVARS
((FNS MOLECULES SUPERATOMS RINGS RINGSKELETONS NOFVRINGS
DAISIES NOLOOPEDRINGS SINGLERINGS KLOOPEDRINGS)))
(DEFINEQ
(MOLECULES
[LAMBDA (CL U)
(if U=0
then (GENMOL CL)
else (for SAP in (SUPERATOMPARTITIONS CL U)
join (for S in (SUPERATOMS (SUPERATOMPARTS SAP))
join (GENMOL <! (CLCREATE S)
!
(REMAININGATOMS SAP)>])
(SUPERATOMS
[LAMBDA (UCLCOMP)
(GROUPRADS (for UCLN in UCLCOMP collect <(RINGS UCLN:1:1 UCLN:1::1)
! UCLN::1>])
(RINGS
[LAMBDA (U CL)
(if (CLCOUNT CL)=2
then CL←(CLEXPAND CL) <(STRUCWITH2NODES U+1 CL:1 CL:2)>
else (PROG (FV)
(FV←(COMPUTEFV U CL))
(CL←(CLBYVALENCE CL))
(RETURN (for SKELETON
in (RINGSKELETONS FV
(for X in CL
collect CLCOUNT))
join (STRUCTURESWITHATOMS CL SKELETON])
(RINGSKELETONS
[LAMBDA (FV VL)
(if FV=0
then NOFVRINGS VL
else (for FVSECTION in (GROUPBY (FUNCTION [LAMBDA (X)
(NEWVL X])
(FVPARTITIONS FV VL))
bind STRUCLIST
join (STRUCLIST←(NOFVRINGS FVSECTION:1))
(for FVPART in FVSECTION::1
join (for STRUC in STRUCLIST
join (ATTACHFVS (FVR FVPART)
STRUC])
(NOFVRINGS
[LAMBDA (VL)
(PROG (MNLPS MXLPS SUMREST)
(SUMREST←(SUM VL::1))
(if (SUMREST=0)
then (RETURN (SINGLERINGS VL:1))
elseif (SUMREST=1)
then (RETURN (DAISIES VL)))
(MNLPS←(MINLOOPS VL))
(MXLPS←(MAXLOOPS VL))
(RETURN (for NEW P from MNLPS to MXLPS join (KLOOPEDRINGS
P VL])
(DAISIES
[LAMBDA (VL)
(for P
in (NUMPARTITIONS VL:1
(for X in VL::1 as I from 3 while X=0
finally (RETURN I/2)
do NIL)
1 99999999)
join (DAISY (CLCREATE P])
(NOLOOPEDRINGS
[LAMBDA (VL)
(if VL:1=0
then (CATALOG VL::1)
else (PROG (BP)
(BP←(BIVALENTPARTITIONS VL))
(RETURN (for S in (CATALOG VL::1)
join (for P in BP
join (ATTACHBIVALENTS (CLCREATE
P)
S])
(SINGLERINGS
[LAMBDA (N) <(SINGLERING N)>])
(KLOOPEDRINGS
[LAMBDA (P VL)
(if P=0
then NOLOOPEDRINGS VL
else (for LPSECTION in (LOOPPARTITIONS P VL) bind STRUCLIST
when (STRUCLIST←(NOFVRINGS (LOOPVL LPSECTION:1)))
join (for LOOPPART in LPSECTION
join (for STRUC in STRUCLIST
join (ATTACHBIVS&LOOPS (EDGELABELS
LOOPPART)
(LOOPLABELS
LOOPPART)
STRUC])
)
STOP