;;[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 <ktilton@nyc.rr.com>
;;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