Programming challenge: wildcard exclusion in cartesian products

[Geoffrey Summerhayes]

Wade Humeniuk wrote:
> 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.
>

FWIW, here's my Q-and-D pattern matcher (only partially tested).

(defun match(list pattern &optional (test #'eql))
  "Match a list of atoms against a pattern list
using :all as a 0-to-many wildcard, :single as a
1-to-1 wildcard, a list of elements or a single
element to match a specific place. Optional
argument test for comparing elements (default eql).

Returns: T if match is made, NIL otherwise.

Examples: (match '(0 1 2 3 4 5) '(:all (2 3) 3 :single 5 :all)) => T
          (match '(0 1 2 3 4 5) '(:all (2 3) 3 :single 5 :single)) =>
NIL"
  (let ((current (first pattern))
        (next-pattern (rest pattern))
        (candidate (first list)))
    (cond ((and (null pattern) (null list))
           t)
          ((and (eq :single current) candidate)
           (match (rest list) next-pattern test))
          ((eq :all current)
           (loop for new-list on list
                 when (match new-list next-pattern test)
                 do (return-from match t))
           (null next-pattern)) ; last case null remainder
          ((if(atom current)
               (funcall test candidate current)
             (member candidate current :test test))
           (match (rest list) next-pattern test)))))

--
Geoff