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))))
--
http://mail.python.org/mailman/listinfo/python-list
