functional-programming-snake/fsharp/tests/M12Check.fs

module Snake.Tests.M12Check

open Expecto
open Snake
open Snake.Model
open Snake.Check
open Snake.Tests.Fixtures

// ---- helpers for moveGaps: a state whose snake has its head at (x, y); nothing else matters there

let private at (x: int) (y: int) : GameState =
    { Width = 20
      Height = 20
      Snake = [ { X = x; Y = y }; { X = x - 1; Y = y } ]
      Dir = Right
      NextDir = Right
      Apple = None
      Seed = 0u
      Score = 0
      Status = Playing
      Frame = 0
      Queued = None }

// ---- the payoff: properties of the game, and deliberately broken games ("mutants") that they must catch

// Every state of the game played with `upd` from `start`. (For the real `Game.update` this is `Game.history`.)
let private statesWith (upd: GameState -> Action -> GameState) (start: GameState) (actions: Action list) : GameState list =
    List.scan upd start actions

let private sane (upd: GameState -> Action -> GameState) (actions: Action list) : bool =
    statesWith upd (Spawn.newGame 1u) actions |> List.forall (fun s -> List.isEmpty (violations s))

// Mutant 1: `turn` checks against NextDir instead of Dir (version A of Puzzle 2 in Module 3).
let private turnAgainstNextDir (state: GameState) (action: Action) : GameState =
    match action with
    | Turn dir -> if state.Status = Playing && dir <> opposite state.NextDir then { state with NextDir = dir } else state
    | _ -> Game.update state action

// Mutant 2: `advance` forgets to check the walls.
let private advanceWithoutWalls (state: GameState) : GameState =
    if state.Status <> Playing then
        state
    else
        let head = Rules.move (List.head state.Snake) state.NextDir
        let eating = state.Apple = Some head
        let body = if eating then state.Snake else Util.dropLast state.Snake

        if Util.contains body head (=) then
            { state with Dir = state.NextDir; Status = GameOver }
        else
            { state with
                Snake = head :: body
                Dir = state.NextDir
                Apple = if eating then None else state.Apple
                Score = state.Score + (if eating then 1 else 0) }

// What `update` does after a step since Exercise 10.6: take the queued turn. The mutants below that replace `Tick`
// do the same, so that each one differs from the real game in exactly one thing.
let private takeQueued (s: GameState) : GameState =
    match s.Queued with
    | Some d when s.Status = Playing -> { s with NextDir = d; Queued = None }
    | _ -> s

let private noWalls (state: GameState) (action: Action) : GameState =
    match action with
    | Tick -> takeQueued (Spawn.spawnApple (advanceWithoutWalls state))
    | _ -> Game.update state action

// Mutant 4: a `Tick` that forgets the turn queue of Exercise 10.6 (the `Frame` step still takes it).
let private tickForgetsQueue (state: GameState) (action: Action) : GameState =
    match action with
    | Tick -> Spawn.tick state
    | _ -> Game.update state action

// Mutant 5: the queue accepts any key that differs from the pending turn, even the one straight back from it.
let private queueAnyKey (state: GameState) (action: Action) : GameState =
    match action with
    | Turn dir when state.Status = Playing && state.NextDir <> state.Dir && dir <> state.NextDir ->
        { state with Queued = Some dir }
    | _ -> Game.update state action

// Mutant 3: the frame rule this course used at first: step whenever the *total* frame count is a multiple of movesEvery.
let private totalFrameCount (state: GameState) (action: Action) : GameState =
    match action with
    | Frame ->
        if state.Status <> Playing then
            state
        else
            let counted = { state with Frame = state.Frame + 1 }
            if counted.Frame % Game.movesEvery counted.Score = 0 then Spawn.tick counted else counted
    | _ -> Game.update state action

// A long corridor: the snake is one step from its third apple (score 2 -> 3, so the speed changes), `frame` frames into the game.
let private corridor (frame: int) : GameState =
    { Width = 60
      Height = 1
      Snake = [ { X = 1; Y = 0 }; { X = 0; Y = 0 } ]
      Dir = Right
      NextDir = Right
      Apple = Some { X = 2; Y = 0 }
      Seed = 0u
      Score = 2
      Status = Playing
      Frame = frame
      Queued = None }

let private frames = List.replicate 40 Frame

// Every gap between two moves is exactly `movesEvery` of the score the snake had after the first of the two.
let private steady (upd: GameState -> Action -> GameState) (frame: int) : bool =
    let states = statesWith upd (corridor frame) frames

    let scoreAtMove =
        states
        |> List.pairwise
        |> List.filter (fun (before, after) -> List.head after.Snake <> List.head before.Snake)
        |> List.map (fun (_, after) -> after.Score)

    let gaps = moveGaps states
    List.forall2 (fun gap score -> gap = Game.movesEvery score) gaps (List.truncate (List.length gaps) scoreAtMove)

// ---- random states and the oracle

let private connected (snake: Point list) : bool =
    snake |> List.pairwise |> List.forall (fun (a, b) -> abs (a.X - b.X) + abs (a.Y - b.Y) = 1)

let private board (width: int) (height: int) : GameState = { at 0 0 with Width = width; Height = height }

// Mutant 6: Puzzle 1 of Module 3, "the new head must not be on the old snake" (it forgets that the tail moves away).
let private advanceOldSnakeCheck (state: GameState) : GameState =
    if state.Status <> Playing then
        state
    else
        let head = Rules.move (List.head state.Snake) state.NextDir
        let eating = state.Apple = Some head
        let body = if eating then state.Snake else Util.dropLast state.Snake

        if not (Rules.inBounds state head) || Util.contains state.Snake head (=) then
            { state with Dir = state.NextDir; Status = GameOver }
        else
            { state with
                Snake = head :: body
                Dir = state.NextDir
                Apple = if eating then None else state.Apple
                Score = state.Score + (if eating then 1 else 0) }

let private pt (x: int) (y: int) : Point = { X = x; Y = y }

[<Tests>]
let tests =
    testList "M12 Check" [
        // ---- generators

        testCase "elementOf picks the element at the index drawn by intBelow" (fun () ->
            let xs = [ "a"; "b"; "c"; "d"; "e" ]
            let i, seed = Random.run 0u (Random.intBelow 5)
            Expect.equal (Random.run 0u (elementOf xs)) (xs[i], seed) "elementOf")

        testCase "elementOf of a one-element list always gives that element, and still uses up a draw" (fun () ->
            Expect.equal (Random.run 0u (elementOf [ "only" ])) ("only", 1831565813u) "elementOf")

        testCase "listOf 0 gen is the empty list and leaves the seed alone" (fun () ->
            Expect.equal (Random.run 99u (listOf 0 Random.nextUint32)) ([], 99u) "listOf 0")

        testCase "listOf threads the seed from each draw to the next" (fun () ->
            Expect.equal
                (Random.run 0u (listOf 3 Random.nextUint32))
                ([ 1144304738u; 1416247u; 958946056u ], 1199730143u)
                "listOf 3")

        testCase "listOf of a constant generator repeats the value and leaves the seed alone" (fun () ->
            Expect.equal (Random.run 7u (listOf 4 (Random.pure "x"))) ([ "x"; "x"; "x"; "x" ], 7u) "listOf pure")

        testCase "genActions n gives n actions, the same ones for the same seed" (fun () ->
            let actions, _ = Random.run 5u (genActions 30)
            Expect.equal (List.length actions) 30 "length"

            Expect.all
                actions
                (fun a ->
                    match a with
                    | Tick
                    | Turn _ -> true
                    | TogglePause
                    | Restart
                    | Frame -> false)
                "only Tick and Turn"

            Expect.equal (Random.run 5u (genActions 30)) (Random.run 5u (genActions 30)) "same seed, same actions")

        // ---- forAll

        testCase "forAll reports success with the number of runs" (fun () ->
            Expect.equal (forAll 200 1u (fun x -> x >= 0 && x < 10) (Random.intBelow 10)) (Passed 200) "forAll")

        testCase "forAll with zero runs succeeds without drawing anything" (fun () ->
            Expect.equal (forAll 0 1u (fun _ -> false) Random.nextUint32) (Passed 0) "forAll")

        testCase "forAll reports the first failing draw, its value and the seed it started from" (fun () ->
            let gen = Random.intBelow 10
            let prop x = x <> 7
            let draws, _ = Random.run 3u (listOf 200 gen)
            let first = draws |> List.findIndex (fun x -> not (prop x))
            Expect.isGreaterThan first 0 "the test needs a failure that is not the very first draw"

            match forAll 200 3u prop gen with
            | Failed(run, seed, value) ->
                Expect.equal (run, value) (first, 7) "run and value"
                Expect.equal (fst (Random.run seed gen)) 7 "the reported seed gives the value again"
            | Passed runs -> failtest $"expected a failure, got Passed {runs}")

        testCase "forAll stops at the first failure: the property is not asked about later values" (fun () ->
            let gen = Random.intBelow 10
            let draws, _ = Random.run 3u (listOf 200 gen)
            let first = draws |> List.findIndex (fun x -> x = 7)
            let mutable calls = 0 // test code may count; the code under test may not

            let result =
                forAll
                    200
                    3u
                    (fun x ->
                        calls <- calls + 1
                        x <> 7)
                    gen

            match result with
            | Failed(run, _, _) -> Expect.equal run first "run"
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"

            Expect.equal calls (first + 1) "calls")

        testCase "forAll is reproducible: same generator, property, runs and seed give the same report" (fun () ->
            let check () = forAll 500 11u (fun x -> x % 97 <> 0) (Random.intBelow 1000)
            Expect.equal (check ()) (check ()) "same report")

        testCase "forAll runs in constant stack: a million runs do not overflow it" (fun () ->
            Expect.equal (forAll 1000000 1u (fun x -> x < 10) (Random.intBelow 10)) (Passed 1000000) "forAll")

        // ---- shrinking

        testCase "removals lists every way to drop one element, in order" (fun () ->
            Expect.equal (removals [ 1; 2; 3 ]) [ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ] "removals")

        testCase "removals of an empty list is empty, and of a single element is one empty list" (fun () ->
            Expect.equal (removals ([]: int list)) [] "empty"
            Expect.equal (removals [ "a" ]) [ [] ] "single")

        testCase "minimize keeps exactly the elements the failure needs" (fun () ->
            Expect.equal
                (minimize (fun xs -> List.contains 3 xs && List.contains 7 xs) [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])
                [ 3; 7 ]
                "minimize")

        testCase "minimize keeps the order and the duplicates the failure needs" (fun () ->
            Expect.equal
                (minimize
                    (fun xs -> (xs |> List.filter (fun x -> x = "a") |> List.length) >= 2 && List.contains "c" xs)
                    [ "b"; "a"; "c"; "a"; "d"; "a" ])
                [ "c"; "a"; "a" ]
                "minimize")

        testCase "minimize of a list that fails whatever you remove is the empty list" (fun () ->
            Expect.equal (minimize (fun _ -> true) [ 1; 2; 3 ]) [] "minimize")

        testCase "minimize returns a list that still fails and has no failing removal (1-minimal)" (fun () ->
            let fails (xs: int list) = List.sum xs >= 10
            let small = minimize fails [ 5; 1; 4; 2; 6; 3 ]
            Expect.isTrue (fails small) "still fails"
            Expect.all (removals small) (fun ys -> not (fails ys)) "no failing removal")

        // ---- invariants

        yield! fixtureTests "m12-violations" "violations" (fun c ->
            Expect.equal (violations (gameState (arg 0 c))) (list str (expected c)) "violations")

        // ---- moveGaps

        testCase "moveGaps measures the distance between consecutive moves of the head" (fun () ->
            Expect.equal
                (moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0; at 2 0; at 3 0; at 3 1 ])
                [ 3; 1 ]
                "moveGaps")

        testCase "moveGaps of fewer than two moves is empty" (fun () ->
            Expect.equal (moveGaps []) [] "no states"
            Expect.equal (moveGaps [ at 1 0 ]) [] "one state"
            Expect.equal (moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0 ]) [] "one move")

        testCase "moveGaps counts a move at index 1" (fun () ->
            Expect.equal (moveGaps [ at 1 0; at 2 0; at 2 0; at 3 0 ]) [ 2 ] "moveGaps")

        testCase "moveGaps treats an empty snake as a head of its own" (fun () ->
            let snake (cells: Point list) = { at 1 0 with Snake = cells }

            Expect.equal
                (moveGaps [ snake []; snake []; snake [ { X = 1; Y = 0 } ]; snake [ { X = 1; Y = 0 } ]; snake [ { X = 2; Y = 0 } ] ])
                [ 2 ]
                "moveGaps")

        // ---- properties of the game, and the mutants

        testCase "statesWith Game.update in these tests is the history of Module 5" (fun () ->
            let actions, _ = Random.run 9u (genActions 25)
            Expect.equal (statesWith Game.update (Spawn.newGame 1u) actions) (Game.history (Spawn.newGame 1u) actions) "history")

        testCase "the real game keeps every invariant on 300 random games of 40 actions" (fun () ->
            Expect.equal (forAll 300 2024u (sane Game.update) (genActions 40)) (Passed 300) "forAll")

        testCase "the quick double turn bug is found and shrunk to its two key presses" (fun () ->
            let prop = sane turnAgainstNextDir

            match forAll 300 2024u prop (genActions 40) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(_, _, value) ->
                match minimize (fun actions -> not (prop actions)) value with
                | [ Turn first; Turn second ] ->
                    Expect.contains [ Up; Down ] first "first turn"
                    Expect.equal second Left "second turn"
                | small -> failtest $"expected two turns, got %A{small}")

        testCase "a game without walls is found and shrunk to the shortest way off the board: ten ticks" (fun () ->
            let prop = sane noWalls

            match forAll 300 2024u prop (genActions 40) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(_, _, value) ->
                Expect.equal (minimize (fun actions -> not (prop actions)) value) (List.replicate 10 Tick) "ten ticks")

        testCase "a Tick that forgets the queued turn is caught by queued-not-reversed and shrunk to four actions" (fun () ->
            let prop = sane tickForgetsQueue

            match forAll 300 2024u prop (genActions 40) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(_, _, value) ->
                Expect.equal
                    (minimize (fun actions -> not (prop actions)) value)
                    [ Turn Up; Turn Right; Tick; Turn Left ]
                    "four actions")

        testCase "a queue that accepts a reversal is found and shrunk to its two key presses" (fun () ->
            let prop = sane queueAnyKey

            match forAll 300 2024u prop (genActions 40) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(_, _, value) ->
                Expect.equal (minimize (fun actions -> not (prop actions)) value) [ Turn Up; Turn Down ] "two key presses")

        testCase "the real game moves exactly every movesEvery score frames, also across a speed-up" (fun () ->
            Expect.equal (forAll 100 7u (steady Game.update) (Random.intBelow 8)) (Passed 100) "forAll")

        testCase "counting frames from the start of the game makes some steps too short, and the property finds one" (fun () ->
            match forAll 100 7u (steady totalFrameCount) (Random.intBelow 56) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(_, _, value) -> Expect.isFalse (steady totalFrameCount value) "the counterexample fails")

        // ---- random states (Exercise 12.6)

        testCase "genSnake draws the head first, then walks from the tail (seed 0, 5x5, at most 6 cells)" (fun () ->
            Expect.equal
                (Random.run 0u (genSnake 5 5 6))
                ([ pt 3 2; pt 3 1; pt 3 0; pt 2 0; pt 1 0; pt 0 0 ], 4231026099u)
                "genSnake")

        testCase "genSnake is pinned for a few more seeds" (fun () ->
            Expect.equal
                (fst (Random.run 1u (genSnake 5 5 6)))
                [ pt 2 3; pt 3 3; pt 4 3; pt 4 4; pt 3 4; pt 2 4 ]
                "seed 1"

            Expect.equal
                (fst (Random.run 42u (genSnake 5 5 6)))
                [ pt 1 0; pt 1 1; pt 2 1; pt 2 0; pt 3 0; pt 3 1 ]
                "seed 42")

        testCase "genSnake with maxLen 1 is just the head, drawn with two draws" (fun () ->
            let x, s1 = Random.run 0u (Random.intBelow 5)
            let y, s2 = Random.run s1 (Random.intBelow 5)
            Expect.equal (Random.run 0u (genSnake 5 5 1)) ([ pt x y ], s2) "genSnake")

        testCase "genSnake stops early when the walk is stuck: a 1x1 board holds one cell" (fun () ->
            Expect.equal (fst (Random.run 3u (genSnake 1 1 5))) [ pt 0 0 ] "genSnake")

        testCase "genSnake always gives a snake on the board, connected, without overlap, at most maxLen long" (fun () ->
            let ok (snake: Point list) =
                List.length snake >= 1
                && List.length snake <= 8
                && connected snake
                && List.forall (Rules.inBounds (board 4 3)) snake
                && List.length (List.distinct snake) = List.length snake

            Expect.equal (forAll 300 5u ok (genSnake 4 3 8)) (Passed 300) "forAll")

        testCase "every generated state is sane: 500 states of a 5x5 board have no violations" (fun () ->
            Expect.equal (forAll 500 2024u (fun s -> List.isEmpty (violations s)) (genState 5 5)) (Passed 500) "forAll")

        testCase "generated states are Playing, have nothing queued, and vary in length and apple" (fun () ->
            let states, _ = Random.run 2024u (listOf 500 (genState 5 5))
            Expect.all states (fun s -> s.Status = Playing && s.Queued = None && s.Width = 5 && s.Height = 5) "shape"

            Expect.all
                states
                (fun s ->
                    match s.Snake with
                    | [ _ ] -> s.Dir = Right
                    | head :: second :: _ -> Rules.move second s.Dir = head
                    | [] -> false)
                "dir"

            Expect.exists states (fun s -> List.length s.Snake = 1) "a one-cell snake"
            Expect.exists states (fun s -> List.length s.Snake >= 10) "a long snake"
            Expect.exists states (fun s -> s.Apple = None) "no apple"
            Expect.exists states (fun s -> s.Apple <> None) "an apple"
            Expect.exists states (fun s -> s.NextDir <> s.Dir) "a pending turn")

        testCase "generated states start with seed 0, score 0 and frame 0" (fun () ->
            let states, _ = Random.run 2024u (listOf 50 (genState 5 5))
            Expect.all states (fun s -> s.Seed = 0u && s.Score = 0 && s.Frame = 0) "seed, score and frame")

        // ---- a second implementation as an oracle (Exercise 12.7)

        yield! fixtureTests "m03-advance" "advanceSpec agrees with Module 3's advance fixture" (fun c ->
            Expect.equal (advanceSpec (gameState (arg 0 c))) (gameState (expected c)) "advanceSpec")

        testCase "advance and advanceSpec agree on 500 generated states of a 5x5 board" (fun () ->
            Expect.equal (forAll 500 2024u (fun s -> Rules.advance s = advanceSpec s) (genState 5 5)) (Passed 500) "forAll")

        testCase "no invariant sees the wrong collision check of Puzzle 1: every state it produces is sane" (fun () ->
            Expect.equal
                (forAll 500 2024u (fun s -> List.isEmpty (violations (advanceOldSnakeCheck s))) (genState 5 5))
                (Passed 500)
                "forAll")

        testCase "comparing with advanceSpec catches the wrong collision check: the head was moving onto the tail" (fun () ->
            match forAll 500 2024u (fun s -> advanceOldSnakeCheck s = advanceSpec s) (genState 5 5) with
            | Passed runs -> failtest $"expected a failure, got Passed {runs}"
            | Failed(run, _, s) ->
                Expect.equal run 21 "run"
                Expect.equal (Rules.move (List.head s.Snake) s.NextDir) (List.last s.Snake) "onto the tail"
                Expect.equal (advanceOldSnakeCheck s).Status GameOver "the mutant ends the game"
                Expect.equal (advanceSpec s).Status Playing "the rules do not")
    ]