In this episode I will quickly describe how to write a generic solver for games having the following properties:

• single player (shouldn't be hard to generalize though)
• can include an element of randomness
• no loops in game states (can't go back to a previous situation)
• relatively simple games

The cause of the last constraint is that the algorithm that is being described here is very simple. Techniques for making it faster will be describe at the end of this post, and in further episodes. This is a template Haskell file than can be copy-pasted and reused, so let's start with the imports:

module SimpleSolver where

import Data.Ord (comparing)
import Data.List
import qualified Data.Map.Strict as M
import qualified Data.List.NonEmpty as NE

A quick reminder of the problem and base types

A probability is represented as a rational value, and a choice is a description coupled with a list of states weighted by probability:

type Proba = Rational
type Choice description state = (description, Probably state)
type Probably a = [(a, Proba)]

Obviously, an event that is certain has probability 1:

certain :: a -> Probably a
certain a = [(a,1)]

And the regroup function, that is used to group together identical events. I tried discrimination, but it was too slow, so I moved to unordered-containers. Unfortunately, under heavy stress I encountered a nasty bug that got me scared. I complained about my program behaving randomly on the #haskell IRC channel, only to have Cale find the culprit in about two minutes. That was cool! It is now using containers, and it is just about as fast as with the HashMap.

regroup :: Ord a => Probably a -> Probably a
regroup = M.toList . M.fromListWith (+)

This function is not used in this post, but is nevertheless extremely critical for performance!

What is a solution ?

The basic structure of the game is, for each chapter:

• The player chooses one of the possible outcomes,
• and stuff happens to him, possibly randomly.

Solving the game means deciding which choice is the best, depending on the circumstances. In the case of the Lone Wolf series, the circumstances could be the current player health, equipment, or choice of disciplines. The solution can be thought of as some sort of tree, where each node describes what the best choice is, and the childrens are the possible outcomes. The tree leaves are the "game over" situations.

data Solution state description
    = Node { _desc    :: description
           , _stt     :: state
           , _score   :: Rational
           , _outcome :: Probably (Solution state description)
           }
    | Leaf { _score :: Rational
           , _stt   :: state
           }
    deriving (Show, Eq)

Finding the solution

We will need the following type, that is used to possibly assign a score to a situation. In the Lone Wolf books, it will give a score of Known 1 to chapter 350, Known 0 to all situations where the hero dies, and Unknown for all other states.

data Score = Known Rational | Unknown

The function that solves a game has the following type:

solve :: (state -> NE.NonEmpty (Choice description state))
      -> (state -> Score)
      -> state
      -> Solution state description

That is, it requires the following arguments:

• A function that, given a game state, can give a non-empty list of choices to the player can decide to choose from.
• A function that can assign a Score to any game state, as described above.
• The current state.

The algorithm is fairly obvious, and as a result the function body is smaller than the Solution type declaration:

solve getChoice score stt =
    let scored = do
          (cdesc, pstates) <- getChoice stt

Given the current state, the possible choices are enumerated (using the list monad), where cdesc is the description of a choice, and pstates the list of possible outcomes, along with their respective probabilities of occurence.

          let ptrees = map (\(o,p) -> (solve getChoice score o, p)) pstates

Here, pstates has type Probably state. The ptrees variable contains the solution associated with each of the possible states, and has type Probably (Solution state description).

          return $ Node cdesc stt (sum (map (\(o, p) -> p * _score o) ptrees)) ptrees

A solution is built, with a score equal to the sum of the scores of the possible outcomes, weighted by their probability of occurence.

    in  case score stt of
          Known x -> Leaf x stt
          Unknown -> maximumBy (comparing _score) scored

Finally, if the current state can be scored, then the "solution" is known. If it can't be, the best choice, based on its score, is kept.

So, problem solved?

Unfortunately, this simple algorithm will not cut it. It is way too slow, but can be improved upon fairly easily with two simple changes:

• The solve function can be memoized,
• the computations in the solve function can be parallelized.

With these two simple changes, the solver will look like that. It is reasonnably efficient, and will solve the book and report statistics up to chapter 200, which is roughly half the book, in about 30 seconds on my computer. Unfortunately, from there is gets slower fairly quickly!

In the next chapter, I will describe a technique for smarter scoring that will decrease this time to about 13 seconds.

As a teaser, here is the output of the solver for now (chapter 247 really is a killer!):

Solving for the following initial state:
CharacterConstant {_maxendurance = Endurance {getEndurance = 25}, _combatSkill = CombatSkill {getCombatSkill = 15}
, _discipline = [Hunting,WeaponSkill ShortSword,MindBlast,SixthSense,MindShield]}
(Endurance {getEndurance = 25},(inventoryFromList [(Gold,15),(Meal,2),(SealHammerdalVol2,1),(Weapon ShortSword,1)]))
Winning probability: 0.8731436491536936 [62916630607511833328443669116357 % 72057594037927936000000000000000]
0.1968 NewChapter 200 (Endurance {getEndurance = 23},(inventoryFromList [(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.1968 NewChapter 200 (Endurance {getEndurance = 25},(inventoryFromList [(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0974 HasLost 247
0.0612 NewChapter 200 (Endurance {getEndurance = 15},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0610 NewChapter 200 (Endurance {getEndurance = 16},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0564 NewChapter 200 (Endurance {getEndurance = 17},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0481 NewChapter 200 (Endurance {getEndurance = 18},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0480 NewChapter 200 (Endurance {getEndurance = 14},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0409 NewChapter 200 (Endurance {getEndurance = 13},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0332 NewChapter 200 (Endurance {getEndurance = 12},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0263 NewChapter 200 (Endurance {getEndurance = 19},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0233 HasLost 345
0.0232 NewChapter 200 (Endurance {getEndurance = 11},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0168 NewChapter 200 (Endurance {getEndurance = 10},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0132 NewChapter 200 (Endurance {getEndurance = 9},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0124 NewChapter 200 (Endurance {getEndurance = 20},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0083 NewChapter 200 (Endurance {getEndurance = 8},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0056 NewChapter 200 (Endurance {getEndurance = 23},(inventoryFromList [(Gold,12),(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0056 NewChapter 200 (Endurance {getEndurance = 25},(inventoryFromList [(Gold,12),(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0046 NewChapter 200 (Endurance {getEndurance = 21},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0043 NewChapter 200 (Endurance {getEndurance = 7},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0040 NewChapter 200 (Endurance {getEndurance = 24},(inventoryFromList [(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0040 NewChapter 200 (Endurance {getEndurance = 26},(inventoryFromList [(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0031 HasLost 186
0.0020 NewChapter 200 (Endurance {getEndurance = 6},(inventoryFromList [(Gold,12),(TicketVol2,1),(Weapon Mace,1)])) Didn'tFight
0.0016 HasLost 326
0.0010 HasLost 146
0.0005 HasLost 268
0.0001 NewChapter 200 (Endurance {getEndurance = 24},(inventoryFromList [(Gold,12),(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0001 NewChapter 200 (Endurance {getEndurance = 26},(inventoryFromList [(Gold,12),(Meal,1),(TicketVol2,1),(SealHammerdalVol2,1)])) Didn'tFight
0.0001 HasLost 34