Matchgame implementation #6: Optimization

The game to implement is
Given four rows of matchsticks:
|||||||
|||||
|||
|

Two players take turns removing any number of sticks from ONE single row. The one to remove the last stick loses.

The previous post held a working implementation of this game. But it was extremely ineficcient, and I had to limit recursion depth for the algorithm to complete in a reasonable time. Which lead to that the computer did not make the right decision until very few sticks remained.

So let's take a look at the bad function along with the complete code to compute the time it takes to run:

#light

let ValidMove state (removeAtIndex, removeNumber) =
removeAtIndex >= 0 &&
removeAtIndex < List.length state &&
removeNumber > 0 &&
removeNumber <= List.nth state removeAtIndex

let MakeMove state (removeAtIndex, removeNumber) =
if ValidMove state (removeAtIndex, removeNumber) = false then failwith (sprintf "%A is not a valid move on %A" (removeAtIndex, removeNumber) state)
List.mapi (fun i numberOfMatches -> if removeAtIndex = i then numberOfMatches - removeNumber else numberOfMatches) state

let GenerateValidMoves state =
let mutable validMoves = []
let validIndices = [0 .. List.length state - 1]
for i in validIndices do
let validNumberOfPicks = [1 .. List.nth state i]
for n in validNumberOfPicks do
validMoves <- (i, n)::validMoves
validMoves

// Checks if a leave is winning by complete search. Since it can take extreme time
// to calculate, the parameter maxDepth is used to limit how many look-aheads are
// valid to do (recursion depth).
let rec IsWinnerLeaveRec maxDepth list =
match maxDepth with
| 0 -> false
| _ ->
(list |> List.map abs |> List.sum = 1)
||
(
let moves = GenerateValidMoves list
moves
|> List.map (MakeMove list)
|> List.map (IsWinnerLeaveRec (maxDepth - 1))
|> List.fold_left (fun x acc-> x || acc) false
) = false

let run_time_func (func: unit -> 'a) =
let time0 = System.DateTime.Now
let res = func ()
let diff0 = System.DateTime.Now - time0
(diff0, res)

let startState = [2;5;3;1]
let (time, result) = run_time_func (fun() -> IsWinnerLeaveRec (List.sum startState) startState)
printfn "%A" time

The bad function is "IsWinnerLeaveRec".
Here I also introduced a function which calculates the run time of another: "run_time_func". I "stole" it right away from F# for game development, I hope that's ok

Note in the last row that actually does the execution, the argument maxDepth is set to "(List.sum startState)". Since one move in the game always removes at least one stick, the maximum possible recursion depth is the number of sticks. And here I want to allow that depth to be able to measure properly.

The results on my system averages to 4 seconds.

So what to do?
Let's focus on the following:

(
let moves = GenerateValidMoves list
moves
|> List.map (MakeMove list)
|> List.map (IsWinnerLeaveRec (maxDepth - 1))
|> List.fold_left (fun x acc-> x || acc) false
) = false

The purpose of those lines is to verify that none of the valid moves may lead to a winning state.
What strikes me here is that the number of possible moves may be very large, but ALL of them are ALWAYS checked. That's quite unnecessary to do. Once we fint ONE move that's winning, we can stop. No need to evaluate all the rest!

So I introduce a new function which does just that; Check for ANY winning move, and if found then stop:

let rec HasWinningMove state moves maxDepth =
match moves with
| [] -> false
| a::b -> IsWinnerLeaveRec (maxDepth - 1) (MakeMove state a) || HasWinningMove state b maxDepth

It takes the state, a list of possible moves, and the maxDepth.
It performs a match on moves.
If there are no moves, then obviously there are no winning moves, so it evaluates to false;
If there is at least one move, then the list contains a winning move if the first move generates a winning state
OR if the remaining moves has a winning move.

Simple, right?
the original bad function the becomes:

let rec IsWinnerLeaveRec maxDepth state =
match maxDepth with
| 0 -> false
| _ ->
(state |> List.map abs |> List.sum = 1)
||
(
let moves = GenerateValidMoves state
HasWinningMove state moves maxDepth
) = false

Should be understandable?

Now the test runs in about 0.02 seconds, which is 200 times faster than the original!

The bad thing is that the code won't compile. It doesn't seem like you can have two functions calling each other. I solved that by defining "HasWinningMove" within "IsWinnerLeave"
Here's working code:

#light

let ValidMove state (removeAtIndex, removeNumber) =
removeAtIndex >= 0 &&
removeAtIndex < List.length state &&
removeNumber > 0 &&
removeNumber <= List.nth state removeAtIndex

let MakeMove state (removeAtIndex, removeNumber) =
if ValidMove state (removeAtIndex, removeNumber) = false then failwith (sprintf "%A is not a valid move on %A" (removeAtIndex, removeNumber) state)
List.mapi (fun i numberOfMatches -> if removeAtIndex = i then numberOfMatches - removeNumber else numberOfMatches) state

let GenerateValidMoves state =
let mutable validMoves = []
let validIndices = [0 .. List.length state - 1]
for i in validIndices do
let validNumberOfPicks = [1 .. List.nth state i]
for n in validNumberOfPicks do
validMoves <- (i, n)::validMoves
validMoves

let run_time_func (func: unit -> 'a) =
let time0 = System.DateTime.Now
let res = func ()
let diff0 = System.DateTime.Now - time0
(diff0, res)

// Checks if a leave is winning by complete search. Since it can take extreme time
// to calculate, the parameter maxDepth is used to limit how many look-aheads are
// valid to do (recursion depth).
let rec IsWinnerLeaveRec maxDepth state =
match maxDepth with
| 0 -> false
| _ ->
(state |> List.map abs |> List.sum = 1)
||
(
let rec HasWinningMove state moves maxDepth =
match moves with
| [] -> false
| a::b -> IsWinnerLeaveRec (maxDepth - 1) (MakeMove state a) || HasWinningMove state b maxDepth
let moves = GenerateValidMoves state
HasWinningMove state moves maxDepth
) = false

let startState = [2;5;3;1]
let (time, result) = run_time_func (fun() -> IsWinnerLeaveRec (List.sum startState) startState)
printfn "%A" time

// Time with this one about 0.02s
// Original: about 4s

// checks if a leave is winning
let IsWinnerLeave list = IsWinnerLeaveRec (List.sum list) list

let rec PickWinnerMove state moves =
match moves with
|[] -> failwith "No valid moves"
|[a]-> a
|a::b when (IsWinnerLeave (MakeMove state a)) -> a
|a::b when not (IsWinnerLeave (MakeMove state a)) -> PickWinnerMove state b
|_ ->failwith "unknown state"

let GenerateWinnerMove state =
let possibleMoves = GenerateValidMoves state
PickWinnerMove state possibleMoves

open System

let GetMoveFromUser state =
printfn "enter a move (row numberToRemove)>"
let input = Console.ReadLine()
let parts = input.Split([|' '|], StringSplitOptions.RemoveEmptyEntries)
let row = int parts.[0]
let numberToRemove = int parts.[1]
(row, numberToRemove)

let GetMoveFromComputer state =
let move = GenerateWinnerMove state
printfn "The computer moves %A" move
move

let StatePrinter state =
printfn "State:"
List.mapi (
fun i x ->
printf "%i: " i
for n in [1..x] do
printf "|"
printfn ""
) state
|> ignore

let rec main (activePlayerName, activePlayerInputRequest) (otherPlayerName,otherPlayerInputRequest) state=
StatePrinter state
let move = activePlayerInputRequest state
let newState = MakeMove state move
if (List.sum newState) < 2 then
if IsWinnerLeave newState then
StatePrinter newState
printfn "The game was won by %A" activePlayerName
else printfn "The game was lost by %A" activePlayerName
else
main (otherPlayerName, otherPlayerInputRequest) (activePlayerName, activePlayerInputRequest) newState

main ("Player", GetMoveFromUser) ("Computer", GetMoveFromComputer) [7;5;3;1]

ignore (Console.ReadKey())

Can you beat the computer? Can you beat the computer in different ways? Good luck ;)