From: Ken Tilton
Subject: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <lyBzg.17282$yN1.10174@fe12.lga>
Well, I got something good enough to let me get back to work since I 
doubt the ugliness of the solution below will matter in practice, but I 
found this a fun and confounding puzzle today. It seems like there 
should be a ten-liner that does not generate excess results to be weeded 
out later (my problem) but two serious tries failed and I do have a 
product to get out.

What we have are a list of steps, actions, ingredients -- however you 
want to think of it. Let's say we have five, and call them:

   '(a b c d e)

We are mixing them in different ways while searching for a solution. But 
we know that all should be included, so we are taking one at a time, 
then two at a time. But there are conflicts. In fact, every item has a 
conflict with at least one other item. And no experiment or "try" can 
include conflicting items.

If there were no conflicts, we would have one try in the branching 
search (tho in this case not branching):

  '(a b c d e)

We do not want to try subsets as separate tries because we know all are 
good and should be done, while respecting conflicts. These are generated
artificially by a hardcoded function identifying these pairs each as a 
conflict:

   '((b c)(a d)(d e))

The constraints are this:

(a) all items must appear in at least one try. If some item conflicts 
with everyone else, it becomes a one-item try.
(b) No tries should be a subset of any other try.
(c) Tries must include as many items as possible without conflict. Even 
if the above two conditions are satisfied, there could be some try T not 
including item I where no item in T conflicts with I. Bad try! Bad!

I tried a clever approach for quite a while before throwing up my hands 
and .... well, I won't give it away in case any budding Lispnik is 
looking for a challenge. Follow the bread crumbs below my sig to my 
solution.

ken


-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon

'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
' -------------here comes one solution ------------------------
'
'
'
'
'
'

#+test ;; eval the following to run my test
(remove-sub-paths
  (combinate-without-conflict '(a b c d e)))

;; correct result (I think) => ((B D) (C D) (A B E) (A C E))

(defun conflicts (x y &aux (query (list x y)))
   "Artificial conflict detector"
   (some (lambda (conflict)
           (null (set-difference query conflict)))
     '((b c)(a d)(d e)))) ;; some hardcoded conflicts

(defun combinate-without-conflict (items)
   (when items
     (destructuring-bind (item . remaining) items
       (loop with item-inserted
           for sc in (combinate-without-conflict remaining)
           collecting sc into result
           unless (find-if (lambda (c) (conflicts item c)) sc)
           collect (progn (setf item-inserted t)
                     (cons item sc)) into result
           finally (return (if item-inserted
                               result
                             (cons (list item) result)))))))

(defun remove-sub-paths (paths)
   "Select only paths not a subset of some other path"
   (loop for (path . longers) on paths
	;; works only because CWC happens to generate subsets first
         unless (find-if-not (lambda (longer)
                 	      (set-difference path longer))
                    longers)
         collect path))

From: Ken Tilton
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <5IBzg.17283$yN1.13372@fe12.lga>
Ken Tilton wrote:
> Well, I got something good enough to let me get back to work since I 
> doubt the ugliness of the solution below will matter in practice, but I 
> found this a fun and confounding puzzle today. It seems like there 
> should be a ten-liner that does not generate excess results to be weeded 
> out later (my problem) but two serious tries failed and I do have a 
> product to get out.
> 
> What we have are a list of steps, actions, ingredients -- however you 
> want to think of it. Let's say we have five, and call them:
> 
>   '(a b c d e)
> 
> We are mixing them in different ways while searching for a solution. But 
> we know that all should be included, so we are taking one at a time, 
> then two at a time. 

That should be "we are /not/ taking them one at a time, two at time."

> But there are conflicts. In fact, every item has a 
> conflict with at least one other item. And no experiment or "try" can 
> include conflicting items.
> 
> If there were no conflicts, we would have one try in the branching 
> search (tho in this case not branching):
> 
>  '(a b c d e)

Another example: if there were one conflict only, between d and e, we 
would make two tries:

   '(a b c d)
   '(a b c e)

> 
> We do not want to try subsets as separate tries because we know all are 
> good and should be done, while respecting conflicts. These are generated
> artificially by a hardcoded function identifying these pairs each as a 
> conflict:
> 
>   '((b c)(a d)(d e))

I meant "in my test example, conflicts are generated artificially....".

> 
> The constraints are this:
> 
> (a) all items must appear in at least one try. If some item conflicts 
> with everyone else, it becomes a one-item try.

How about "Each item must appear in at least one try".

kt

> (b) No tries should be a subset of any other try.
> (c) Tries must include as many items as possible without conflict. Even 
> if the above two conditions are satisfied, there could be some try T not 
> including item I where no item in T conflicts with I. Bad try! Bad!
> 
> I tried a clever approach for quite a while before throwing up my hands 
> and .... well, I won't give it away in case any budding Lispnik is 
> looking for a challenge. Follow the bread crumbs below my sig to my 
> solution.
> 
> ken
> 
> 

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: ············@gmail.com
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154426467.886549.162600@i42g2000cwa.googlegroups.com>
Ken Tilton wrote:
> Well, I got something good enough to let me get back to work since I
> doubt the ugliness of the solution below will matter in practice, but I
> found this a fun and confounding puzzle today.

It was fun indeed. Here's what I got (the procedure returns maximal
sets by construction, but they're not unique; the remove-duplicates
might not be good enough if you need the "canonical" form):

(compatible-subsets '(a b c d e) #'conflicts)
=> ((D B) (D C) (E B A) (E C A))

(defun compatible-subsets (list test)
  (remove-duplicates
   (loop for item in list
	 for non-conflicting = (remove-if (lambda (x) (funcall test x item))
list)
	 append (if non-conflicting
		    (mapcar (lambda (x) (cons item x))
			    (compatible-subsets non-conflicting test))
		    (list (list item ))))
   :test (lambda (x y) (and (subsetp x y) (subsetp y x)))))
From: ············@gmail.com
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154428012.564749.135780@m73g2000cwd.googlegroups.com>
I wrote:
> the procedure returns maximal
> sets by construction, but they're not unique; the remove-duplicates
> might not be good enough if you need the "canonical" form)

This version respects the original ordering in each subset:

(defun compatible-subsets (list test)
  (remove-if-not
   (lambda (x) (apply #'< (loop for element in x
				collect (position element list))))
   (loop for item in list
	 for non-conflicting = (remove-if (lambda (x) (funcall test x item))
list)
	 append (if non-conflicting
		    (mapcar (lambda (x) (cons item x))
			    (compatible-subsets non-conflicting test))
		    (list (list item ))))))
From: ············@gmail.com
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154428022.185303.56910@75g2000cwc.googlegroups.com>
I wrote:
> the procedure returns maximal
> sets by construction, but they're not unique; the remove-duplicates
> might not be good enough if you need the "canonical" form

This version respects the original ordering in each subset:

(defun compatible-subsets (list test)
  (remove-if-not
   (lambda (x) (apply #'< (loop for element in x
				collect (position element list))))
   (loop for item in list
	 for non-conflicting = (remove-if (lambda (x) (funcall test x item))
list)
	 append (if non-conflicting
		    (mapcar (lambda (x) (cons item x))
			    (compatible-subsets non-conflicting test))
		    (list (list item ))))))
From: Ken Tilton
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <p2Kzg.37855$UY2.12819@fe11.lga>
············@gmail.com wrote:
> I wrote:
> 
>>the procedure returns maximal
>>sets by construction, but they're not unique; the remove-duplicates
>>might not be good enough if you need the "canonical" form
> 
> 
> This version respects the original ordering in each subset:
> 
> (defun compatible-subsets (list test)
>   (remove-if-not
>    (lambda (x) (apply #'< (loop for element in x
> 				collect (position element list))))
>    (loop for item in list
> 	 for non-conflicting = (remove-if (lambda (x) (funcall test x item))
> list)
> 	 append (if non-conflicting
> 		    (mapcar (lambda (x) (cons item x))
> 			    (compatible-subsets non-conflicting test))
> 		    (list (list item ))))))
> 

Wow. Short! I have no idea how it works!! :) kt

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: Patrick Collison
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154441831.035949.305110@b28g2000cwb.googlegroups.com>
Ken Tilton wrote:
> Well, I got something good enough to let me get back to work since I
> doubt the ugliness of the solution below will matter in practice, but I
> found this a fun and confounding puzzle today. It seems like there
> should be a ten-liner that does not generate excess results to be weeded
> out later (my problem) but two serious tries failed and I do have a
> product to get out.

Here's another version (that still does fairly naive duplicate
removal): - http://paste.lisp.org/display/23477. (Apologies for not
pasting directly; I can't get Google Groups to not mangle code.)
From: Stefan Mandl
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at   bottom)
Date: 
Message-ID: <4j8li6F6rf4lU1@news.dfncis.de>
Hi, here is my try, don't know if it's dealing with all your constraints correctly, and
yes, it creates some excess in cross-sequences.

CL-USER> (heal '(a b c d e) '((d e)))
((A B C E) (A B C D))
CL-USER> (heal '(a b c d e) '((a c)(a d)(d e)))
((B C D) (B C E) (A B E))

...

regards,
Stefan

---

(defun cross-sequences (sequences)
   (cond ((null sequences) '())
  	((= (length sequences) 1) (mapcar #'list (first sequences)))
  	(t (apply #'append (loop :for item :in (first sequences)
  			      :collecting (mapcar #'(lambda (rseq)
  						      (cons item rseq))
  						  (cross-sequences (rest sequences))))))))

(defun removal-sets (conflicts)
   (let* ((cs (mapcar #'remove-duplicates (cross-sequences conflicts)))
	 (scs (sort cs #'(lambda (a b)
			   (> (length a) (length b)))))
	 (keep nil))
     (do* ((s scs (rest s))
	  (current (first s) (first s)))
	 ((null s) (reverse keep))
       (when (not (some
		  #'(lambda (other)
		      (subsetp other current))
		  (rest s)))
	(push current keep)))))

(defun heal (items conflicts)
   (let* ((rss (removal-sets conflicts))
	 (hs (mapcar #'(lambda (rs)  ; cannot use set-difference as it would disturb the order
		(loop :for i :in items
		   :when (not (member i rs))
		   :collect i))
		rss))
	 (lonelies nil))
     ;; add the lonely ones
     (dolist (i items)
       (when (not (some (lambda (s)
			 (member i s))
		       hs))
	(push (list i) lonelies)))
     (append lonelies hs)))
From: Ken Tilton
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at   bottom)
Date: 
Message-ID: <f%Jzg.37745$UY2.5491@fe11.lga>
Stefan Mandl wrote:
> Hi, here is my try,

Thx, interesting approach.

> don't know if it's dealing with all your constraints 
> correctly, and
> yes, it creates some excess in cross-sequences.

That seems to be unavoidable, though something tells me there must be 
/some/ way not to start with an excess and then trim. Oh, well.

> 
> CL-USER> (heal '(a b c d e) '((d e)))
> ((A B C E) (A B C D))
> CL-USER> (heal '(a b c d e) '((a c)(a d)(d e)))
> ((B C D) (B C E) (A B E))

In case others are wondering why the results here happen to be 
different, it is only because it uses a slightly different list of 
hard-coded conflicts: the first pair should be (b c) to match what I 
offered, and then Stefan's solution does produce the correct results.

kt


> 
> ...
> 
> regards,
> Stefan
> 
> ---
> 
> (defun cross-sequences (sequences)
>   (cond ((null sequences) '())
>      ((= (length sequences) 1) (mapcar #'list (first sequences)))
>      (t (apply #'append (loop :for item :in (first sequences)
>                    :collecting (mapcar #'(lambda (rseq)
>                                (cons item rseq))
>                            (cross-sequences (rest sequences))))))))
> 
> (defun removal-sets (conflicts)
>   (let* ((cs (mapcar #'remove-duplicates (cross-sequences conflicts)))
>      (scs (sort cs #'(lambda (a b)
>                (> (length a) (length b)))))
>      (keep nil))
>     (do* ((s scs (rest s))
>       (current (first s) (first s)))
>      ((null s) (reverse keep))
>       (when (not (some
>           #'(lambda (other)
>               (subsetp other current))
>           (rest s)))
>     (push current keep)))))
> 
> (defun heal (items conflicts)
>   (let* ((rss (removal-sets conflicts))
>      (hs (mapcar #'(lambda (rs)  ; cannot use set-difference as it would 
> disturb the order
>         (loop :for i :in items
>            :when (not (member i rs))
>            :collect i))
>         rss))
>      (lonelies nil))
>     ;; add the lonely ones
>     (dolist (i items)
>       (when (not (some (lambda (s)
>              (member i s))
>                hs))
>     (push (list i) lonelies)))
>     (append lonelies hs)))
> 

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: Mattias Nilsson
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154477482.024868.285020@i42g2000cwa.googlegroups.com>
Well, here's my naive newbie attempt, which should work if all the
conflicts are pairwise, and under your assumption that

> [...] every item has a conflict with at least one other item.


(defun conflicts (x y &aux (query (list x y)))
  "Artificial conflict detector"
  (some (lambda (conflict) (null (set-difference query conflict)))
        '((b c)(a d)(d e)))) ;; some hardcoded conflicts

(defun combine-without-conflicts (items)
  (good-tries (conflicts-list items)))

(defun conflicts-list (items &optional acc)
  (if (null (cdr items))
    acc
    (conflicts-list (cdr items)
                    (append
                      (mapcar #'(lambda (x) (cons (car items) `(,x)))
                              (remove (car items) (cdr items)
                                      :test-not #'conflicts))
                      acc))))

(defun good-tries (conflicts &optional (acc '(())))
  (if (null conflicts)
    acc
    (good-tries (cdr conflicts)
                (mapcan #'(lambda (x) (grow-try (car conflicts) x))
                        acc))))

(defun grow-try (pair try)
  (let* ((a (car pair))
         (b (cadr pair))
         (found-a (find a try))
         (found-b (find b try))
         (add-a (not (or found-a (find a try :test #'conflicts))))
         (add-b (not (or found-b (find b try :test #'conflicts)))))
    (cond
      ((and add-a add-b) (list (cons a try) (cons b try)))
      (add-a (if found-b
               (list try (cons a (remove b try)))
               (list (cons a try))))
      (add-b (if found-a
               (list try (cons b (remove a try)))
               (list (cons b try))))
      (t (list try)))))


Not very short, and maybe I missed the mark completely,
but there it is...

Mattias
From: Ken Tilton
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <oITzg.359$547.213@fe10.lga>
Mattias Nilsson wrote:
> Well, here's my naive newbie attempt, which should work if all the
> conflicts are pairwise, and under your assumption that
> 
> 
>>[...] every item has a conflict with at least one other item.
> 
> 
> 
> (defun conflicts (x y &aux (query (list x y)))
>   "Artificial conflict detector"
>   (some (lambda (conflict) (null (set-difference query conflict)))
>         '((b c)(a d)(d e)))) ;; some hardcoded conflicts
> 
> (defun combine-without-conflicts (items)
>   (good-tries (conflicts-list items)))
> 
> (defun conflicts-list (items &optional acc)
>   (if (null (cdr items))
>     acc
>     (conflicts-list (cdr items)
>                     (append
>                       (mapcar #'(lambda (x) (cons (car items) `(,x)))
>                               (remove (car items) (cdr items)
>                                       :test-not #'conflicts))
>                       acc))))
> 
> (defun good-tries (conflicts &optional (acc '(())))
>   (if (null conflicts)
>     acc
>     (good-tries (cdr conflicts)
>                 (mapcan #'(lambda (x) (grow-try (car conflicts) x))
>                         acc))))
> 
> (defun grow-try (pair try)
>   (let* ((a (car pair))
>          (b (cadr pair))
>          (found-a (find a try))
>          (found-b (find b try))
>          (add-a (not (or found-a (find a try :test #'conflicts))))
>          (add-b (not (or found-b (find b try :test #'conflicts)))))
>     (cond
>       ((and add-a add-b) (list (cons a try) (cons b try)))
>       (add-a (if found-b
>                (list try (cons a (remove b try)))
>                (list (cons a try))))
>       (add-b (if found-a
>                (list try (cons b (remove a try)))
>                (list (cons b try))))
>       (t (list try)))))
> 
> 
> Not very short, and maybe I missed the mark completely,
> but there it is...

I don't know, i cannot understand any of these solutions. :) But it 
works, which is nice. :)

kt

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: Mattias Nilsson
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154550309.926614.278490@m79g2000cwm.googlegroups.com>
Ken Tilton wrote:
> I don't know, i cannot understand any of these solutions. :) But it
> works, which is nice. :)

Actually, my "solution" doesn't work. The simple case where the
ingredients are '(a b c) and the conflicts are '((a b) (b c) (c a))
isn't handled correctly. So there's no point in trying to explain
my "method". :)

Ah, well...

Mattias
From: Ken Tilton
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <th8Ag.118$2d.56@fe08.lga>
Mattias Nilsson wrote:
> Ken Tilton wrote:
> 
>>I don't know, i cannot understand any of these solutions. :) But it
>>works, which is nice. :)
> 
> 
> Actually, my "solution" doesn't work. The simple case where the
> ingredients are '(a b c) and the conflicts are '((a b) (b c) (c a))
> isn't handled correctly.

I better go check mine. :)

kt

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: NR
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <44d59716$0$21302$5a62ac22@per-qv1-newsreader-01.iinet.net.au>
Here's some code that does what you want (I think) without any pruning 
of results. It's a bit longer than 10 lines though...

To use it, call, eg.
(get-sorted-ordered-try-lists '(a b c d e) '((a d) (d e) (b c)))

;; This just tests if two elements are compatible (ie. not in conflict)
(defun are-compat (x y conflict-list)
   (loop for conflict in conflict-list do
	(if (and (find x conflict)
		 (find y conflict))
	    (return nil))
	finally (return t)))

;; This gets the list of all elements that are compatible with the
;; element x. Not including x in the compatibility list is a fairly
;; arbitray choice (ie. easy to cons it on when needed anyway)
(defun get-compat-list (x full-list conflict-list)
   (remove nil
	  (loop for elt in full-list collecting
		(if (and (not (eql x elt))
			 (are-compat x elt conflict-list))
		    elt))))

;; This function turns the full list and conflict list into a hashtable
;; that maps each element to their compatibility list
(defun make-compat-hash (full-list conflict-list)
   (let ((the-hash (make-hash-table)))
     (loop for elt in full-list do
	  (setf (gethash elt the-hash) (get-compat-list elt full-list 
conflict-list)))
     the-hash))

;; This function gets the set of elements that need to be iterated
;; across at any depth. This will be the smallest subset of remaining
;; such that the union of all the elements of the attempt list and
;; all their compatabilities is equal to or a superset of remaining
(defun get-attempt-list (remaining compat-hash)
   (loop with unused-set = remaining
	until (null unused-set) collecting
	(let ((first-elt (first unused-set)))
	  (setf unused-set (set-difference
			    unused-set
			    (cons first-elt
				  (gethash first-elt compat-hash))))
	  first-elt)))

;; This function iterates across the elements needed to cover the
;; compatible elements and recurses down to build up the try
(defun get-try-list-r (curr-try compats compat-hash)
   (if (null compats) (list curr-try)
       (loop for elt in
	    (get-attempt-list compats compat-hash)
	    appending
	    (get-try-list-r (cons elt curr-try)
			    (intersection compats
					  (gethash elt compat-hash))
			    compat-hash))))

;; This just kicks off the recursive implementation
(defun get-try-list (full-list conflict-list)
   (get-try-list-r nil
		  full-list
		  (make-compat-hash full-list conflict-list)))

;;; These are just used to sort / order the returned lists. If
;;; that is unimportant then just use 'get-try-list', otherwise
;;; use 'get-sorted-ordered-try-lists'
(defun get-ordered-try-lists (full-list conflict-list)
   (loop for curr-list in (get-try-list full-list conflict-list) collecting
	(remove nil
		(loop for elt in full-list collecting
		      (if (find elt curr-list) elt)))))

(defun order-lists (sort-order)
   #'(lambda (x y)
       (loop for idx from 0 to (max (length x)
				   (length y))
	    do
	    (cond ((not (nth idx x)) (return t))
		  ((not (nth idx y)) (return nil))
		  ((< (position (nth idx x) sort-order)
		      (position (nth idx y) sort-order)) (return t))
		  ((> (position (nth idx x) sort-order)
		      (position (nth idx y) sort-order)) (return nil))))))

(defun get-sorted-ordered-try-lists (full-list conflict-list)
   (sort (get-ordered-try-lists full-list conflict-list)
	(order-lists full-list)))
From: Ken Tilton
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <HjpBg.442$Fs3.407@fe09.lga>
NR wrote:
> Here's some code that does what you want (I think) without any pruning 
> of results. 

Nice code. Would you say it works by over-generating and pruning 
internally, ie, in one of the inner loops where you repeatedly take the 
compat list and then the intersection with something else? ie, There 
really is no direct (whatever that means) recrusive solution?

 > It's a bit longer than 10 lines though...

Take out the comments! :)

I am getting a Fermat's Last Theorem feeling: the search for the 
marvellously simple proof ending with a 200-page tapping of every 
abstruse corner of modern mathematics.

This seems like it should be simple (hence the subject) but I guess not.

I feel a contest coming on to find the highest ratio of code hairyness 
to specification simplicity. Tho think to come of it, my spec did run on 
for a while. Hmmmm....

btw, this is for a new game of chess in which at each turn a player is 
allowed to make any positive number of moves legal from the initial 
position, except of course two pieces cannot land on the same square.

Not as subtle as the original, but lots of action, and the games do not 
drag on too long.

kenny

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon
From: Rob Thorpe
Subject: Re: There has to be a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <1154887073.988072.70460@i42g2000cwa.googlegroups.com>
Ken Tilton wrote:
> NR wrote:
> > Here's some code that does what you want (I think) without any pruning
> > of results.
>
> Nice code. Would you say it works by over-generating and pruning
> internally, ie, in one of the inner loops where you repeatedly take the
> compat list and then the intersection with something else? ie, There
> really is no direct (whatever that means) recrusive solution?
>
>  > It's a bit longer than 10 lines though...
>
> Take out the comments! :)
>
> I am getting a Fermat's Last Theorem feeling: the search for the
> marvellously simple proof ending with a 200-page tapping of every
> abstruse corner of modern mathematics.
>
> This seems like it should be simple (hence the subject) but I guess not.

Also, I can't help feeling that the code should check for the state
where no conflicts occur.  Since, if I read the spec correctly it
shouldn't happen.

There are probably other error states that need checking too.
From: NR
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <44d71eb1$0$21289$5a62ac22@per-qv1-newsreader-01.iinet.net.au>
Ken Tilton wrote:
> 
> 
> NR wrote:
>> Here's some code that does what you want (I think) without any pruning 
>> of results. 
> 
> Nice code. Would you say it works by over-generating and pruning 
> internally, ie, in one of the inner loops where you repeatedly take the 
> compat list and then the intersection with something else? ie, There 
> really is no direct (whatever that means) recrusive solution?
> 

I'd say it works by magic, but that probably wouldn't be that convincing.

If pressed, I'd say that get-attempt-list is the function that prunes 
the search space so that reorderings of a good try are not generated 
(rather than pruning the results). It does this pruning as aggressively 
as possible by getting a minimum set of elements such that all elements 
of remaining are either in, or compatible with, at least one element of 
the resulting attempt list.

So say you're considering the list (a b c d) which has the rules ((a b) 
(a c) (a d)). To generate all possible tries it only needs to branch in 
two directions - one looking at 'a', and one that looks at (to make an 
arbitrary choice) 'b'. All the possible try lists that started with 'c' 
or 'd' are not considered, as they are compatible with (and therefore 
will show up in the try lists generated by looking at) 'b'. To further 
muddy the water, say the list was (a b c d e) with the same rules, you 
still don't need to consider 'e' separately because it will show up 
under both 'a' and 'b'. If, in the second case, the arbitrary element 
choice had chosen 'e', then it would not need to branch at all since 
everything is compatible with e (and then you're back at example 1).

When get-try-list generates (intersection compats (gethash elt 
compat-list) that's the application of the conflict rules - if an 
element is in 'compats' but not in the compat-list of elt that has just 
been cons'd onto the try being built up, then it's in conflict with elt 
so can be discarded.

Direct sub-lists of a try being built are implicitly pruned as elements 
from compats are cons'd on in front of them (so, 'b' becomes 'b c' and 
is implicitly pruned, 'b c' becomes 'b c d', etc, etc.)

You can see the performance difference between pruning results and 
pruning the search space on, eg, the list
(a b c d e f g h i j k l m n o p)
with the conflicts
((a b) (a c) (a d) (a e) (a f) (a g) (a h) (a i) (a j) (a k) (a l) (a m) 
(a n) (a o) (a p))

>  > It's a bit longer than 10 lines though...
> 
> Take out the comments! :)
> 

Or I could take out the ugly code which is marring the comments :P

> I am getting a Fermat's Last Theorem feeling: the search for the 
> marvellously simple proof ending with a 200-page tapping of every 
> abstruse corner of modern mathematics.
> 
> This seems like it should be simple (hence the subject) but I guess not.
> 

I get the feeling I've seen this or something like it somewhere else 
before but I just can't place my finger on where. If it does exist then 
it's probably side-by-side with a simpler, better solution to the same 
problem.

> I feel a contest coming on to find the highest ratio of code hairyness 
> to specification simplicity. Tho think to come of it, my spec did run on 
> for a while. Hmmmm....
> 
> btw, this is for a new game of chess in which at each turn a player is 
> allowed to make any positive number of moves legal from the initial 
> position, except of course two pieces cannot land on the same square.
> 
> Not as subtle as the original, but lots of action, and the games do not 
> drag on too long.
> 

Sounds interesting.

> kenny
> 
From: Ken Tilton
Subject: Re: There has to be  a better way...(Lisp Puzzle, with one solution at bottom)
Date: 
Message-ID: <eMLBg.957$Fs3.103@fe09.lga>
NR wrote:
> ...  a minimum set of elements such that all elements
> of remaining are either in, or compatible with, at least one element of 
> the resulting attempt list.

Genius!

>> btw, this is for a new game of chess in which at each turn a player is 
>> allowed to make any positive number of moves legal from the initial 
>> position, except of course two pieces cannot land on the same square.
>>
>> Not as subtle as the original, but lots of action, and the games do 
>> not drag on too long.
>>
> 
> Sounds interesting.

I was kidding, but now I am starting to wonder... :)

kt

-- 
Cells: http://common-lisp.net/project/cells/

"I'll say I'm losing my grip, and it feels terrific."
    -- Smiling husband to scowling wife, New Yorker cartoon