(defun unique-pairs (set) (let ((pairs (pairs set)) (r)) (flet ((sieve (e l) (if (member e l :test #'equal) (remove e l :test #'equal) l))) (dolist (x pairs r) (dolist (y pairs) (unless (equal x y) ;; does x y cover the whole set? (let ((s (copy-list set))) (dolist (z (list (car x) (cadr x) (car y) (cadr y)) s) (setf s (sieve z s))) (when (null s) ;; x y is a legal pair, do we have it ;; already? (let ((xy (list x y)) (yx (list y x))) (unless (or (member xy r :test #'equal) (member yx r :test #'equal)) (push xy r))))))))) (nreverse r)))
CL-USER 5 > (pairs '(a b c d)) ((a b) (a c) (a d) (b c) (b d) (c d))
CL-USER 6 > (unique-pairs '(a b c d)) (((a b) (c d)) ((a c) (b d)) ((a d) (b c)))
If pairs is ugly, unique-pairs is really terrible :-( It stems from my still-non-lisp-thinking mode. - the two outer dolists make it run in n^2 - the third dolist is a hack, with embedded knowledge of the structure ((u v) (w x)) ie, it doesn't scale to triplets let alone tuples - this whole sieve construct, togetether with the copy-list just to prune duplicates - so is the final xy and yx to actually construct the result (and doesb't scale either). - I hate the setf at this point in the code
Can you read that I'm not happy? :-(
While I'm sure that loop/iterate can do wonders I'm looking more for a "functional" style. Any taker?
(defun pairs (set) "Returns a set of all the pairs in the given SET" (cond ((null set) '()) ; empty set has no pairs ((null (rest set)) '()) ; neither do singletons. ((null (rest (rest set))) (list set)) ; but pairs contain only one pair (t (append (mapcar (lambda (y) (list (first set) y)) (rest set)) (pairs (rest set)))))) ;; For an easy space optimization, we can replace append by nconc above.
(mapcar (function pairs) '(() (a) (a b) (a b c) (a b c d))) --> (NIL NIL ((A B)) ((A B) (A C) (B C)) ((A B) (A C) (A D) (B C) (B D) (C D)))
> (defun unique-pairs (set)
I'll provide a nicer version tomorrow ;-)
> Can you read that I'm not happy? :-(
If you could stipulate clearly in English what these functions should do, you could probably come with a clearer lisp version.
> While I'm sure that loop/iterate can do wonders I'm > looking more for a "functional" style. Any taker?
> (defun unique-pairs (set) > (let ((pairs (pairs set)) > (r)) > (flet ((sieve (e l) > (if (member e l :test #'equal) > (remove e l :test #'equal) > l))) > (dolist (x pairs r) > (dolist (y pairs) > (unless (equal x y) > ;; does x y cover the whole set? > (let ((s (copy-list set))) > (dolist (z (list (car x) (cadr x) > (car y) (cadr y)) s) > (setf s (sieve z s))) > (when (null s) > ;; x y is a legal pair, do we have it > ;; already? > (let ((xy (list x y)) > (yx (list y x))) > (unless (or > (member xy r :test #'equal) > (member yx r :test #'equal)) > (push xy r))))))))) > (nreverse r)))
> CL-USER 5 > (pairs '(a b c d)) > ((a b) (a c) (a d) (b c) (b d) (c d))
> CL-USER 6 > (unique-pairs '(a b c d)) > (((a b) (c d)) ((a c) (b d)) ((a d) (b c)))
> If pairs is ugly, unique-pairs is really terrible :-( > It stems from my still-non-lisp-thinking mode. > - the two outer dolists make it run in n^2 > - the third dolist is a hack, with embedded knowledge > of the structure ((u v) (w x)) ie, it doesn't scale > to triplets let alone tuples > - this whole sieve construct, togetether with the > copy-list just to prune duplicates > - so is the final xy and yx to actually construct > the result (and doesb't scale either). > - I hate the setf at this point in the code
> Can you read that I'm not happy? :-(
> While I'm sure that loop/iterate can do wonders I'm > looking more for a "functional" style. Any taker?
> Many Thanks > -- > JFB
It's not clear to me what unique-pairs is trying to do. For inputs other than 4-elements, it returns NIL.
> (defun unique-pairs (set) > (let ((pairs (pairs set)) > (r)) > (flet ((sieve (e l) > (if (member e l :test #'equal) > (remove e l :test #'equal) > l))) > (dolist (x pairs r) > (dolist (y pairs) > (unless (equal x y) > ;; does x y cover the whole set? > (let ((s (copy-list set))) > (dolist (z (list (car x) (cadr x) > (car y) (cadr y)) s) > (setf s (sieve z s))) > (when (null s) > ;; x y is a legal pair, do we have it > ;; already? > (let ((xy (list x y)) > (yx (list y x))) > (unless (or > (member xy r :test #'equal) > (member yx r :test #'equal)) > (push xy r))))))))) > (nreverse r)))
> CL-USER 6 > (unique-pairs '(a b c d)) > (((a b) (c d)) ((a c) (b d)) ((a d) (b c)))
Now I'm wondering what is unique-pairs supposed to do with five items? The code looks very hard to follow. I cannot see an extrapolatable pattern in the single example. I know, I'll run the code!
CL-USER> (unique-pairs '(a b c d e)) NIL
CL-USER> (unique-pairs '(a b c)) (((A B) (A C)) ((A B) (B C)) ((A C) (B C)))
CL-USER> (unique-pairs '(a b c d e f)) NIL
CL-USER> (unique-pairs '(a b)) NIL
Err, I give in. What is the idea behind unique-pairs? What is it trying to do? If you can tell me, that might also give you a clue as to how to tell your REPL.
On May 26, 9:44 pm, Gene <gene.ress...@gmail.com> wrote:
> On May 26, 5:42 pm, "John Thingstad" <jpth...@online.no> wrote:
> > På Mon, 26 May 2008 21:35:37 +0200, skrev Gene <gene.ress...@gmail.com>:
> > > It's not clear to me what unique-pairs is trying to do. For inputs > > > other than 4-elements, it returns NIL.
> > Seems to me we are talking abot combinations and permutations. > > Why restrict yourself to a pair?
> My guess is that he wants all possible exact covers by 2-sets.
;;; For example, CL-USER> (defun all-exact-covers-by-2-sets (set) "Return a list of exact covers by 2-sets of given set with even length." (cond ((oddp (length set)) (error "Set ~a does not have even length." set)) ((null set) (list nil)) ; The only exact cover has zero 2-sets. (t (mapcan (lambda (y) (let ((pair (list (car set) y))) (mapcar (lambda (z) (cons pair z)) (all-exact-covers-by-2-sets (remove y (cdr set)))))) (cdr set))))) ALL-EXACT-COVERS-BY-2-SETS CL-USER> (all-exact-covers-by-2-sets '(a b c d e f)) (((A B) (C D) (E F)) ((A B) (C E) (D F)) ((A B) (C F) (D E)) ((A C) (B D) (E F)) ((A C) (B E) (D F)) ((A C) (B F) (D E)) ((A D) (B C) (E F)) ((A D) (B E) (C F)) ((A D) (B F) (C E)) ((A E) (B C) (D F)) ((A E) (B D) (C F)) ((A E) (B F) (C D)) ((A F) (B C) (D E)) ((A F) (B D) (C E)) ((A F) (B E) (C D)))
> CL-USER> (pairs '(a b c d)) > ((A B) (A C) (A D) (B C) (B D) (C D))
> CL-USER> (pairs '(a b c d e)) > ((A B) (A C) (A D) (A E) (B C) (B D) (B E) (C D) (C E) (D E))
Wow! :)
[...]
> Now I'm wondering what is unique-pairs supposed to do with > five items?
Hmmm. Let's see if I can be better at English than I am at Lisp :)
Pairs is concerned with things that come two at a time, out of a bigger set. unique-pairs takes a collection of such pairs and returns the minimal collection such that every element of that collection is a set of pairs. Each such element must refer to an individual of the orginal set exactly once.
The math term must be something like "combination", except that I am more interested in getting the actual arrangements than counting them, I think it is pronounced "n chooses k". and written "C(n, k)"
In other words, I wamt the set of things chosen k at a times from a bigger set of n elements, where the order is non significant, and where each set of result tuples (pair, or triplet, or quadruplet, ...) contains each element of the original set exactly once.
... But I wasn't dreaming of getting to the general case in one go (ie: tuples) and started to get my feet wet with pairs to start with... -- JFB
> Hmmm. Let's see if I can be better at English than I am > at Lisp :)
> Pairs is concerned with things that come two at a time, > out of a bigger set. unique-pairs takes a collection of > such pairs and returns the minimal collection such that > every element of that collection is a set of pairs. Each > such element must refer to an individual of the orginal > set exactly once.
> The math term must be something like "combination", except > that I am more interested in getting the actual arrangements > than counting them, I think it is pronounced "n chooses k". > and written "C(n, k)"
> In other words, I wamt the set of things chosen k at a times > from a bigger set of n elements, where the order is non > significant, and where each set of result tuples (pair, > or triplet, or quadruplet, ...) contains each element > of the original set exactly once.
> ... But I wasn't dreaming of getting to the general case > in one go (ie: tuples) and started to get my feet wet > with pairs to start with... > -- > JFB
CL-USER> (tuple-cover '(a b c d e f) 2) (((A B) (F E) (C D)) ((A B) (F D) (C E)) ((A B) (F C) (D E)) ((A B) (E D) (C F)) ((A B) (E C) (D F)) ((A B) (D C) (E F)) ((A C) (F E) (B D)) ((A C) (F D) (B E)) ((A C) (F B) (D E)) ((A C) (E D) (B F)) ((A C) (E B) (D F)) ((A C) (D B) (E F)) ((A D) (F E) (B C)) ((A D) (F C) (B E)) ((A D) (F B) (C E)) ((A D) (E C) (B F)) ((A D) (E B) (C F)) ((A D) (C B) (E F)) ((A E) (F D) (B C)) ((A E) (F C) (B D)) ((A E) (F B) (C D)) ((A E) (D C) (B F)) ((A E) (D B) (C F)) ((A E) (C B) (D F)) ((A F) (E D) (B C)) ((A F) (E C) (B D)) ((A F) (E B) (C D)) ((A F) (D C) (B E)) ((A F) (D B) (C E)) ((A F) (C B) (D E)) ((B C) (F E) (A D)) ((B C) (F D) (A E)) ((B C) (F A) (D E)) ((B C) (E D) (A F)) ((B C) (E A) (D F)) ((B C) (D A) (E F)) ((B D) (F E) (A C)) ((B D) (F C) (A E)) ((B D) (F A) (C E)) ((B D) (E C) (A F)) ((B D) (E A) (C F)) ((B D) (C A) (E F)) ((B E) (F D) (A C)) ((B E) (F C) (A D)) ((B E) (F A) (C D)) ((B E) (D C) (A F)) ((B E) (D A) (C F)) ((B E) (C A) (D F)) ((B F) (E D) (A C)) ((B F) (E C) (A D)) ((B F) (E A) (C D)) ((B F) (D C) (A E)) ((B F) (D A) (C E)) ((B F) (C A) (D E)) ((C D) (F E) (A B)) ((C D) (F B) (A E)) ((C D) (F A) (B E)) ((C D) (E B) (A F)) ((C D) (E A) (B F)) ((C D) (B A) (E F)) ((C E) (F D) (A B)) ((C E) (F B) (A D)) ((C E) (F A) (B D)) ((C E) (D B) (A F)) ((C E) (D A) (B F)) ((C E) (B A) (D F)) ((C F) (E D) (A B)) ((C F) (E B) (A D)) ((C F) (E A) (B D)) ((C F) (D B) (A E)) ((C F) (D A) (B E)) ((C F) (B A) (D E)) ((D E) (F C) (A B)) ((D E) (F B) (A C)) ((D E) (F A) (B C)) ((D E) (C B) (A F)) ((D E) (C A) (B F)) ((D E) (B A) (C F)) ((D F) (E C) (A B)) ((D F) (E B) (A C)) ((D F) (E A) (B C)) ((D F) (C B) (A E)) ((D F) (C A) (B E)) ((D F) (B A) (C E)) ((E F) (D C) (A B)) ((E F) (D B) (A C)) ((E F) (D A) (B C)) ((E F) (C B) (A D)) ((E F) (C A) (B D)) ((E F) (B A) (C D)))
CL-USER> (tuple-cover '(a b c d e f) 3) (((A B C) (F E D)) ((A B D) (F E C)) ((A B E) (F D C)) ((A B F) (E D C)) ((A C D) (F E B)) ((A C E) (F D B)) ((A C F) (E D B)) ((A D E) (F C B)) ((A D F) (E C B)) ((A E F) (D C B)) ((B C D) (F E A)) ((B C E) (F D A)) ((B C F) (E D A)) ((B D E) (F C A)) ((B D F) (E C A)) ((B E F) (D C A)) ((C D E) (F B A)) ((C D F) (E B A)) ((C E F) (D B A)) ((D E F) (C B A)))
Looks like you've got yourself a tricky puzzle there.
> > Hmmm. Let's see if I can be better at English than I am > > at Lisp :)
> > Pairs is concerned with things that come two at a time, > > out of a bigger set. unique-pairs takes a collection of > > such pairs and returns the minimal collection such that > > every element of that collection is a set of pairs. Each > > such element must refer to an individual of the orginal > > set exactly once.
> > The math term must be something like "combination", except > > that I am more interested in getting the actual arrangements > > than counting them, I think it is pronounced "n chooses k". > > and written "C(n, k)"
> > In other words, I wamt the set of things chosen k at a times > > from a bigger set of n elements, where the order is non > > significant, and where each set of result tuples (pair, > > or triplet, or quadruplet, ...) contains each element > > of the original set exactly once.
> > ... But I wasn't dreaming of getting to the general case > > in one go (ie: tuples) and started to get my feet wet > > with pairs to start with... > > -- > > JFB
> Here is some code which gives a lot of duplicates
> CL-USER> (tuple-cover '(a b c d e f) 2) > (((A B) (F E) (C D)) ((A B) (F D) (C E)) ((A B) (F C) (D E))
[ output trimmed ]
> Looks like you've got yourself a tricky puzzle there.
Alan, this defcurry is quite beautiful. I'm hooked.
[But I wonder if it causes optimizers to miss opportunities because the generated closure is not obviously a constant at compile time...?]
To finish up what you started, you need only to declare a canonical representation for tuples and covers. Lexicographic order (based on the orginal list order) will work. Then note that to generate canonical reps, it is sufficient to _always_ choose the first thus-far- unchosen element to be the first of each tuple.
It's also necessary to define your own order-preserving (canonical) set-difference operator because the library function is liable to scramble things.
(defcurry prefix-by (head) (tail) (cons head tail))
(defun ordered-set-difference (a b) (cond ((null a) nil) ((null b) a) ((eq (first a) (first b)) (ordered-set-difference (rest a) (rest b))) (t (cons (first a) (ordered-set-difference (rest a) b)))))
CL-USER> (tuple-cover '(a b c d e f) 2) (((A B) (C D) (E F)) ((A B) (C E) (D F)) ((A B) (C F) (D E)) ((A C) (B D) (E F)) ((A C) (B E) (D F)) ((A C) (B F) (D E)) ((A D) (B C) (E F)) ((A D) (B E) (C F)) ((A D) (B F) (C E)) ((A E) (B C) (D F)) ((A E) (B D) (C F)) ((A E) (B F) (C D)) ((A F) (B C) (D E)) ((A F) (B D) (C E)) ((A F) (B E) (C D)))
CL-USER> (tuple-cover '(a b c d e f) 3) (((A B C) (D E F)) ((A B D) (C E F)) ((A B E) (C D F)) ((A B F) (C D E)) ((A C D) (B E F)) ((A C E) (B D F)) ((A C F) (B D E)) ((A D E) (B C F)) ((A D F) (B C E)) ((A E F) (B C D)))
> > > Hmmm. Let's see if I can be better at English than I am > > > at Lisp :)
> > > Pairs is concerned with things that come two at a time, > > > out of a bigger set. unique-pairs takes a collection of > > > such pairs and returns the minimal collection such that > > > every element of that collection is a set of pairs. Each > > > such element must refer to an individual of the orginal > > > set exactly once.
> > > The math term must be something like "combination", except > > > that I am more interested in getting the actual arrangements > > > than counting them, I think it is pronounced "n chooses k". > > > and written "C(n, k)"
> > > In other words, I wamt the set of things chosen k at a times > > > from a bigger set of n elements, where the order is non > > > significant, and where each set of result tuples (pair, > > > or triplet, or quadruplet, ...) contains each element > > > of the original set exactly once.
> > > ... But I wasn't dreaming of getting to the general case > > > in one go (ie: tuples) and started to get my feet wet > > > with pairs to start with... > > > -- > > > JFB
> > Here is some code which gives a lot of duplicates
> > CL-USER> (tuple-cover '(a b c d e f) 2) > > (((A B) (F E) (C D)) ((A B) (F D) (C E)) ((A B) (F C) (D E))
> [ output trimmed ]
> > Looks like you've got yourself a tricky puzzle there.
> Alan, this defcurry is quite beautiful. I'm hooked.
> [But I wonder if it causes optimizers to miss opportunities because > the generated closure is not obviously a constant at compile time...?]
> To finish up what you started, you need only to declare a canonical > representation for tuples and covers. Lexicographic order (based on > the orginal list order) will work. Then note that to generate > canonical reps, it is sufficient to _always_ choose the first thus-far- > unchosen element to be the first of each tuple.
> It's also necessary to define your own order-preserving (canonical) > set-difference operator because the library function is liable to > scramble things.
> (defcurry prefix-by (head) (tail) (cons head tail))
> (defun ordered-set-difference (a b) > (cond ((null a) nil) > ((null b) a) > ((eq (first a) (first b)) > (ordered-set-difference (rest a) (rest b))) > (t (cons (first a) > (ordered-set-difference (rest a) b)))))
> (defun pairs (set) > "Returns a set of all the pairs in the given SET" > (cond > ((null set) '()) ; empty set has no pairs > ((null (rest set)) '()) ; neither do singletons. > ((null (rest (rest set))) (list set)) ; but pairs contain only > one pair (t (append (mapcar (lambda (y) (list (first set) y)) > (rest set)) (pairs (rest set)))))) > ;; For an easy space optimization, we can replace append by nconc > above.
