[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: gen-permutation, solution



>(gen-permutation '(a a b b))
>
>I'm looking for:
>
>-> ((a a b b) (a b a b) (a b b a) (b a a b) (b a b a) (b b a a))
>
>permute-uniqe?

(DELETE-DUPLICATES (permute '(a a b b) :test #'equal)

The problem was that remove removes ALL elements. Solution is to
remove the first one, and then delete-duplicates. Now we'll get the 
following:

; gen-permutation

#|  
(gen-permutation '(a a b b))
--> ((a a b b) (a b a b) (a b b a) (b a a b) (b a b a) (b b a a))
|#

(defun gen-permutation (l)
  (delete-duplicates (gen-permutation-sup l) :test #'equal))

(defun gen-permutation-sup (list-to-permute)
  (if (null (cdr list-to-permute))
    (list list-to-permute)
    (mapcan
     #'(lambda (x)
         (map 'list #'(lambda (y) (cons x y))
              (gen-permutation-sup (remove-first x list-to-permute))))
     list-to-permute)))

(defun remove-first (item l)
  (let ((out nil) (removed nil))
    (dolist (x l)
      (if (or removed (not (equal x item)))
        (push x out)
        (setq removed t)))
    (nreverse out)))

Cheers,
Peter