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