Programming challenge: wildcard exclusion in cartesian products

[Wade Humeniuk]

wkehowski at cox.net wrote:
> 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.
> 

Another attempt.  I have made no special attempt to create an
exclusion language, just used an anonymous lambda predicate.


;; Wade Humeniuk

(defclass odometer ()
   ((base :initform 0 :accessor base)
    (meter :initform nil :accessor meter)
    (n-digits :initarg :n-digits :accessor n-digits)
    (digit-set :initarg :digit-set :accessor digit-set)))

(defmethod initialize-instance :after ((obj odometer) &rest initargs)
   (setf (base obj) (length (digit-set obj))
         (meter obj) (make-array (n-digits obj) :initial-element 0)
         (digit-set obj) (coerce (digit-set obj) 'vector)))

(defun inc-odometer (odometer)
   (loop with carry = 1
         for i from (1- (n-digits odometer)) downto 0
         for digit = (incf (aref (meter odometer) i) carry)
         if (= digit (base odometer)) do
           (setf (aref (meter odometer) i) 0)
           (setf carry 1)
         else do
           (setf carry 0)
         while (not (zerop carry))))

(defun zero-meter-p (odometer)
   (every #'zerop (meter odometer)))

(defmethod next-set ((obj odometer))
   (prog1 (map 'list (lambda (digit)
                       (aref (digit-set obj) digit))
               (meter obj))
     (inc-odometer obj)))

(defclass cs-with-wc (odometer)
   ((exclusion :initarg :exclusion :accessor exclusion)
    (at-end :initform nil :accessor at-end)))

(defmethod next-set ((obj odometer))
   (tagbody
    :next
    (unless (at-end obj)
      (let ((set (call-next-method)))
        (when (zero-meter-p obj) (setf (at-end obj) t))
        (if (not (funcall (exclusion obj) set))
            (return-from next-set set)
          (go :next))))))

(defun print-all-cs (set length exclusion)
   (let ((cs-with-wc (make-instance 'cs-with-wc :n-digits length :digit-set set
                                    :exclusion exclusion)))
     (loop for set = (next-set cs-with-wc)
           while set do (print set))))

CL-USER 134 > (cs-with-wc '(a b) 3 (lambda (set)
                                      (destructuring-bind (x y z)
                                          set
                                        (or (and (eql x 'a) (eql z 'b))
                                            (and (eql x 'b) (eql z 'a))))))

(A A A)
(A B A)
(B A B)
(B B B)
NIL

CL-USER 135 > (cs-with-wc '(a b) 3 (lambda (set)
                                      (eql (second set) 'a)))

(A B A)
(A B B)
(B B A)
(B B B)
NIL

CL-USER 136 > (cs-with-wc '(abc xyz) 3 (lambda (set)
                                          (and (eql (first set) 'abc)
                                               (eql (third set) 'xyz))))

(ABC ABC ABC)
(ABC XYZ ABC)
(XYZ ABC ABC)
(XYZ ABC XYZ)
(XYZ XYZ ABC)
(XYZ XYZ XYZ)
NIL