# Programming challenge: wildcard exclusion in cartesian products

funkyj funkyj at gmail.com
Thu Mar 16 22:26:13 CET 2006

```here is my version of the same.

REPL output:

CL-USER> (tests)

set      = (1 2)
n        = 3
patterns = ((1 ANY 2))
-----------------------
(1 1 1)
(1 2 1)
(2 1 1)
(2 1 2)
(2 2 1)
(2 2 2)

set      = (A B)
n        = 3
patterns = ((A ANY B) (B ANY A))
-----------------------
(A A A)
(A B A)
(B A B)
(B B B)

set      = (1 2)
n        = 3
patterns = ((1 ANY 2) (2 ANY 1))
-----------------------
(1 1 1)
(1 2 1)
(2 1 2)
(2 2 2)
NIL
CL-USER>

source:

;;;; cartesian products minus wildcard patterns per:
;;;;
;;;; >Newsgroups: comp.lang.lisp, etc...
;;;; >Subject: Programming challenge: wildcard exclusion in cartesian
products
;;;; >Date: 16 Mar 2006 03:14:23 -0800
;;;;
;;;;

(defun show-me (x) (format t "~A~%" x))

(defun set^n (fn set n &optional acc)
"call `fn' on each permutation of `set' raised to the `n' power"
(if (<= n 0)
(funcall fn (reverse acc))
(dolist (e set)
(set^n fn set (- n 1) (cons e acc)))))

;; test set^n by printing and visually inspecting the result
(defun pr-set^n (set n)   (set^n #'show-me set n))

;; curry `set^n' so that `fn' is the only parameter
(defun set^n-gen (set n)
(lambda (fn) (set^n fn set n)))

(defun mk-matchl-p (pat-list)
"return a function that tests a value against the patterns in
`pat-list'"
(labels ((matchp (pat val)
(cond ((null pat) t)
((or (eq (car pat) (car val))
(eq (car pat) :any))
(matchp (cdr pat) (cdr val))))))
(lambda (val)
"predicate: return true if val matches any pattern in `pat-list'"
(dolist (p pat-list)
(if (matchp p val)
(return t))))))

(defun not-fp (f-pred)
"return the complement of predicate `f-pred'"
(lambda (x) (not (funcall f-pred x))))

;; f-gen is a generator of the form returned by set^n-gen
(defun accumulate-if (f-gen f-pred)
"accumulate values generated by f-gen that satisfy f-pred"
(let (acc)
(funcall f-gen (lambda (x) (if (funcall f-pred x) (push x acc))))
(nreverse acc)))

;; `pr-set^n-withoutWC' is the lisp equivalent (more or less) of
;; python code:
;;   >>> for i in cp.CPWithoutWC(x,y,z): print i
(defun pr-set^n-withoutWC (set n pat-list)
(format t "~%~%set      = ~A~%n        = ~A~%patterns = ~A~%~A~%"
set n pat-list "-----------------------")
(dolist (e (accumulate-if (set^n-gen set n)
(not-fp (mk-matchl-p pat-list))))
(format t "~A~%" e)))

(defun tests ()
"generate test output per the original problem examples"
(pr-set^n-withoutWC '(1 2) 3 '((1 :any 2)))
(pr-set^n-withoutWC '(a b) 3 '((a :any b) (b :any a)))
(pr-set^n-withoutWC '(1 2) 3 '((1 :any 2) (2 :any 1))))

```