perm filename CL[1,LMM] blob sn#029050 filedate 1973-03-12 generic text, type T, neo UTF8
  (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "12-MAR-73 00:23:49")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE CLVARS)
              T)
  (RPAQQ CLVARS
         ((FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS 
               CLCREATE CLINSERT CL=PARTS CLBYVALENCE CLPARTITIONSL 
               CLEXPAND)
          (VARS)))
(DEFINEQ

(CLDIFF
  [LAMBDA (CL1 CL2)

          (* This function computes the DIFFERENCE of two 
          composition lists -
          Zero terms are eliminated)


    (FOR NEW PR IN CL1 AS NEW N IS (IDIFFERENCE (CDR PR)
                                                (LMASSOC (CAR PR)
                                                         CL2 0))
       WHEN (IGREATERP N 0)
            LIST
            (CONS (CAR PR)
                  N])

(CLCOUNT
  [LAMBDA (CL)                                  (* This function 
                                                computes the number of 
                                                elements IN a 
                                                composition list)
    (FOR NEW PR IN CL IPLUS (CDR PR])

(CLPARTS
  [LAMBDA (CL PARTSIZE)

          (* This function finds all SUB compositions of the 
          composition list cl1 which are of SIZE parsizze, and 
          returns a list of the possibilities -
          I.e. (CLPARTS ' ((A . 3) (B . 2)) 2) returns 
          (((a . 2)) , ((a . 1) (b . 1)), 
          ((b . 2))))


    (IF (ZEROP PARTSIZE)
        THEN (LIST NIL)
      ELSEIF (NULL (CDR CL))
        THEN (LIST (LIST (CONS (CAAR CL)
                               PARTSIZE)))
      ELSE (PROG (SIZE)
                 [SETQ SIZE (IDIFFERENCE PARTSIZE (CLCOUNT
                                           (CDR CL]
                 (RETURN (FOR NEW X :=((MAX SIZE 1)
                               (MIN PARTSIZE (CDAR CL))) FOR NEW PART
                            IN (CLPARTS (CDR CL)
                                        (DIFFERENCE PARTSIZE X))
                               XLIST FIRST
                               (IF (LESSP 0 SIZE)
                                   THEN NIL
                                 ELSE (CLPARTS (CDR CL)
                                               PARTSIZE))
                               (CONS (CONS (CAAR CL)
                                           X)
                                     PART])

(CLPARTITIONSN
  [LAMBDA (CL N MINPARTSIZE MAXPARTSIZE)

          (* This function finds all partitions of CL into N 
          parts WHERE each part has a CLCOUNT of at least 
          MINPARTSIZE and at most MAXPARTSIZE)


    (FOR NEW PARTSIZES IN (NUMPARTITIONS (CLCOUNT CL)
                                         N MINPARTSIZE MAXPARTSIZE)
                          NCONC
                          (CLPARTITIONS CL PARTSIZES])

(CLPARTITIONS
  [LAMBDA (CL PARTSIZES)

          (* PARTSIZES IS a list of numbers -
          This function finds all partitions of CL into PARTS 
          WHERE each PART IS of the corresponding SIZE IN 
          PARTSIZES -
          The sum of PARTSIZES must be equal to the CLCOUNT of 
          CL or ELSE the value will be NIL -
          The value IS a list of partitions;
          a partition IS a list of composition lists)


    (IF (NOT (CDR PARTSIZES))
        THEN (LIST (LIST CL))
      ELSEIF (ZEROP (CAR PARTSIZES))
        THEN [MAPCAR (CLPARTITIONS CL (CDR PARTSIZES))
                     (FUNCTION (LAMBDA (X)
                         (CONS NIL X]
      ELSEIF (EQUAL (CAR PARTSIZES)
                    (CADR PARTSIZES))
        THEN [PROG (N THISPART)
                   (SETQ N 1)
                   (SETQ THISPART (CAR PARTSIZES)
                     PARTSIZES)
                   (FOR PARTSIZES ON (CDR PARTSIZES)
                      WHILE (EQP (CAR PARTSIZES)
                                 THISPART) DO (SETQ N (ADD1 N)))
                   (IF (NOT PARTSIZES)
                       THEN (RETURN (CL=PARTS CL N THISPART)))
                   (RETURN (FOR NEW BIGPART
                              IN (CLPARTS CL (TIMES N THISPART))
                                 AS NEW RESTPARTSLIST IS
                                 (CLPARTITIONS (CLDIFF CL BIGPART)
                                               PARTSIZES) FOR NEW 
                                                        LITTLEPARTS
                              IN (CL=PARTS BIGPART N THISPART)
                              FOR NEW RESTPARTS
                              IN RESTPARTSLIST XLIST (APPEND 
                                                        LITTLEPARTS 
                                                          RESTPARTS]
      ELSE (FOR NEW PART IN (CLPARTS CL (CAR PARTSIZES)) FOR NEW PARTS
              IN (CLPARTITIONS (CLDIFF CL PART)
                               (CDR PARTSIZES))
                 XLIST
                 (CONS PART PARTS])

(CLCREATE
  [LAMBDA (L)

          (* This function takes a list which may have 
          duplicates, and returns a composition list which 
          corresponds to it -
          I.e. (CLCREATE ' (A A A B B C)) returns 
          ((a . 3) (b . 2) (C . 1)))


    (PROG (CL)
          (FOR NEW X IN L DO (SETQ CL (CLINSERT X CL)))
          (RETURN CL])

(CLINSERT
  [LAMBDA (ITEM CL)                             (* This function returns
                                                the composition list CL 
                                                with "ITEM" inserted)
    (IF (NOT CL)
        THEN (LIST (CONS ITEM 1))
      ELSEIF (EQUAL ITEM (CAAR CL))
        THEN (REPLACE (CDAR CL)
                      (ADD1 (CDAR CL)))
             CL
      ELSEIF (LEQ ITEM (CAAR CL))
        THEN (CONS (CONS ITEM 1)
                   CL)
      ELSE (REPLACE (CDR CL)
                    (CLINSERT ITEM (CDR CL])

(CL=PARTS
  [LAMBDA (CL NPARTS PARTSIZE)

          (* This function finds all partitions of CL into 
          NPARTS parts, where every part is of size PARTSIZE -
          NPARTS*PARTSIZE must be equal to the CLCOUNT of CL)


    (IF (ZEROP NPARTS)
        THEN (QUOTE (NIL))
      ELSEIF (NOT (CDR CL))
        THEN [SETQ CL (AND (NOT (ZEROP PARTSIZE))
                           (LIST (CONS (CAAR CL)
                                       PARTSIZE]
             (LIST (FOR NEW I :=(1 NPARTS)
                        XLIST CL))
      ELSE (FOR NEW X IN (NUMPARTITIONS (CDAR CL)
                                        NPARTS 0 PARTSIZE)
              FOR NEW Y
              IN (CLPARTITIONS (CDR CL)
                               (FOR NEW XX IN X LIST (DIFFERENCE 
                                                           PARTSIZE XX))
                               )
                 XLIST
                 (FOR NEW XX IN X AS NEW YY
                    IN Y LIST (IF (ZEROP XX)
                                  THEN YY
                                ELSE (CONS (CONS (CAAR CL)
                                                 XX)
                                           YY])

(CLBYVALENCE
  [LAMBDA (CL)
    (SETQ CL (GROUPBY [FUNCTION (LAMBDA (PR)
                          (VALENCE (CAR PR]
                      CL))

          (* CL must be a composition list of things with a 
          VALENCE -
          This function returns a list of composition lists;
          the first CL contains those things with VALENCE 2 -
          The second those with VALENCE 3, and so on)


    (FOR NEW I :=[2 (*MAX (MAPCAR CL (FUNCTION CAR]
         LIST
         (LMASSOC I CL NIL])

(CLPARTITIONSL
  [LAMBDA (CL LL)                               (* Damn if i can 
                                                remember what this one 
                                                does)
    (IF (NOT LL)
        THEN (LIST NIL)
      ELSE (FOR NEW FP IN (CLPARTS CL (*PLUS (CAR LL)))
                          AS NEW RPL IS (CLPARTITIONSL (CLDIFF CL FP)
                                                       (CDR LL))
              FOR NEW TP IN (CLPARTLP1 FP (CAR LL)
                                       1) FOR NEW RP
              IN RPL XLIST (CONS TP RP])

(CLEXPAND
  [LAMBDA (CL)

          (* This function is the inverse of CLCREATE -
          It takes a composition list and returns a list with 
          the appropriate number of copies of each item IN the 
          composition list -
          I.e. (CLEXPAND ' ((A . 3) (B . 2))) gives 
          (a a a b b))


    (FOR NEW X IN CL FOR NEW N :=(1 (CDR X))
                         LIST
                         (CAR X])
)
STOP