Programming challenge: wildcard exclusion in cartesian products

[Wade Humeniuk]

Without much testing.  Common Lisp

Pattern exclusions are made lispy.


(defun all-lists (list length)
   (unless (zerop length)
     (if (= length 1) (mapcar #'list list)
       (loop for elt in list
             nconc
             (mapcar (lambda (rest)
                       (cons elt rest))
                     (loop for rest on list
                           nconc (all-lists rest (1- length))))))))

(defun cp-without-wc (source-list &rest patterns)
   (let* ((length (length (first patterns)))
          (all-lists (all-lists source-list length)))
     (dolist (pattern patterns)
       (setf all-lists
             (set-difference all-lists
                             (mapcar (lambda (insertion)
                                       (let ((cp (copy-list pattern)))
                                         (loop for place on cp
                                               when (eql :any (car place)) do
                                               (setf (car place) (pop insertion)))
                                         cp))
                                     (all-lists source-list (count :any pattern)))
                             :test #'equal)))
     (remove-duplicates all-lists :test #'equal)))

CL-USER 22 > (cp-without-wc '(a b) '(a :any b) '(b :any a))
((A A A) (A B A) (B A B) (B B B))

CL-USER 23 > (cp-without-wc '(abc xyz) '(abc :any xyz))
((XYZ XYZ XYZ) (XYZ XYZ ABC) (XYZ ABC XYZ) (XYZ ABC ABC) (ABC XYZ ABC) (ABC ABC ABC))

CL-USER 24 > (cp-without-wc '(a b) '(a :any :any))
((B B B) (B B A) (B A B) (B A A))

CL-USER 25 > (cp-without-wc '(a b) '(a :any :any) '(b :any :any))
NIL

CL-USER 26 > (cp-without-wc '(a b) '(:any :any b))
((B B A) (B A A) (A B A) (A A A))

CL-USER 27 >

Wade