2048 – Type Provider Edition

:: fsharp, type providers

I’m sure you would have all seen the highly addictive and annoying game 2048 by now (if not, follow the link and have a go now, don’t forget to come back here though! ). Fellow F#er @brandewinder wrote a bot that wins the game for you, subsequently turning it into an cool F# dojo. It is London’s turn for this dojo next Thursday, so I figured before then I would have a go myself and do the obvious thing which is to turn it into a type provider :)

2048 TP Edition is available as part of my type provider abstraction the Interactive Provider. You will want to set your tooltips to a fixed-width font for this to render for you properly. Here is a picture of it in action !

image

2048 Implementation

I will start by saying that I have not looked at any other implementations of either the game or any automated bots, so if this is terrible then please forgive me. I had also not played the game at all until recently and as such the rules implemented here are from my brief analysis of playing it. There might be some subtleties I have overlooked.

I first implemented this using arrays as it seemed like a natural fit for the 4 x 4 board, but although I got it to work, it was horrible and instead I replaced it with this much more functional version.

1
2
 
type data = Map<int * int, int> 
type direction = Up | Down | Left | Right

That covers the entire domain :) Each location of the grid is stored in the map along with the value, if one exists.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
let shift (x,y) = function 
  | Up -> (x,y-1) 
  | Down -> (x,y+1) 
  | Left -> (x-1,y) 
  | Right -> (x+1,y)

let moves = function 
  | Up -> 
    [for x in 0..3 do 
     for y in 0..3 do 
       yield x,y] 
  | Down -> 
    [for x in 0..3 do 
     for y in 3..-1..0 do 
       yield x,y] 
  | Left -> 
    [for y in 0..3 do 
     for x in 0..3 do 
       yield x,y] 
  | Right -> 
    [for y in 0..3 do 
     for x in 3..-1..0 do 
       yield x,y]

A couple of utility functions. The first is pretty obvious, the second returns a list of tuples indicating the order that the cells should be processed. The order is very important for a number of reasons as will become clear.

1
2
3
4
5
6
7
8
 
let rec move direction data (x,y) (px,py) = 
  match x, y with 
  | -1, _ 
  | _, -1 
  | 4, _ 
  | _, 4 -> (px,py) 
  | x, y when Map.containsKey (x,y) data -> (px,py) 
  | _ -> move direction data (shift (x,y) direction) (x,y)

This function takes a location and attempts to move it in the specified direction until either it goes out of bounds, or it finds the location is already taken in the map. In either case, it returns the last good position that can be moved to.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
 
let replace direction data inputs = 
  let move = move direction 
  (data,inputs) 
  ||> List.fold(fun m p -> 
    match move m (shift p direction) p with 
    | newpos when newpos = p -> m 
    | newpos -> let v = m.[p] in m |> Map.remove p |> Map.add newpos v)

let compress direction data = 
  direction 
  |> moves 
  |> List.filter(fun k -> Map.containsKey k data) 
  |> replace direction data

These functions effectively “compress” the map in a specified direction. What this means is that if we are going Up, it will start from the top row, and moving downwards it will move each cell up as far as it can go, resulting in a new compressed map. You can think of this much like defragging memory, but with a direction bias. It’s like applying gravity from different directions :)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
 
let merge direction data = 
  let moves = direction |> moves |> Seq.pairwise |> Seq.toList 
  (data,moves) 
  ||> List.fold( fun data ((x,y), (x',y')) -> 
    match Map.tryFind (x,y) data, Map.tryFind(x',y') data with 
    | Some first, Some second when first = second -> 
      data 
      |> Map.remove (x,y) 
      |> Map.remove (x',y') 
      |> Map.add (x,y) (first*2) 
    |_ -> data)

This one is a little more fun :) The idea of the merge function is to, based on the direction, merge any pair cells that are touching and have the same value, replacing them with one cell (based on the “gravity” direction) that has double the value. This code uses pairwise to serve up each pair of locations – the order that the cells are generated from the moves function is critical here

1
 
let step direction = (compress direction) >> (merge direction) >> (compress direction)

Using function composition, I can now say that one step of the simulation consists of compressing the map in a certain direction, merging the resulting cells together where appropriate, and then compressing again to fill in any blanks that appeared from the merge step. I think this is pretty awesome :)

Type Provider

As mentioned before, this uses my Interactive Provider so there is no gnarly provided types code. Instead, I have a very simple state that gets passed back and forth

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
 
type ``2048State`` = 
  | NewGame 
  | GameOn of Map<int*int, int> 
  | GameOver of bool 
  interface IInteractiveState with 
    member x.DisplayOptions: (string * obj) list = 
      match x with 
      | NewGame -> ["Begin Game", box ""] 
      | GameOn(data) -> ["# Show Grid", box "show";"Up", box "up";"Down", box "down";"Left", box "left";"Right", box "right";] 
      | GameOver(true) -> [] 
      | GameOver(false) -> [] 
    member x.DisplayText: string = // omit drawing code for brevity

Very simple .. at the start it shows “Begin Game” and from then on displays the directional choices as properties along with a “# Show Grid” property that shows the current state of the grid.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
type ``2048``() = 
  interface IInteractiveServer with 
    member x.NewState: IInteractiveState = NewGame :> IInteractiveState 
    member x.ProcessResponse(state: IInteractiveState, response: obj): IInteractiveState = 
      let (|Win|Lose|Continue|) (data:Map<int*int,int>) = 
        ((true,0),[for x in 0..3 do 
                   for y in 0..3 do 
                   yield x,y]) 
        ||> List.fold(fun (b,highest) k -> 
            match Map.tryFind k data with 
            | Some v -> if v > highest then (b,v) else (b,highest) 
            | None -> (false,highest)) 
        |> function 
            | (_, 2048) -> Win 
            | (true, _) -> Lose 
            | _ -> Continue data

      match (state:?>``2048State``), (response :?> String).ValueOption() with 
      | NewGame, _ -> 
        let x, y = rnd.Next(0,4), rnd.Next(0,4) 
        GameOn( Map.ofList[(x,y),2]) 
      | GameOn(data), Some "show" -> GameOn(data) 
      | GameOn(data), dir -> 
        let dir = 
          match dir with 
          | Some "left" -> Left 
          | Some "right" -> Right 
          | Some "up" -> Up 
          | Some "down" -> Down 
          | _ -> failwith "" 
        match step dir data with 
        | Win -> GameOver true 
        | Lose -> GameOver false 
        | Continue data -> 
          let rec aux () = 
            let x, y = rnd.Next(0,4), rnd.Next(0,4) 
            if Map.containsKey (x,y) data then aux() 
            else x,y 
        GameOn(data.Add(aux(),2)) 
      | _, _ -> failwith "" 
      |> fun x -> x :> IInteractiveState

There is really not a lot to this. The active pattern at the top cycles through all the possible grid states, collecting the highest cells and whether or not all the cells are populated. With this information it can return if the game has been won, lost, or should continue.

When the game is running, it simply looks at the direction that was selected, and pattern matches on the results of calling the composed step function using the active pattern above. Assuming the game is still running, it finds a random location to put a new 2 in, and returns the new data map.

Conclusion

Now you can really spend time in Visual Studio playing games instead of working, because this is a lot more fun than minesweeper! 2048 Type Provider Edition for the win!