Programming challenge: wildcard exclusion in cartesian products

Geoffrey Summerhayes sumrnot at hotmail.com
Fri Mar 17 18:51:38 CET 2006

```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

```