(FILECREATED "27-OCT-73 23:22:34" S-CL)


  (LISPXPRINT (QUOTE CLVARS)
              T)
  (RPAQQ CLVARS
         ((* Composition list manipulation functions)
          (FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS 
               CLCREATE CLINSERT CLEQUALPARTS CLPARTITIONSL CLEXPAND)))

(* 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)
    (sum (CDR PR) for PR in CL])

(CLPARTS
  [LAMBDA (CL PARTSIZE)
    (COND
      ((ZEROP PARTSIZE)
        (LIST NIL))
      [(NULL (CDR CL))
        (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)
          [MAPC L (FUNCTION (LAMBDA (X)
                    (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 FP IN (CLPARTS CL (SUMOF (CAR LL)))
            AS RPL IS (CLPARTITIONSL (CLDIFF CL FP)
                                     (CDR LL))
              FOR TP
            IN (CLPARTLP1 FP (CAR LL)
                          1)
              FOR RP
            IN RPL XLIST (CONS TP RP])

(CLEXPAND
  [LAMBDA (CL)
    (FOR X IN CL FOR I FROM 1 TO (CDR X) COLLECT (CAR X])
)
STOP