People Arrested For Dancing

Our government shows no shame that they are turning into SS- or Taliban-like thugs, by assaulting, battering, and arresting people for -- get this -- DANCING at the Jefferson Memorial. The most brutal treatment captured on the video was that of an officer body-slamming a distinguished Marine veteran of Iraq. This is how they treat vets on Memorial weekend! (BTW, the Marine is going to go back and dance again; semper fi!)

http://www.youtube.com/watch?v=6UyiaR1PDhQ

Nom de boucanier

Following my friend's (aka Dirty John Rackham's) lead, I took the Pirate Quiz, and here is my piratical name:

My pirate name is:

Red Jack Cash

Passion is a big part of your life, which makes sense for a pirate. You're musical, and you've got a certain style if not flair. You'll do just fine. Arr!

Get your own pirate name from piratequiz.com.
part of the fidius.org network

Permutations of a Multiset

A little over a year ago, my friend John Warren and I developed an algorithm which computes the k-permutations of a multiset (k is at most the size of the multiset). John does not program in Lisp, but I do and the algorithm can be clearly and concisely expressed in Lisp. Here it is:

(defun make-k-permutations (k multiset)
 (let ((pivots (remove-duplicates multiset)))
   (if (= k 1)
       (mapcar #'list pivots)
     (let ((acc '()))
       (dolist (p pivots acc)
         (let ((sub-multiset (remove p multiset :count 1)))
           (dolist (sub-perm
                    (make-k-permutations (1- k) sub-multiset))
             (push (cons p sub-perm) acc))))))))

How this works is you first make a list of pivots which are just the unique entries in the given multiset. For each pivot p, remove p from the original multiset, yielding a multiset like the original except minus one occurrence of p. Then recursively, compute the (k-1)-permutations of this new multiset. Now, cons the pivot p onto each of these (k-1)-permutations, accumulating them in acc. After you do this for every pivot p, you have the answer!

Here it is in action:

> (setq M1 '(93 4 42 93 5 7 8 10 8 8 10 42 4))
(93 4 42 93 5 7 8 10 8 8 10 42 4)
> (make-k-permutations 2 M1)
((4 4) (4 42) (4 10) (4 8) (4 7) (4 5) (4 93) (42 4) (42 42)
(42 10) (42 8) (42 7) (42 5) (42 93) (10 4) (10 42) (10 10)
(10 8) (10 7) (10 5) (10 93) (8 4) (8 42) (8 10) (8 8) (8 7)
(8 5) (8 93) (7 4) (7 42) (7 10) (7 8) (7 5) (7 93) (5 4) (5 42)
(5 10) (5 8) (5 7) (5 93) (93 4) (93 42) (93 10) (93 8) (93 7)
(93 5) (93 93))

Here’s a version of the same function in newlisp (followed by the necessary helper function remove1).

(define (make-k-permutations k multiset)
 (let ((pivots (unique multiset)))
   (if (= k 1)
       (map list pivots)
     (let ((acc '()))
       (dolist (p pivots)
         (let ((sub-multiset (remove1 p multiset)))
           (dolist (sub-perm
                    (make-k-permutations (- k 1) sub-multiset))
             (push (cons p sub-perm) acc))))
       acc))))

(define (remove1 elt lst)
 (let ((elt-pos (find elt lst)))
   (if elt-pos (pop lst elt-pos))
   lst))