As @luqui says in a comment to the question:
You could either merge the outputs ... or you could search the history once for each space in
the board. ...
The former solution is described in a nearby question. The "chess" problem having been
solved there is only superficially distinct from your "noughts & crosses" problem, so it should
not be too hard to adapt the solution. However:
In that case, the board size is fixed and small, so we were not worried about the inefficiency
of merging the boards pairwise.
In this case, the board size is variable, so a solution by the latter method may be worth a try.
To make the algorithm even more efficient, instead of scrolling across the board and searching for
matching moves at every cell, we will scroll across the moves and assign values to a board
represented as a mutable array. Mutable arrays may be considered an "advanced technique" in
functional programming, so it could also be a good exercise for an intermediate Haskeller. I only
used them once or twice before, so let us see if I can figure this out!
How is this going to work?
At the heart of the program will be a rectangular array of bytes. An array goes in two flavours:
mutable and "frozen". While a frozen array cannot be changed, It is a rule that a mutable array
may only exist in a monadic context, so we can only freely pass around an array when it is frozen.
If this seems to be overcomplicated, I can only ask the reader to believe that the additional
safety guarantees are worth this complication.
Anyway, here are the types:
type Position = (Int, Int)
type Field s = STUArray s Position Char
type FrozenField = UArray Position Char
We will create a function that "applies" a list of moves to an array, thawing and freezing it as
needed.
type Move = (Char, Position)
applyMoves :: FrozenField -> [Move] -> FrozenField
(The idea of Move is that it is sufficient to put a mark on the board, without needing to know
whose turn it is.)
Applied to an empty field of the appropriate size, this function will solve our problem — we shall
only need to adjust the format of the input and the output.
empty :: Position -> FrozenField
positionsToMoves :: [Position] -> [Move]
arrayToLists :: FrozenField -> [[Char]]
Our final program will then look like this:
tictac :: Position -> [Position] -> IO ()
tictac corner = pp . arrayToLists . applyMoves (empty corner) . positionsToMoves
I hope it looks sensible? Even though we have not yet written any tangible code.
Can we write the code?
Yes.
First, we will need some imports. No one likes imports, but, for some reason, it is not yet
automated. So, here:
import Data.Foldable (traverse_)
import Data.Array.Unboxed
import Data.Array.ST
import GHC.ST (ST)
The simplest thing one can do with arrays is to create an empty one. Let us give it a try:
empty :: Position -> FrozenField
empty corner = runSTUArray (newArray ((1, 1), corner) ' ')
The idea is that newArray claims a region in memory and fills it with spaces, and runSTUArray
freezes it so that it can be safely transported to another part of a program. We could instead
"inline" the creation of the array and win some speed, but we only need to do it once, and I
wanted to keep it composable — I think the program will be simpler this way.
Another easy thing to do is to write the "glue" code that adjusts the input and output format:
positionsToMoves :: [Position] -> [Move]
positionsToMoves = zip (cycle ['x', 'o'])
arrayToLists :: FrozenField -> [[Char]]
arrayToLists u =
let ((minHeight, minWidth), (maxHeight, maxWidth)) = bounds u
in [ [ u ! (row, column) | column <- [minWidth.. maxWidth] ] | row <- [minHeight.. maxHeight] ]
Nothing unusual here, run-of-the-mill list processing.
Finally, the hard part — the code that applies any number of moves to a given frozen array:
applyMoves :: FrozenField -> [Move] -> FrozenField
applyMoves start xs = runSTUArray (foldST applyMove (thaw start) xs)
where
foldST :: (a -> b -> ST s ()) -> ST s a -> [b] -> ST s a
foldST f start' moves = do
u <- start'
traverse_ (f u) moves
return u
applyMove :: Field s -> Move -> ST s ()
applyMove u (x, i) = writeArray u i x
The pattern is the same as in the function empty: modify an array, then freeze it — and all the
modifications have to happen in an ST monad, for safety. foldST contains all the
"imperative" "inner loop" of our program.
(P.S.) How does this actually work?
Let us unwrap the UArray and STUArray types first. What are they and what is the difference?
UArray means "unboxed array", which is to say an array of values, as opposed to an array of
pointers. The value in our case is actually a Unicode character, not a C "byte" char, so it is not a byte, but a variable
size entity. When it is stored in unboxed form, it is converted to an Int32 and back invisibly
to us. An Int32 is of course way too much for our humble purpose of storing 3 different values,
so there is space for improvement here. To find out more about unboxed values, I invite you to
check the article that introduced them back in 1991, "Unboxed Values as First Class Citizens in
a Non-Strict Functional Language".
That the values are unboxed does not mean that you can change them though. A pure value in Haskell
is always immutable. So, were you to change a single value in an array, the whole array would be
copied — expensive! This is where STUArray comes in. ST stands for State Thread, and what
STUArray is is an "unfrozen" array, where you can overwrite individual values without copying
the whole thing. To ensure safety, it can only live in a monad, in this case the ST monad.
(Notice how an STUArray value never appears outside of an ST s wrap.) You can imagine an
ST computation as a small imperative process with its own memory, separate from the outside
world. The story goes that they invented ST first, and then figured out they can get IO from
it, so IO is actually ST in disguise. For more details on how ST works, check out the
original article from 1994: "Lazy Functional State Threads".
Let us now take a more careful look at foldST. What we see is that functionally, it does not
make sense. First we bind the value of start' to u, and then we return u — the same
variable. From the functional point of view, this is the same as writing:
u <- start'
return u
— Which would be equivalent to u by monad laws. The trick is in what happens inbetween:
traverse_ (f u) moves
Let us check the type.
λ :type traverse_
traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
So, some function is being called, with u as argument, but the result is the useless () type.
In a functional setting, this line would mean nothing. But in a monad, bound values may appear
to change. f is a function that can change the state of a monad, and so can change the value of
the bound names when they are returned. The analogous code in C would go somewhat like this:
char* foldST(void f(char*, Move), int n_start, char start[], int n_moves, Move moves[])
{
// u <- start
char* u = malloc(sizeof(char) * n_start);
memcpy(u, start, sizeof(char) * n_start);
// traverse_ (f u) moves
for (int i = 0; i < n_moves; i++)
{
f(u, moves[i]);
}
// return u
return u;
}
In Haskell, the pointer arithmetic is abstracted away, but essentially traverse_ in ST works
like this. I am not really familiar with C nor with the inner workings of the ST abstraction, so
this is merely an analogy, not an attempt at a precise rendition. Nevertheless I hope it helps the reader to observe the similarity between ST and ordinary imperative C code.
Mission accomplished!
It runs reasonably fast. Takes only a moment to draw a million-step match on a million-sized
board. I hope it is also explained clearly enough. Do not hesitate to comment if something is amiss or unclear.
