;;[SNIP: he wants all legal partial tic-tac-toe games,
;;each represented as a list of two lists: X's moves
;;and O's -- er, Y's -- moves.]
;;Try this.
(defun enumerate (p n used result)
"The first N elements of the vector P contain distinct
numbers from 1 to 9. USED is an integer in which bits
1..9 indicate which digits have been used (1 for used,
0 for unused).
Push onto RESULT a representation of every partial game
beginning with those moves in 'shuffled order' -- where
Y's moves come first, then X's. Return RESULT at the end.
On exit from this function, the first N elements of P
are unchanged. Later elements of P may have been changed."
(push (translate p n) result)
(when (< n 9)
(loop for next from 1 to 9
for bit = 2 then (ash bit 1) do
(when (zerop (logand used bit))
(setf (aref p n) next)
(setf result (enumerate p (1+ n) (logior used bit) result)))))
result)
(defun translate (p n)
"The first N elements of the vector P contain distinct
integers from 1 to 9. Return a list of two lists,
the first containing the first (FLOOR N 2) elements
and the second containing the rest."
(let ((x nil) (y nil))
(loop for i from 0 below n do
(if (oddp i)
(push (aref p i) y)
(push (aref p i) x)))
(list x y)))
(defun enumerate-all-moves ()
"Enumerate everything, from the starting position onwards."
(enumerate (make-array 9) 0 0 nil))
;;On my box (1GHz Athlon, FreeBSD, CMU CL 18d) this takes about
;;10 seconds, about half of which is GC and most of the rest of
;;which is in TRANSLATE. The final result occupies several tens
;;of megabytes, so the GC overhead isn't very surprising. I bet
;;ACL does better; its GC is quite good.
;; ----------------------------------------------------------------------
;;From: Gareth.McCaughan@pobox.com (Gareth McCaughan)
;;Reply-To: Gareth.McCaughan@pobox.com
;;Newsgroups: comp.lang.lisp
;;Subject: Re: Interesting clustering/permutations problem [slightly OT]
;;Date: Fri, 5 Jul 2002 23:00:53 +0100
;;Organization: International Pedant Conspiracy
;;Eli Bendersky wrote:
;;> Perhaps you can help me understand why it takes so long...
;;> According to my calculations, there are a 3025 ways in total
;;> to make such division, so it shouldn't take more than a few
;;> tens of K's of memory !
;;The list of positions has almost a million elements.
;;Much more than 3025. However, this is treating positions
;;as different when they have the same pieces in the same
;;places, provided they arose via different move orders.
;;This probably isn't what you want, but it's what (as I
;;understood) you asked for. :-)
;;If you want to enumerate positions instead of game histories,
;;here's one approach.
(defun enumerate (x-so-far y-so-far next nx ny result)
"Push onto RESULT every list with the following properties,
finally returning RESULT.
(1) The list has two elements X and Y, both lists.
(2) The length of X is equal to that of Y, or one greater.
(3) Some tail of X equals X-SO-FAR and some tail of Y equals Y-SO-FAR.
(4) X and Y are disjoint.
(5) The elements of X and Y are distinct integers satisfying (<= 1 n 9).
(6) The elements of X and Y each appear in ascending order.
(7) The elements in X and Y which aren't in X-SO-FAR and Y-SO-FAR
are at most NEXT.
Precondition: X-SO-FAR and Y-SO-FAR satisfy all of those
conditions. Furthermore, NX and NY are the lengths of those
lists."
(when (<= ny nx (1+ ny))
(push (list x-so-far y-so-far) result))
(loop for actual-next from 1 upto next do
(setq result
(enumerate (cons actual-next x-so-far) y-so-far
(1- actual-next)
(1+ nx) ny
result))
(setq result
(enumerate x-so-far (cons actual-next y-so-far)
(1- actual-next)
nx (1+ ny)
result)))
result)
(defun check (x y)
(let ((nx (length x))
(ny (length y)))
(assert (<= ny nx (1+ ny)))
(assert (= (length (remove-duplicates (append x y)))
(+ nx ny)))
(assert (every (lambda (a) (<= 1 a 9)) x))
(assert (every (lambda (a) (<= 1 a 9)) y))))
(let ((all-positions (enumerate nil nil 9 0 0 nil)))
(loop for (x y) in all-positions do (check x y))
(length all-positions))
;... which, by the way, returns 6046. How sure are you about
;your figure of 3025? What exactly is it the number of?
;You could save some work by checking for the possibility that
;NX and NY are so far apart that filling all the remaining spaces
;wouldn't bring them back into balance, but the function takes
;about 0.01 seconds as it is, and it's possible that the overhead
;of checking the condition would outweigh the savings.
;You ought to consider, by the way, whether you actually need to
;enumerate the positions at all...
;--
;Gareth McCaughan Gareth.McCaughan@pobox.com
;.sig under construc
;; ----------------------------------------------------------------------
;;From: Kenny Tilton
;;Newsgroups: comp.lang.lisp
;;Subject: Re: Interesting clustering/permutations problem
;;Date: Thu, 04 Jul 2002 03:03:13 GMT
;;Organization: Road Runner - NYC
;;I looked at the code some more, found some stuff. Not rigorously
;;verified, but:
;;This was my timing of your code under ACL5:
;;; cpu time (non-gc) 9,916 msec user, 0 msec system
;;; cpu time (gc) 143,174 msec (00:02:23.174) user, 0 msec system
;;; cpu time (total) 153,090 msec (00:02:33.090) user, 0 msec system
;;; real time 153,090 msec (00:02:33.090)
;;; space allocation:
;;; 69,876,746 cons cells, 0 symbols, 73,960 other bytes, 0 static bytes
;;Switching the loop appends to nconcs (I think that's OK):
;;; cpu time (non-gc) 10,073 msec user, 0 msec system
;;; cpu time (gc) 47,170 msec user, 0 msec system
;;; cpu time (total) 57,243 msec user, 0 msec system
;;; real time 57,232 msec
;;; space allocation:
;;; 62,965,251 cons cells, 0 symbols, 68,848 other bytes, 0 static bytes
;;Removing the sort from the new state gen (why sort? if nec, do at end,
;;not after each insertion):
;;; cpu time (non-gc) 5,176 msec user, 0 msec system
;;; cpu time (gc) 26,149 msec user, 0 msec system
;;; cpu time (total) 31,325 msec user, 0 msec system
;;; real time 31,325 msec
;;; space allocation:
;;; 22,223,161 cons cells, 0 symbols, 34,600 other bytes, 0 static bytes
;;removing the copy-list from new state gen (looks unnecessary):
;;; cpu time (non-gc) 4,547 msec user, 0 msec system
;;; cpu time (gc) 5,858 msec user, 0 msec system
;;; cpu time (total) 10,405 msec user, 0 msec system
;;; real time 10,405 msec
;;; space allocation:
;;; 12,130,893 cons cells, 0 symbols, 14,824 other bytes, 0 static bytes
;;eliminating possible-moves (just loop from 1 to 9 testing the state):
;;; cpu time (non-gc) 4,465 msec user, 0 msec system
;;; cpu time (gc) 552 msec user, 0 msec system
;;; cpu time (total) 5,017 msec user, 0 msec system
;;; real time 5,017 msec
;;; space allocation:
;;; 10,157,053 cons cells, 0 symbols, 160 other bytes, 0 static bytes
;;etc etc... bit vectors would be next.
;;--
;; kenny tilton
;; clinisys, inc
;; ---------------------------------------------------------------
;;""Well, I've wrestled with reality for thirty-five years, Doctor,
;; and I'm happy to state I finally won out over it.""
;; Elwood P. Dowd