(FILECREATED "24-AUG-73 19:47:11" CL.CLISP)


  (LISPXPRINT (QUOTE CLVARS)
              T)
  (RPAQQ CLVARS
         ((FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS 
               CLCREATE CLINSERT CLEQUALPARTS CLBYVALENCE CLPARTITIONSL 
               CLEXPAND)))
(DEFINEQ

(CLDIFF
  [LAMBDA (CL1 CL2)
    (for PR in CL1 bind N when N←PR::1-(LMASSOC PR:1 CL2 0) GT 0
       collect <PR:1 ! N>])

(CLCOUNT
  [LAMBDA (CL)
    (for PR in CL bind VAL←0 finally (RETURN VAL) do VAL←VAL+PR::1])

(CLPARTS
  [LAMBDA (CL PARTSIZE)
    (if PARTSIZE=0
        then <NIL>
      elseif CL::1=NIL
        then <<<CL:1:1 ! PARTSIZE>>>
      else (PROG (SIZE MAXX RESULTS)
                 (SIZE←PARTSIZE-(CLCOUNT CL::1))
                 (MAXX←(MIN PARTSIZE CL:1::1))
                 (if SIZE LT 0
                     then (RESULTS←(CLPARTS CL::1 PARTSIZE)))
                 (for X from (MAX SIZE 1) to MAXX
                    do (for PART in (CLPARTS CL::1 PARTSIZE-X)
                          do RESULTS←
                             <<<CL:1:1 ! X> ! PART> ! RESULTS>))
                 (RETURN RESULTS])

(CLPARTITIONSN
  [LAMBDA (CL N MINPARTSIZE MAXPARTSIZE)
    (for PARTSIZES in (NUMPARTITIONS (CLCOUNT CL)
                                     N MINPARTSIZE MAXPARTSIZE)
       join (CLPARTITIONS CL PARTSIZES])

(CLPARTITIONS
  [LAMBDA (CL PARTSIZES)
    (if PARTSIZES::1=NIL
        then <<CL>>
      elseif PARTSIZES:1=0
        then (for X in (CLPARTITIONS CL PARTSIZES::1)
                collect <NIL ! X>)
      elseif PARTSIZES:1=PARTSIZES:2
        then (PROG (N THISPART RESTPARTSLIST RESULTS)
                   (N←1)
                   (THISPART←PARTSIZES:1)
                   (for X in old PARTSIZES←PARTSIZES::1 while 
                                                         X=THISPART
                      do N←N+1)
                   (if (PARTSIZES=NIL)
                       then (RETURN (CLEQUALPARTS CL N THISPART)))
                   (for BIGPART in (CLPARTS CL N*THISPART)
                      do RESTPARTSLIST←(CLPARTITIONS (CLDIFF CL BIGPART)
                                                     PARTSIZES)
                         (for LITTLEPARTS in (CLEQUALPARTS BIGPART N 
                                                           THISPART)
                            do (for RESTPARTS in RESTPARTSLIST
                                  do RESULTS←
                                     <<! LITTLEPARTS ! RESTPARTS> ! 
                                         RESULTS>)))
                   (RETURN RESULTS))
      else (for PART in (CLPARTS CL PARTSIZES:1)
              join (for PARTS in (CLPARTITIONS (CLDIFF CL PART)
                                               PARTSIZES::1)
                      collect <PART ! PARTS>])

(CLCREATE
  [LAMBDA (L)
    (PROG (CL)
          (for X in L do CL←(CLINSERT X CL))
          (RETURN CL])

(CLINSERT
  [LAMBDA (ITEM CL)
    (if CL=NIL
        then <<ITEM ! 1>>
      elseif ITEM EQUALS CL:1:1
        then (CL:1::1←CL:1::1+1) CL
      elseif (ALPHLEQ ITEM CL:1:1)
        then <<ITEM ! 1> ! CL>
      else (CL::1←(CLINSERT ITEM CL::1])

(CLEQUALPARTS
  [LAMBDA (CL NPARTS PARTSIZE)
    (if NPARTS=0
        then '(NIL)
      elseif CL::1=NIL
        then CL←(PARTSIZE}=0 and <<CL:1:1 ! PARTSIZE>>)
             <(for I from 1 to NPARTS collect CL)>
      else (for X in (NUMPARTITIONS CL:1::1 NPARTS 0 PARTSIZE)
              join (for Y
                      in (CLPARTITIONS CL::1
                                       (for XX in X collect PARTSIZE-XX)
                                       )
                      collect (for XX in X as YY in Y
                                 collect (if XX=0
                                             then YY
                                           else
                                            <<CL:1:1 ! XX> ! YY>])

(CLBYVALENCE
  [LAMBDA (CL)
    CL←(GROUPBY (FUNCTION [LAMBDA (PR)
                    (VALENCE PR:1])
                CL)
    (PROG ((MAXI -999))
          (for X in CL when X:1 GT MAXI do MAXI←X:1)
          (for I from 2 to MAXI collect (LMASSOC I CL NIL])

(CLPARTITIONSL
  [LAMBDA (CL LL)
    (if LL=NIL
        then <NIL>
      else (for FP in (CLPARTS CL (SUM LL:1)) bind RPL RESULTS
              finally (RETURN RESULTS)
              do (RPL←(CLPARTITIONSL (CLDIFF CL FP)
                                     LL::1))
                 (for TP in (CLPARTLP1 FP LL:1 1)
                    do (for RP in RPL
                          do RESULTS ← < <TP ! RP> ! RESULTS>])

(CLEXPAND
  [LAMBDA (CL)
    (for X in CL bind RESULTS finally (RETURN RESULTS)
       do (for N from 1 to X::1 collect X:1])
)
STOP