(FILECREATED "11-NOV-73 09:03:09" S-CL

     changes to:  CLPARTITIONSL

     previous date: " 7-NOV-73  6:03:36")


  (LISPXPRINT (QUOTE CLVARS)
              T)
  [RPAQQ CLVARS
         ((* Composition list manipulation functions)
          (FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS 
               CLCREATE CLINSERT CLEQUALPARTS CLPARTITIONSL CLEXPAND)
          (BLOCKS (NIL CLPARTS CLCREATE CLINSERT (LINKFNS . T]

(* Composition list manipulation functions)

(DEFINEQ

(CLDIFF
  [LAMBDA (CL1 CL2)
    (FOR PR IN CL1
       AS N IS (IDIFFERENCE (CDR PR)
                            (OR [CDR (COND
                                       ((LISTP (CAR PR))
                                         (SASSOC (CAR PR)
                                                 CL2))
                                       (T (ASSOC (CAR PR)
                                                 CL2]
                                0))
       WHEN (IGREATERP N 0)
       COLLECT (CONS (CAR PR)
                     N])

(CLCOUNT
  [LAMBDA (CL)
    (for PR in CL sum (CDR PR])

(CLPARTS
  [LAMBDA (CL PARTSIZE)
    (COND
      ((ZEROP PARTSIZE)
        (LIST NIL))
      [(NULL (CDR CL))
        (COND
          ((EQ PARTSIZE (CDAR CL))
            (LIST CL))
          (T (LIST (LIST (CONS (CAAR CL)
                               PARTSIZE]
      (T (FOR X FROM (MAX (IDIFFERENCE PARTSIZE (CLCOUNT (CDR CL)))
                          1)
            TO (MIN PARTSIZE (CDAR CL)) FOR PART
            IN (CLPARTS (CDR CL)
                        (IDIFFERENCE PARTSIZE X))
            COLLECT
            FIRST (AND (NOT (ILESSP 0 PARTSIZE))
                       (CLPARTS (CDR CL)
                                PARTSIZE))
                  (CONS (CONS (CAAR CL)
                              X)
                        PART])

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

(CLPARTITIONS
  [LAMBDA (CL PARTSIZES)
    (COND
      ((NULL (CDR PARTSIZES))
        (LIST (LIST CL)))
      ((ZEROP (CAR PARTSIZES))
        (for X in (CLPARTITIONS CL (CDR PARTSIZES))
           collect (CONS NIL X)))
      [(EQ (CAR PARTSIZES)
           (CADR PARTSIZES))
        (PROG (N THISPART)
              (SETQ N 1)
              (SETQ THISPART (CAR PARTSIZES))
              (while (AND (SETQ PARTSIZES (CDR PARTSIZES))
                          (EQ (CAR PARTSIZES)
                              THISPART))
                 do (SETQ N (ADD1 N)))
              [COND
                ((NULL PARTSIZES)
                  (RETURN (CLEQUALPARTS CL N THISPART]
              (RETURN (FOR BIGPART IN (CLPARTS CL (ITIMES N THISPART))
                         AS RESTPARTSLIST IS (CLPARTITIONS
                              (CLDIFF CL BIGPART)
                              PARTSIZES)
                           FOR LITTLEPARTS
                         IN (CLEQUALPARTS BIGPART N THISPART)
                           FOR RESTPARTS
                         IN RESTPARTSLIST XLIST (APPEND LITTLEPARTS 
                                                        RESTPARTS]
      (T (FOR PART IN (CLPARTS CL (CAR PARTSIZES)) FOR PARTS
            IN (CLPARTITIONS (CLDIFF CL PART)
                             (CDR PARTSIZES))
               XLIST
               (CONS PART PARTS])

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

(CLINSERT
  [LAMBDA (ITEM CL)
    (COND
      ((NULL CL)
        (LIST (CONS ITEM 1)))
      ((EQUAL ITEM (CAAR CL))
        (RPLACD (CAR CL)
                (ADD1 (CDAR CL)))
        CL)
      ((ORDERED ITEM (CAAR CL))
        (CONS (CONS ITEM 1)
              CL))
      (T (RPLACD CL (CLINSERT ITEM (CDR CL])

(CLEQUALPARTS
  [LAMBDA (CL NPARTS PARTSIZE)
    (COND
      ((ZEROP NPARTS)
        (QUOTE (NIL)))
      ((NULL (CDR CL))
        (SETQ CL (COND
            ((NOT (ZEROP PARTSIZE))
              (LIST (CONS (CAAR CL)
                          PARTSIZE)))
            (T NIL)))
        (LIST (to NPARTS collect CL)))
      (T (FOR X IN (NUMPARTITIONS (CDAR CL)
                                  NPARTS 0 PARTSIZE)
                  FOR Y
            IN (CLPARTITIONS (CDR CL)
                             (FOR XX IN X COLLECT (IDIFFERENCE PARTSIZE 
                                                               XX)))
            COLLECT (FOR XX IN X AS YY IN Y
                       COLLECT (COND
                                 ((ZEROP XX)
                                   YY)
                                 (T (CONS (CONS (CAAR CL)
                                                XX)
                                          YY])

(CLPARTITIONSL
  [LAMBDA (CL LL)
    (COND
      ((NULL LL)
        (LIST NIL))
      (T (FOR FIRSTPART IN (CLPARTS CL (TD (CAR LL)
                                           1))
            AS RESTPARTLIST IS (CLPARTITIONSL (CLDIFF CL FIRSTPART)
                                              (CDR LL))
              FOR THISPART
            IN (CLPARTLP1 FIRSTPART (CAR LL)
                          1)
              FOR RP
            IN RESTPARTLIST XLIST (CONS THISPART RP])

(CLEXPAND
  [LAMBDA (CL)
    (FOR X IN CL FOR I FROM 1 TO (CDR X) COLLECT (CAR X])
)
(DECLARE
  (BLOCK: NIL CLPARTS CLCREATE CLINSERT (LINKFNS . T))
)STOP