Programming challenge: wildcard exclusion in cartesian products

[Alan Crowe]

"wkehowski at cox.net" <wkehowski at cox.net> writes:

> What I have in mind is the efficient, <enumerated> generation of the
> complement S^n/WC(S^n). A good program should initialize, generate, and
> terminate.
> 
> T=cartprodex(S,n,WC); //initialize
> for all i in T do
>   what you want with i
>   test to see if any more
>   terminate if not
> 
> and it should do this without explicitly generating WC and then
> complementing. For example, if the cardinality of S is m, and the WC is
> just '*a*b*', with a != b, then EX(S^n):=S^n\WC(S^n) has cardinality
> (m-1)^(n-1)*(m+n-1). Specifically, if m=5 and n=10, then |EX|=3670016
> while |S^10|=9765625, so that |EX|/|S^10| is about 0.3758. In general
> the program should directly generate EX from arbitrary WC. Of course,
> in practice the WC should themselves occur in a logically consistent
> manner, but let's just assume they're a given.

The following code doesn't build a data structure. It
recurses n deep and those n stack frames contain state that
tracks progress through the product. But it still generates
and tests, taking time proportional to S^n. Is this what you
had in mind?

;; A macro to let you loop over the S^n possibilities
;; without building a big data structure
;; The macro is structured as syntactic sugar on
;; a higher order function
;;
(defmacro cartesian-power ((variable set exponent) &body code)
  (let ((body-function (gensym)))
    `(flet ((,body-function(,variable), at code))
      (cartesian-power-hof ,set ,exponent '() (function ,body-function)))))

;; The standard idea of using recursion to implement a nest
;; of loops of indefinite depth
;;
(defun cartesian-power-hof (set exponent prefix f)
  (if (zerop exponent)
      (funcall f prefix)
      (dolist (item set)
        (cartesian-power-hof set
                             (- exponent 1)
                             (cons item prefix)
                             f))))

;; A simple recursive pattern match
;; I haven't thought through the implications
;; I guess that it is exponentially slow on some long
;; patterns
;;
(defun wild-match (pattern data)
  (cond ((endp pattern) (endp data))
        ((endp data) (or (endp pattern)
                         (equal pattern '(:wild))))
        ((eql (car pattern) :wild)
         (or (null (cdr pattern))
             (wild-match (cdr pattern)
                         data)
             (wild-match pattern
                         (cdr data))))
        ('literal-pattern
         (and (eql (car pattern)
                   (car data))
              (wild-match (cdr pattern)
                          (cdr data))))))

;; close over a data item to get a function 
;; suitable for checking several patterns
(defun match-data (data)
  (lambda(pattern)
    (wild-match pattern data)))

;; Use the macro and the utilities to count how many are not excluded
(defun count-remainder (set exponent &rest exclusions)
  (let ((count 0))
    (cartesian-power (item set exponent)
      (when (notany (match-data item) exclusions)
        (incf count)))
    count))

CL-USER> (loop for i from 3 to 10 
               do (format t "~&~4D~10D" i
                          (count-remainder '(a b c d e) i '(:wild a :wild b :wild))))
   3       112
   4       512
   5      2304
   6     10240
   7     45056
   8    196608
   9    851968
  10   3670016

I can see how a pattern such as (a b :wild) would knock out
an element from each of the first two sets so reducing the
task from m^n to (m-1)^2 * m^(n-2). 

Also (:wild a :wild) knocks it down from m^n to (m-1)^n

However I can only see the exploitation of (:wild a :wild b
:wild) as a hairy special case. Pick one of n places for the
first a. Pick earlier elements from the set excluding a,
pick later elements from the set excluding b. Add in all the
items with a missing altogether (so b can be used freely).
I cannot see what algorithm exploits the constraints more
generally. Is there a standard technique, page nn of Knuth
or the like? Is that what you are actually wanting to see
coded?

Alan Crowe
Edinburgh
Scotland