(FILECREATED "29-OCT-73  6:54:32" S-GENLISP)


  (LISPXPRINT (QUOTE GENLISPVARS)
              T)
  (RPAQQ GENLISPVARS
         ((* VERY GENERAL PURPOSE ROUTINES
             (BUT NOT SYSTEM INTERFACE ROUTINES; I.E. DON'T DEPEND ON 
                  VAGARIES OF LISP FILE PACKAGE, FOR EXAMPLE))
          (FNS GROUPRADS GROUPRADS1 CIELING GROUPBY CARLIST CDRLIST 
               LCARLIST LCDRLIST DELETE DIFF ORDPAIR MAX MIN ORDERED 
               SUMOF LMASSOC INTERSECTP)))

(* VERY GENERAL PURPOSE ROUTINES (BUT NOT SYSTEM INTERFACE ROUTINES;
I.E. DON'T DEPEND ON VAGARIES OF LISP FILE PACKAGE, FOR EXAMPLE))

(DEFINEQ

(GROUPRADS
  [LAMBDA (CLOFLISTS)

          (* Takes a composition list of lists and returns all 
          the list of all possible selections;
          with one from each list; for example given 
          (((A B C) . 2) ((E F) . 3)) returns 
          (A A E E E) (A A E E F) (A A E F E) ...
          I.e. All lists with 2 elements from 
          (A B C) and three from (E F) 
          (duplication allowed))


    (COND
      ((NULL CLOFLISTS)
        (LIST NIL))
      (T (GROUPRADS1 (CAAR CLOFLISTS)
                     (CDAR CLOFLISTS)
                     (GROUPRADS (CDR CLOFLISTS])

(GROUPRADS1
  [LAMBDA (TAKELIST N LISTSDONE)
    (COND
      ((ZEROP N)
        LISTSDONE)
      (T (FOR OLD TAKELIST ON TAKELIST FOR RADS
            IN (GROUPRADS1 TAKELIST (SUB1 N)
                           LISTSDONE)
            COLLECT (CONS (CAR TAKELIST)
                          RADS])

(CIELING
  [LAMBDA (X)
    (FIX (PLUS X .99])

(GROUPBY
  [LAMBDA (FN L)

          (* FN is a function of one argument;
          L is a list; returns L grouped by the values of FN 
          applied to it; e.g. (GROUPBY 'VALENCE L) will return 
          ((2 %. Atoms with VALENCE 2) 
          (3 %. Atoms with VALENCE 3) ...))


    (COND
      ((NULL L)
        NIL)
      (T (PROG (FNX GROUPCDR X)
               (SETQ GROUPCDR (GROUPBY FN (CDR L)))
               (COND
                 ((NULL (SETQ X (LMASSOC (SETQ FNX (APPLY*
                                             FN
                                             (CAR L)))
                                         GROUPCDR NIL)))
                   (RETURN (CONS (LIST FNX (CAR L))
                                 GROUPCDR)))
                 (T (NCONC1 X (CAR L))
                    (RETURN GROUPCDR])

(CARLIST
  [LAMBDA (L)
    (FOR X IN L COLLECT (CAR X])

(CDRLIST
  [LAMBDA (L)
    (FOR X IN L COLLECT (CDR X])

(LCARLIST
  [LAMBDA (L)
    (FOR X IN L COLLECT (CARLIST X])

(LCDRLIST
  [LAMBDA (L)
    (FOR X IN L COLLECT (CDRLIST X])

(DELETE
  [LAMBDA (I L)
    (COND
      [(NULL L)
        (HELP (QUOTE (BAD ARG TO DELETE]
      ((EQ (CAR L)
           I)
        (CDR L))
      (T (RPLACD L (DELETE I (CDR L])

(DIFF
  [LAMBDA (L1 L2)
    (FOR X IN L1 WHEN (NOT (MEMBER X L2)) COLLECT X])

(ORDPAIR
  [LAMBDA (X1 X2)
    (COND
      ((ORDERED X1 X2)
        (CONS X1 X2))
      (T (CONS X2 X1])

(MAX
  [LAMBDA (X Y)
    (COND
      ((IGREATERP X Y)
        X)
      (T Y])

(MIN
  [LAMBDA (X Y)
    (COND
      ((IGREATERP X Y)
        Y)
      (T X])

(ORDERED
  [LAMBDA (X Y)
    (COND
      ((NLISTP X)
        (ALPHORDER X Y))
      ((NLISTP Y)
        NIL)
      ((EQUAL (CAR X)
              (CAR Y))
        (ORDERED (CDR X)
                 (CDR Y)))
      (T (ORDERED (CAR X)
                  (CAR Y])

(SUMOF
  [LAMBDA (L)
    (FOR X IN L SUM X])

(LMASSOC
  [LAMBDA (X Y Z)
    (COND
      ([SETQ X (COND
            ((OR (SMALLP X)
                 (LITATOM X))
              (ASSOC X Y))
            (T (SASSOC X Y]
        (CDR X))
      (T Z])

(INTERSECTP
  [LAMBDA (X Y)
    (OR (NULL X)
        (NULL Y)
        (COND
          [(LISTP X)
            (SOME X (FUNCTION (LAMBDA (X)
                      (INTERSECTP X Y]
          [(LISTP Y)
            (SOME Y (FUNCTION (LAMBDA (Y)
                      (INTERSECTP X Y]
          (T (EQ X Y])
)
STOP