American Checkers with AI

Question

This is the third question in the series. Number 1 had most of the official two-player rules implemented, and Number 2 was the basic UI. This one has the complete two-player rules implemented, an AI using minimax with alpha-beta pruning. All suggestions welcome, especially those that help me program in a more functionally and more cleanly.

Checkers.fs contains my basic types:

module public Checkers.Types
type Player = Black | White

type PieceType = Checker | King

type Coord = { Row :int; Column :int }

let offset c1 c2 =
        { Row = c1.Row + c2.Row; Column = c1.Column + c2.Column }

type Move = Coord List

type MoveTree = { Move :Move; Parent :Option<MoveTree>; Children :Option<List<MoveTree>> }

type internal AlphaBetaMove = { Alpha :float Option; Beta :float Option; Move :Move }

Piece.fs contains the information on a piece:

module public Checkers.Piece
open Checkers.Types

type Piece = { Player :Player; PieceType :PieceType }

let Promote piece = { Player = piece.Player; PieceType = King }

let whiteChecker = Some <| { Player = White; PieceType = Checker }
let whiteKing = Some <| { Player = White; PieceType = King }

let blackChecker = Some <| { Player = Black; PieceType = Checker }
let blackKing = Some <| { Player = Black; PieceType = King }

Board.fs contains a type alias and some helper methods:

module public Checkers.Board
open Checkers.Types
open Checkers.Piece
open System.Collections.Generic

type Board = Piece option list list

let square (coord :Coord) = List.item coord.Row >> List.item coord.Column

let rowFromSeq (value :'a seq) =
    Some (List.ofSeq value)

let listFromSeq (value :'a seq seq) =
    List.ofSeq (Seq.choose rowFromSeq value)

let defaultBoard = 
    [
        List.replicate 4 [None; blackChecker] |> List.concat
        List.replicate 4 [blackChecker; None] |> List.concat
        List.replicate 4 [None; blackChecker] |> List.concat
        List.replicate 8 None
        List.replicate 8 None
        List.replicate 4 [whiteChecker; None] |> List.concat
        List.replicate 4 [None; whiteChecker] |> List.concat
        List.replicate 4 [whiteChecker; None] |> List.concat
    ]

FSharpExtensions.fs contains a few functions that will be used by all the variants:

module internal Checkers.FSharpExtensions
open Checkers
open Checkers.Types
open System

let internal getJumpedCoord startCoord endCoord =
    { Row = startCoord.Row - Math.Sign(startCoord.Row - endCoord.Row); Column = startCoord.Column - Math.Sign(startCoord.Column - endCoord.Column) }

let internal moveIsDiagonal startCoord endCoord =
    startCoord <> endCoord &&
    System.Math.Abs(startCoord.Row - endCoord.Row) = System.Math.Abs(startCoord.Column - endCoord.Column)

let internal otherPlayer player =
    match player with
    | White -> Black
    | Black -> White

AmericanCheckers.fs contains the logic for American Checkers (or English Draughts, if you prefer):

module internal Checkers.Variants.AmericanCheckers
open Checkers.Types
open Checkers.Piece
open Checkers.Board
open Checkers.FSharpExtensions
open System
open System.Collections.Generic

[<Literal>]
let Rows = 7

[<Literal>]
let Columns = 7

let internal kingRowIndex(player) =
    match player with
    | Player.Black -> Rows
    | Player.White -> 0

let internal coordExists coord =
    coord.Row >= 0 && coord.Row <= Rows &&
    coord.Column >= 0 && coord.Column <= Columns

let internal checkMoveDirection piece startCoord endCoord =
    match piece.PieceType with
    | PieceType.Checker ->
        match piece.Player with
        | Player.Black -> startCoord.Row < endCoord.Row
        | Player.White -> startCoord.Row > endCoord.Row
    | PieceType.King -> true

let internal isValidCheckerHop startCoord endCoord (board :Board) =
    let piece = (square startCoord board).Value

    checkMoveDirection piece startCoord endCoord &&
    (square endCoord board).IsNone

let internal isValidKingHop endCoord (board :Board) =
    (square endCoord board).IsNone

let internal isValidCheckerJump startCoord endCoord (board :Board) =
    let piece = (square startCoord board).Value

    let jumpedCoord = getJumpedCoord startCoord endCoord
    let jumpedPiece = square jumpedCoord board

    checkMoveDirection piece startCoord endCoord &&
    (square endCoord board).IsNone &&
    jumpedPiece.IsSome &&
    jumpedPiece.Value.Player <> piece.Player

let internal isValidKingJump startCoord endCoord (board :Board) =
    let piece = (square startCoord board).Value

    let jumpedCoord = getJumpedCoord startCoord endCoord
    let jumpedPiece = square jumpedCoord board

    (square endCoord board).IsNone &&
    jumpedPiece.IsSome &&
    jumpedPiece.Value.Player <> piece.Player

let internal isValidHop startCoord endCoord (board :Board) =
    match (square startCoord board).Value.PieceType with
    | PieceType.Checker -> isValidCheckerHop startCoord endCoord board
    | PieceType.King -> isValidKingHop endCoord board

let internal isValidJump startCoord endCoord (board :Board) =
    match (square startCoord board).Value.PieceType with
    | PieceType.Checker -> isValidCheckerJump startCoord endCoord board
    | PieceType.King -> isValidKingJump startCoord endCoord board

let internal hasValidHop startCoord (board :Board) =
    let hopCoords =
        [
            offset startCoord {Row = -1; Column = 1};
            offset startCoord {Row = -1; Column = -1};
            offset startCoord {Row = 1; Column = 1};
            offset startCoord {Row = 1; Column = -1}
        ]

    let flattenedList = seq {
        for coord in hopCoords do
        yield coordExists coord && isValidHop startCoord coord board }

    flattenedList |> Seq.exists id

let internal hasValidJump startCoord (board :Board) =
    let jumpCoords =
        [
            offset startCoord {Row = -2; Column = 2};
            offset startCoord {Row = -2; Column = -2};
            offset startCoord {Row = 2; Column = 2};
            offset startCoord {Row = 2; Column = -2}
        ]

    let flattenedList = seq {
        for coord in jumpCoords do
        yield coordExists coord && isValidJump startCoord coord board }

    flattenedList |> Seq.exists id

let internal jumpAvailable player (board :Board) =
    let pieceHasJump row column =
        let piece = board.[row].[column]
        piece.IsSome && piece.Value.Player = player && hasValidJump { Row = row; Column = column } board

    let flattenedList = seq {
        for row in 0 .. Rows do
        for column in 0 .. Columns do
        yield (pieceHasJump row column) }

    flattenedList |> Seq.exists id

let internal moveAvailable (board :Board) player =
    let pieceHasMove row column =
        let piece = board.[row].[column]
        piece.IsSome &&
        piece.Value.Player = player &&
        (hasValidJump { Row = row; Column = column } board || hasValidHop { Row = row; Column = column } board)

    let flattenedList = seq {
        for row in 0 .. Rows do
        for column in 0 .. Columns do
        yield (pieceHasMove row column) }

    flattenedList |> Seq.exists id

let isWon (board :Board) =
    match (moveAvailable board) with
    | x when not <| x White -> Some Black
    | x when not <| x Black -> Some White
    | _ -> None

let internal setPieceAt coord piece (board :Board) =
    let boardItems = List.init (Rows + 1) (fun row ->
        match row with
        | i when i = coord.Row ->
            List.init (Columns + 1) (fun col ->
                match col with
                | j when j = coord.Column -> piece
                | _ -> board.[row].[col]
            )
        | _ -> board.[row]
    )

    boardItems

let internal jump startCoord endCoord (board :Board) =
    let kingRowIndex = kingRowIndex((square startCoord board).Value.Player)

    let piece =
        match endCoord.Row with
        | row when row = kingRowIndex -> Some <| Promote (square startCoord board).Value
        | _ -> (square startCoord board)

    let jumpedCoord = getJumpedCoord startCoord endCoord

    board
    |> setPieceAt startCoord None
    |> setPieceAt endCoord piece
    |> setPieceAt jumpedCoord None

let internal hop startCoord endCoord (board :Board) =
    let kingRowIndex = kingRowIndex (square startCoord board).Value.Player

    let piece =
        match endCoord.Row with
        | row when row = kingRowIndex -> Some <| Promote (square startCoord board).Value
        | _ -> (square startCoord board)

    board
    |> setPieceAt startCoord None
    |> setPieceAt endCoord piece

let internal playerTurnEnds (move :Move) (originalBoard :Board) (currentBoard :Board) =
    let lastMoveWasJump = Math.Abs(move.[0].Row - move.[1].Row) = 2
    let pieceWasPromoted = (square (List.last move) currentBoard).Value.PieceType = King &&
                            (square move.[0] originalBoard).Value.PieceType = Checker

    pieceWasPromoted ||
    not (lastMoveWasJump && hasValidJump (List.last move) currentBoard)

let public isValidMove startCoord endCoord (board :Board) =
    coordExists startCoord &&
    coordExists endCoord &&
    moveIsDiagonal startCoord endCoord &&
    (square startCoord board).IsSome &&
    match Math.Abs(startCoord.Row - endCoord.Row) with
    | 1 -> isValidHop startCoord endCoord board && not <| jumpAvailable (square startCoord board).Value.Player board
    | 2 -> isValidJump startCoord endCoord board
    | _ -> false

let public movePiece startCoord endCoord (board :Board) :Option<Board> =
    match isValidMove startCoord endCoord board with
    | false -> None
    | true ->
        match Math.Abs(startCoord.Row - endCoord.Row) with
        | 1 -> Some <| hop startCoord endCoord board
        | 2 -> Some <| jump startCoord endCoord board
        | _ -> None

let rec public moveSequence (coordinates :Coord seq) (board :Option<Board>) =
    let coords = List.ofSeq(coordinates)

    match board with
    | None -> None
    | Some b ->
        match coords.Length with
        | b when b >= 3 ->
            let newBoard = movePiece coords.Head coords.[1] board.Value
            moveSequence coords.Tail newBoard
        | _ -> movePiece coords.Head coords.[1] board.Value

let internal uncheckedMovePiece startCoord endCoord (board :Board) =
    match Math.Abs(startCoord.Row - endCoord.Row) with
    | 1 -> hop startCoord endCoord board
    | 2 -> jump startCoord endCoord board

let rec internal uncheckedMoveSequence (coordinates :Coord seq) (board :Board) =
    let coords = List.ofSeq(coordinates)

    match coords.Length with
    | b when b >= 3 ->
        let newBoard = uncheckedMovePiece coords.Head coords.[1] board
        uncheckedMoveSequence coords.Tail newBoard
    | _ -> uncheckedMovePiece coords.Head coords.[1] board

AmericanCheckersAI.fs contains the variant-specific logic for AI:

module Checkers.AIs.AmericanCheckersAI
open Checkers.Board
open Checkers.Variants.AmericanCheckers
open Checkers.Types
open System

let checkerWeights =
    [[0.0; 3.20; 0.0; 3.20; 0.0; 3.20; 0.0; 3.10];
    [1.15; 0.0; 1.05; 0.0; 1.0; 0.0; 1.10; 0.0];
    [0.0; 1.10; 0.0; 1.0; 0.0; 1.05; 0.0; 1.15];
    [1.15; 0.0; 1.05; 0.0; 1.0; 0.0; 1.10; 0.0];
    [0.0; 1.10; 0.0; 1.0; 0.0; 1.05; 0.0; 1.15];
    [1.15; 0.0; 1.05; 0.0; 1.0; 0.0; 1.10; 0.0];
    [0.0; 1.10; 0.0; 1.0; 0.0; 1.05; 0.0; 1.15];
    [3.10; 0.0; 3.20; 0.0; 3.20; 0.0; 3.20; 0.0]]

let kingWeights =
    [[0.0; 1.05; 0.0; 1.0; 0.0; 1.0; 0.0; 1.0];
    [1.05; 0.0; 1.10; 0.0; 1.05; 0.0; 1.05; 0.0];
    [0.0; 1.10; 0.0; 1.15; 0.0; 1.10; 0.0; 1.0];
    [1.0; 0.0; 1.15; 0.0; 1.20; 0.0; 1.05; 0.0];
    [0.0; 1.05; 0.0; 1.20; 0.0; 1.15; 0.0; 1.0];
    [1.0; 0.0; 1.10; 0.0; 1.15; 0.0; 1.10; 0.0];
    [0.0; 1.05; 0.0; 1.05; 0.0; 1.10; 0.0; 1.05];
    [1.0; 0.0; 1.0; 0.0; 1.0; 0.0; 1.05; 0.0]]

let isPlayerPiece player coord (board :Board) =
    let piece = square coord board
    piece.IsSome && player = piece.Value.Player

let nextPoint coord =
    match coord with
    | c when c.Row = Rows && c.Column = Columns -> None
    | c when c.Column = Columns -> Some {Row = c.Row + 1; Column = 0}
    | _ -> Some {coord with Column = coord.Column + 1}

let calculateCheckerWeight coord (board :Board) =
    let piece = (square coord board).Value
    let kingRow = kingRowIndex piece.Player

    let weight = 8.0 - (float <| Math.Abs(kingRow - coord.Row)) + (square coord checkerWeights)
    match piece.Player with
    | Black -> weight
    | White -> -weight

let calculateKingWeight coord (board :Board) =
    let piece = (square coord board).Value
    let weight = 8.0 + (square coord kingWeights)

    match piece.Player with
    | Black -> weight
    | White -> -weight

let calculatePieceWeight coord (board :Board) =
    let piece = square coord board
    match piece.Value.PieceType with
    | Checker -> calculateCheckerWeight coord board
    | King -> calculateKingWeight coord board

let calculateWeight player (board :Board) =
    let rec loop (weight :float) coord :float =
        match nextPoint coord with
        | Some c ->
            match isPlayerPiece player coord board with
            | true -> loop (weight + (calculatePieceWeight coord board)) c
            | false -> loop weight c
        | None -> weight

    loop 0.0 {Row = 0; Column = 0}

let calculateWeightDifference (board :Board) =
    let rec loop (weight :float) coord =
        match nextPoint coord with
        | Some c ->
            let piece = square coord board
            match piece.IsSome with
            | true -> loop (weight + (calculatePieceWeight coord board)) c
            | false -> loop weight c
        | None -> weight

    loop 0.0 {Row = 0; Column = 0}

let checkerJumps player =
    match player with
    | White -> [{Row = -2; Column = -2}; {Row = -2; Column = 2}]
    | Black -> [{Row = 2; Column = -2}; {Row = 2; Column = 2}]

let kingJumps player =
    (checkerJumps player) @
        (match player with
        | White -> [{Row = 2; Column = -2}; {Row = 2; Column = 2}]
        | Black -> [{Row = -2; Column = -2}; {Row = -2; Column = 2}])

let checkerHops player =
    match player with
    | White -> [{Row = -1; Column = -1}; {Row = -1; Column = 1}]
    | Black -> [{Row = 1; Column = -1}; {Row = 1; Column = 1}]

let kingHops player =
    (checkerHops player) @
        (match player with
        | White -> [{Row = 1; Column = -1}; {Row = 1; Column = 1}]
        | Black -> [{Row = -1; Column = -1}; {Row = -1; Column = 1}])

let getPieceSingleJumps coord (board :Board) =
    let piece = (square coord board).Value
    let moves = 
        match piece.PieceType with
        | Checker -> checkerJumps piece.Player
        | King -> kingJumps piece.Player

    let hops = List.ofSeq (seq {
        for move in moves do
        let endCoord = offset coord move
        yield
            match coordExists endCoord && isValidJump coord endCoord board with
            | true -> Some [coord; endCoord]
            | false -> None })

    List.map (fun (item :Option<Move>) -> item.Value) (List.where (fun (item :Option<Move>) -> item.IsSome) hops)

let rec createMoveTree (move :Move) (board :Board) =
    let moveTree =
        {
            Move = move;
            Parent = None;
            Children =
                let newBoard = if move.Length = 1 then board else uncheckedMoveSequence move board

                let newJumps = getPieceSingleJumps (List.last move) newBoard
                let newMoveEndCoords = List.map (fun item -> List.last item) newJumps

                let oldPieceType = (square move.Head board).Value.PieceType
                let newPieceType = (square (List.last move) newBoard).Value.PieceType

                match newMoveEndCoords.IsEmpty || (oldPieceType = Checker && newPieceType = King) with
                | false ->
                    let moves = List.map (fun (item :Coord) -> move @ [item]) newMoveEndCoords
                    let children = List.map (fun item -> createMoveTree item board) moves
                    Some children
                | true -> None
        }

    moveTree

let getPieceJumps coord (board :Board) =
    let moves = new System.Collections.Generic.List<Move>()

    let rec loop (moveTree :MoveTree) =
        match moveTree.Children with
        | None -> moves.Add(moveTree.Move)
        | Some t -> List.iter (fun item -> (loop item)) t

    let moveTree = createMoveTree [coord] board
    match moveTree.Children with
    | Some t -> loop <| createMoveTree [coord] board
    | None -> ()

    List.ofSeq moves

let getPieceHops coord (board :Board) =
    let piece = (square coord board).Value
    let moves = 
        match piece.PieceType with
        | Checker -> checkerHops piece.Player
        | King -> kingHops piece.Player

    let hops = List.ofSeq (seq {
        for move in moves do
        let endCoord = offset coord move
        yield
            match coordExists endCoord && isValidHop coord endCoord board with
            | true -> Some [coord; endCoord]
            | false -> None })

    List.map (fun (item :Option<Move>) -> item.Value) (List.where (fun (item :Option<Move>) -> item.IsSome) hops)

let calculateMoves player (board :Board) =
    let rec loop jumpAcc hopAcc coord =
        match isPlayerPiece player coord board with
        | true ->
            let newJumpAcc = getPieceJumps coord board @ jumpAcc
            match newJumpAcc with
            | [] ->
                let newHopAcc = getPieceHops coord board @ hopAcc
                match nextPoint coord with
                | Some c -> loop newJumpAcc newHopAcc c
                | None -> newHopAcc
            | _ ->
                match nextPoint coord with
                | Some c -> loop newJumpAcc [] c
                | None -> newJumpAcc
        | false ->
            match nextPoint coord with
            | Some c -> loop jumpAcc hopAcc c
            | None -> jumpAcc @ hopAcc

    loop [] [] {Row = 0; Column = 0}

GameController.fs contains the state of the game as a whole. In the future, this will be expanded to tracking move history and other relevant information.

module public Checkers.GameController
open Checkers.Types
open Checkers.Board

type GameController = { Board :Board; CurrentPlayer :Player; CurrentCoord :Option<Coord> }

let newGame = { Board = Board.defaultBoard; CurrentPlayer = Black; CurrentCoord = None }

Minimax.fs contains the general logic for the AI's. This module contains some very nasty code, including a few mutable variables. I'm sure my other code is a mess as well, but I'd like special attention for this.

module internal Checkers.Minimax
open Checkers.Types
open Checkers.Board
open Checkers.FSharpExtensions
open Checkers.Variants.AmericanCheckers
open Checkers.AIs.AmericanCheckersAI

let rec internal bestMatchInList player highestDifference moveForHighestDifference (list :List<float * Move>) =
    let head::tail = list
    let weight = fst head

    let newMoveForHighestDifference =
        match player with
        | Black -> match weight > highestDifference with
                   | true -> snd head
                   | false -> moveForHighestDifference
        | White -> match weight < highestDifference with
                   | true -> snd head
                   | false -> moveForHighestDifference

    let newHighestDifference =
        (highestDifference, weight)
        ||> match player with
            | Black -> max
            | White -> min

    match tail with
    | [] -> (highestDifference, newMoveForHighestDifference)
    | _ -> bestMatchInList player newHighestDifference newMoveForHighestDifference list.Tail

let internal chooseNewAlpha currentAlpha (candidateAlpha :float Option) =
    match currentAlpha with
    | Some x -> if candidateAlpha.IsSome then Some <| max x candidateAlpha.Value else currentAlpha
    | None -> candidateAlpha

let internal chooseNewBeta currentBeta (candidateBeta :float Option) =
    match currentBeta with
    | Some x -> if candidateBeta.IsSome then Some <| min x candidateBeta.Value else currentBeta
    | None -> candidateBeta

let rec minimax player searchDepth alpha beta (board :Board) =
    match searchDepth = 0 || (isWon board).IsSome with
    | true ->
        let weightDifference = Some <| calculateWeightDifference board

        let newAlpha = if player = Black then weightDifference else alpha
        let newBeta = if player = White then weightDifference else beta

        { Alpha = newBeta; Beta = newAlpha; Move = [] }
    | false ->
        let moves = calculateMoves player board
        let mutable alphaForNode = None
        let mutable betaForNode = None

        let mutable newAlpha = alpha
        let mutable newBeta = beta
        let mutable move = []

        if searchDepth <> 0 then
            ignore <| List.map (fun x -> if newAlpha.IsNone || newBeta.IsNone || newAlpha.Value < newBeta.Value then
                                             let newBoard = uncheckedMoveSequence x board
                                             let alphaBetaMove = minimax (otherPlayer player) (searchDepth - 1) alphaForNode betaForNode newBoard

                                             match player with
                                             | Black ->
                                                 alphaForNode <- chooseNewAlpha alphaForNode alphaBetaMove.Alpha
                                                 newAlpha <- chooseNewAlpha newAlpha alphaForNode
                                                 move <- if newAlpha = alphaBetaMove.Alpha then x else move
                                             | White ->
                                                 betaForNode <- chooseNewBeta betaForNode alphaBetaMove.Beta
                                                 newBeta <- chooseNewBeta newBeta betaForNode
                                                 move <- if newBeta = alphaBetaMove.Beta then x else move

                                         ())
                               moves

        { Alpha = betaForNode; Beta = alphaForNode; Move = move }

PublicAPI.fs is really kind of a wrapper that containing methods that are meant to be called from outside the library. On this note, note that all the internal methods are really meant to be private to the class, but xUnit doesn't support Portable Class Libraries (PCLs), so I need to expose them to the test library.

module public Checkers.PublicAPI
open Checkers.Variants
open Checkers.Types
open Checkers.Board
open Checkers.FSharpExtensions
open Checkers.Variants.AmericanCheckers
open Checkers.Minimax
open Checkers.GameController
open System

let isValidMove startCoord endCoord gameController =
    isValidMove startCoord endCoord gameController.Board &&
    (square startCoord gameController.Board).Value.Player = gameController.CurrentPlayer &&
    match gameController.CurrentCoord with
    | None -> true
    | coord -> startCoord = coord.Value

let movePiece startCoord endCoord gameController :Option<GameController> =
    let board = movePiece startCoord endCoord gameController.Board

    match (isValidMove startCoord endCoord gameController) with
    | true -> Some <|
                {
                    Board = board.Value;
                    CurrentPlayer = match playerTurnEnds [startCoord; endCoord] gameController.Board board.Value with
                                    | true -> otherPlayer gameController.CurrentPlayer
                                    | false -> gameController.CurrentPlayer        
                    CurrentCoord = match playerTurnEnds [startCoord; endCoord] gameController.Board board.Value with
                                   | true -> None
                                   | false -> Some endCoord
                }
    | false -> None

let move (move :Coord seq) (gameController) :Option<GameController> =
    let board = moveSequence move (Some gameController.Board)
    match board with
    | Some b -> Some <|
                {
                    Board = board.Value;
                    CurrentPlayer = match playerTurnEnds (List.ofSeq move) gameController.Board board.Value with
                                    | true -> otherPlayer gameController.CurrentPlayer
                                    | false -> gameController.CurrentPlayer        
                    CurrentCoord = match playerTurnEnds (List.ofSeq move) gameController.Board board.Value with
                                   | true -> None
                                   | false -> Some (Seq.last move)
                }
    | None -> None

let getMove searchDepth gameController =
    (minimax gameController.CurrentPlayer searchDepth None None gameController.Board).Move

let isWon controller =
    isWon controller.Board

Answer 1

I don't like these at all:

let internal chooseNewAlpha currentAlpha (candidateAlpha :float Option) =
    match currentAlpha with
    | Some x -> if candidateAlpha.IsSome then Some <| max x candidateAlpha.Value else currentAlpha
    | None -> candidateAlpha

let internal chooseNewBeta currentBeta (candidateBeta :float Option) =
    match currentBeta with
    | Some x -> if candidateBeta.IsSome then Some <| min x candidateBeta.Value else currentBeta
    | None -> candidateBeta

In our chat you state you were told to use if when matching against a simple boolean (there's no specific reason to use it over match, or match over it for that situation, so I'll not comment on that) but you can rewrite that with one match instead of a match with a nested if:

let internal chooseNewAlpha currentAlpha (candidateAlpha :float Option) =
    match (currentAlpha, candidateAlpha) with
    | (Some current, Some candidate) -> Some <| max current candidate
    | (Some current, None) -> Some current
    | (None, Some candidate) -> Some candidate
    | _ -> None

let internal chooseNewBeta currentBeta (candidateBeta :float Option) =
    match (currentBeta, candidateBeta) with
    | (Some current, Some candidate) -> Some <| min current candidate
    | (Some current, None) -> Some current
    | (None, Some candidate) -> Some candidate
    | _ -> None

Why match with a Tuple? Because current and candidate are codependent: each one can affect the result of the other. So we want to take both into account idiomatically.

---

let internal moveIsDiagonal startCoord endCoord =
    startCoord <> endCoord &&
    System.Math.Abs(startCoord.Row - endCoord.Row) = System.Math.Abs(startCoord.Column - endCoord.Column)

F# has an abs method: startCoord <> endCoord && abs (startCoord.Row - endCoord.Row) = abs (startCoord.Column - endCoord.Column).

---

I would consider a refactor:

[<Literal>]
let Rows = 7

[<Literal>]
let Columns = 7

You use Rows and 0 in the same place, but now 0 doesn't make sense.

let internal kingRowIndex(player) =
    match player with
    | Player.Black -> Rows
    | Player.White -> 0

You should have:

[<Literal>]
Rows = 8

[<Literal>]
Columns = 8

[<Literal>]
FirstRow = 0

[<Literal>]
LastRow = Rows - 1

[<Literal>]
FirstColumn = 0

[<Literal>]
LastColumn = Columns - 1

Thus we have:

let internal kingRowIndex(player) =
    match player with
    | Player.Black -> LastRow
    | Player.White -> FirstRow

---

Some of your functions can take advantage of function composition:

let internal isValidJump startCoord endCoord (board :Board) =
    match (square startCoord board).Value.PieceType with
    | PieceType.Checker -> isValidCheckerJump startCoord endCoord board
    | PieceType.King -> isValidKingJump startCoord endCoord board

Could be something like:

let internal isValidJump startCoord endCoord (board:Board) =
    let jumpFunc =
        match (square startCoord board).Value.PieceType with
        | PieceType.Checker -> isValidCheckerJump
        | PieceType.King -> isValidKingJump

    jumpFunc startCoord endCoord board

---

let getPieceHops coord (board :Board) =
    let piece = (square coord board).Value
    let moves = 
        match piece.PieceType with
        | Checker -> checkerHops piece.Player
        | King -> kingHops piece.Player

    let hops = List.ofSeq (seq {
        for move in moves do
        let endCoord = offset coord move
        yield
            match coordExists endCoord && isValidHop coord endCoord board with
            | true -> Some [coord; endCoord]
            | false -> None })

    List.map (fun (item :Option<Move>) -> item.Value) (List.where (fun (item :Option<Move>) -> item.IsSome) hops)

Boy is that a mess.

You use a for loop (not F# idiomatic), filter in the for loop and return either None or Some, then use a List.map on a List.where to filter only the Some values and return the actual value.

You use a List.where, which is a synonym for List.filter (which is the preferred method), and the worst part is you use it on a list that could have already been filtered.

let getPieceHops coord (board :Board) =
    let piece = (square coord board).Value
    let moves = 
        match piece.PieceType with
        | Checker -> checkerHops piece.Player
        | King -> kingHops piece.Player

    let hopsFilter = List.filter (fun (head::tail) ->
        let startCoord = head
        let endCoord = tail |> List.head
        coordExists endCoord && isValidHop startCoord endCoord board)

    moves |> List.map (fun move -> [coord; offset coord move]) |> hopsFilter

We eliminated multiple excessive methods, and return the same thing you did initially. (Or should have.)

---

I've finally had time to review minimax, and I think this should be a suitable version that uses tail-call recursion and should do what you want.

Do note I've not tested this at all yet, this was a rewrite in Notepad. Something like the following should work, though you've mentioned to me in chat, so I've updated it substantially.

let rec minimax player searchDepth alpha beta (board:Board) =
    match searchDepth = 0 || (isWon board).IsSome with
    | true ->
        let weightDifference = Some <| calculateWeightDifference board
        let newAlpha = 
            match player with
            | Black -> weightDifference
            | _ -> alpha
        let newBeta =
            match player with
            | White -> weightDifference
            | _ -> beta
        { Alpha = newBeta; Beta = newAlpha; Move = [] }
    | false ->
        let rec loop alphaForNode betaForNode newAlpha newBeta move moves =
            match List.isEmpty moves with
            | true -> { Alpha = betaForNode; Beta = alphaForNode; Move = move }
            | false ->
                let currentMove = moves |> List.head

                match newAlpha.IsNone || newBeta.IsNone || newAlpha.Value < newBeta.Value with
                | false -> loop alphaForNode betaForNode newAlpha newBeta move (moves |> List.tail)
                | true ->
                    let newBoard = uncheckedMoveSequence currentMove board
                    let alphaBetaMove = minimax (otherPlayer player) (searchDepth - 1) alphaForNode betaForNode newBoard

                    match player with
                    | Black ->
                        let newAlphaForNode = chooseNewAlpha alphaForNode alphaBetaMove.Alpha
                        let newNewAlpha = choseNewAlpha newAlpha newAlphaForNode
                        let newMove = 
                            match newNewAlpha with
                            | a when a = alphaBetaMove.Alpha -> currentMove
                            | _ -> move
                        loop newAlphaForNode betaForNode newNewAlpha newBeta newMove (moves |> List.tail)
                    | White ->
                        let newBetaForNode = chooseNewBeta betaForNode alphaBetaMove.Beta
                        let newNewBeta = chooseNewBeta newBeta newBetaForNode
                        let newMove =
                            match newNewBeta with
                            | b when b = alphaBetaMove.Beta -> currentMove
                            | _ -> move
                        loop alphaForNode newBetaForNode newAlpha newNewBeta newMove (moves |> List.tail)
        let moves = calculateMoves player board
        loop None None alpha beta [] moves

Of course that's huge and does a lot of stuff. We obviously want to break it down.

So we'll extract our match player with to use some methods, function composition, etc.

It's still long, but it's slightly more maintainable.

let rec minimax player searchDepth alpha beta (board:Board) =
    match searchDepth = 0 || (isWon board).IsSome with
    | true ->
        let weightDifference = Some <| calculateWeightDifference board
        let newAlpha = 
            match player with
            | Black -> weightDifference
            | _ -> alpha
        let newBeta =
            match player with
            | White -> weightDifference
            | _ -> beta
        { Alpha = newBeta; Beta = newAlpha; Move = [] }
    | false ->
        let getNewValueAndMove chooseMethod nodeValue moveValue currentValue currentMove newMove =
            let newNodeValue = chooseMethod nodeValue moveValue
            let newValue = chooseMethod currentValue newNodeValue
            let finalMove = 
                match newValue with
                | a when a = moveValue -> currentMove
                | _ -> newMove
            (newNodeValue, newValue, finalMove)

        let rec loop alphaForNode betaForNode newAlpha newBeta move moves =
            match List.isEmpty moves with
            | true -> { Alpha = betaForNode; Beta = alphaForNode; Move = move }
            | false ->
                let currentMove = moves |> List.head

                match newAlpha.IsNone || newBeta.IsNone || newAlpha.Value < newBeta.Value with
                | false -> loop alphaForNode betaForNode newAlpha newBeta move (moves |> List.tail)
                | true ->
                    let newBoard = uncheckedMoveSequence currentMove board
                    let alphaBetaMove = minimax (otherPlayer player) (searchDepth - 1) alphaForNode betaForNode newBoard

                    match player with
                    | Black ->
                        let (newAlphaForNode, newNewAlpha, newMove) = getNewValueAndMove chooseNewAlpha alphaForNode alphaBetaMove.Alpha newAlpha currentMove move
                        loop newAlphaForNode betaForNode newNewAlpha newBeta newMove (moves |> List.tail)
                    | White ->
                        let (newBetaForNode, newNewBeta, newMove) = getNewValueAndMove chooseNewBeta betaForNode alphaBetaMove.Beta newBeta currentMove move
                        loop alphaForNode newBetaForNode newAlpha newNewBeta newMove (moves |> List.tail)
        loop None None alpha beta [] (calculateMoves player board)

---

Finally, PublicAPI: I hate the whitespace there, the way you indented that.

Generally, if I have to multi-line things like that I line break and then start indentation.

let movePiece startCoord endCoord gameController :Option<GameController> =
    let board = movePiece startCoord endCoord gameController.Board
    match (isValidMove startCoord endCoord gameController) with
    | false -> None
    | true ->
        Some <|
        {
            Board = board.Value;
            CurrentPlayer =
                match playerTurnEnds [startCoord; endCoord] gameController.Board board.Value with
                | true -> otherPlayer gameController.CurrentPlayer
                | false -> gameController.CurrentPlayer        
            CurrentCoord =
                match playerTurnEnds [startCoord; endCoord] gameController.Board board.Value with
                | true -> None
                | false -> Some endCoord
        }

let move (move :Coord seq) (gameController) :Option<GameController> =
    let board = moveSequence move (Some gameController.Board)
    match board with
    | None -> None
    | Some b ->
        Some <|
        {
            Board = board.Value;
            CurrentPlayer =
                match playerTurnEnds (List.ofSeq move) gameController.Board board.Value with
                | true -> otherPlayer gameController.CurrentPlayer
                | false -> gameController.CurrentPlayer        
            CurrentCoord =
                match playerTurnEnds (List.ofSeq move) gameController.Board board.Value with
                | true -> None
                | false -> Some (Seq.last move)
        }

It's a lot easier to follow. I also tend to put the single-line match patterns at the top, where it allows, so that there's not one line underneath a massive block like that just hanging out.

---

Overall it was quite good, excepting the few idiomatic issues.

Answer 2

let internal hasValidJump startCoord (board :Board) =
    let jumpCoords =
        [
            offset startCoord {Row = -2; Column = 2};
            offset startCoord {Row = -2; Column = -2};
            offset startCoord {Row = 2; Column = 2};
            offset startCoord {Row = 2; Column = -2}
        ]

    let flattenedList = seq {
        for coord in jumpCoords do
        yield coordExists coord && isValidJump startCoord coord board }

    flattenedList |> Seq.exists id

That iterates jumpCoords and produces a new list of booleans as to whether the conditions match. That new list is then iterated to find if the condition ever returned true. I can make that into one iteration with early return like:

let internal hasValidHop startCoord (board :Board) =
    let hopCoords =
        [
            offset startCoord {Row = -1; Column = 1};
            offset startCoord {Row = -1; Column = -1};
            offset startCoord {Row = 1; Column = 1};
            offset startCoord {Row = 1; Column = -1}
        ]

    let rec anyHopIsValid hops =
        let coord::tail = hops
        match coordExists coord && isValidHop startCoord coord board, tail with
        | true, _ -> true
        | false, [] -> false
        | false, _ -> anyHopIsValid tail

anyHopIsValid hopCoords

I can use the same principles to get rid of my multiple other fors, and noticeable reduce the runtime and make my code follow FP principles better.

---

Having Board be a Piece Option List List is very expensive since looking up an item in a list is \$O(N)\$. Making this into a Piece Option [,] nearly halves the time to calculate a move.