4
\$\begingroup\$

I recently added Pool Checkers to my Checkers game. My main concerns are about how I manage calling the correct variant in my PublicAPI functions. Because this is a library, any public-facing method in PublicAPI can be the starting point, and because I use pure functions, I have to get the information in every function. I'm not sure if I managed this very well, or if I can improve it.

The game rules are in PoolCheckers.fs:

module internal Checkers.Variants.PoolCheckers
open Checkers.Generic
open Checkers.Piece
open Checkers.Board
open Checkers.GameController
open Checkers.FSharpExtensions
open System

[<Literal>]
let Rows = 7

[<Literal>]
let Columns = 7

let newGame = { Variant = Variant.PoolCheckers; Board = Checkers.Board.defaultBoard; CurrentPlayer = Black; InitialPosition = Checkers.Board.defaultFen; MoveHistory = []; CurrentCoord = None }

let internal pdnBoard =
    array2D [
        [None; Some 1; None; Some 2; None; Some 3; None; Some 4];
        [Some 5; None; Some 6; None; Some 7; None; Some 8; None];
        [None; Some 9; None; Some 10; None; Some 11; None; Some 12];
        [Some 13; None; Some 14; None; Some 15; None; Some 16; None];
        [None; Some 17; None; Some 18; None; Some 19; None; Some 20];
        [Some 21; None; Some 22; None; Some 23; None; Some 24; None];
        [None; Some 25; None; Some 26; None; Some 27; None; Some 28];
        [Some 29; None; Some 30; None; Some 31; None; Some 32; None];
    ]

let internal pdnBoardCoords =
    [
        {Row = -1; Column = -1};    // adjust for FEN's 1-based indexing
        {Row = 0; Column = 1}; {Row = 0; Column = 3}; {Row = 0; Column = 5}; {Row = 0; Column = 7};
        {Row = 1; Column = 0}; {Row = 1; Column = 2}; {Row = 1; Column = 4}; {Row = 1; Column = 6};
        {Row = 2; Column = 1}; {Row = 2; Column = 3}; {Row = 2; Column = 5}; {Row = 2; Column = 7};
        {Row = 3; Column = 0}; {Row = 3; Column = 2}; {Row = 3; Column = 4}; {Row = 3; Column = 6};
        {Row = 4; Column = 1}; {Row = 4; Column = 3}; {Row = 4; Column = 5}; {Row = 4; Column = 7};
        {Row = 5; Column = 0}; {Row = 5; Column = 2}; {Row = 5; Column = 4}; {Row = 5; Column = 6};
        {Row = 6; Column = 1}; {Row = 6; Column = 3}; {Row = 6; Column = 5}; {Row = 6; Column = 7};
        {Row = 7; Column = 0}; {Row = 7; Column = 2}; {Row = 7; Column = 4}; {Row = 7; Column = 6};
    ]

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

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 isJump (move :Move) =
    match abs (move.[0].Row - move.[1].Row) with
    | 1 -> false
    | _ -> true

let internal checkMoveDirection piece startCoord endCoord =
    let isJump = abs (startCoord.Row - endCoord.Row) <> 1
    match piece.PieceType, piece.Player, isJump with
    | Checker, Black, false -> startCoord.Row < endCoord.Row
    | Checker, White, false -> startCoord.Row > endCoord.Row
    | _, _, true -> true
    | 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

    abs (startCoord.Row - endCoord.Row) = 2 &&
    (square endCoord board).IsNone &&
    jumpedPiece.IsSome &&
    jumpedPiece.Value.Player <> piece.Player

let internal isValidKingJump startCoord endCoord (board :Board) =
    let rec checkBetweenCoords currentCoord rowSign colSign =
        let nextCoord = offset currentCoord {Row = rowSign; Column = colSign}
        match currentCoord, nextCoord with
        | _, c when c = endCoord -> true
        | c, _ when (square c board).IsSome -> false
        | _ -> checkBetweenCoords nextCoord rowSign colSign

    let piece = (square startCoord board).Value

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

    let rowSign = Math.Sign(endCoord.Row - startCoord.Row)
    let colSign = Math.Sign(endCoord.Column - startCoord.Column)
    let nextCoord = offset startCoord {Row = rowSign; Column = colSign}

    (checkBetweenCoords nextCoord rowSign colSign) &&
    (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 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

let internal hasValidCheckerJump 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 rec anyJumpIsValid jumps =
        let coord::tail = jumps
        match coordExists coord && isValidJump startCoord coord board, tail with
        | true, _ -> true
        | false, [] -> false
        | false, _ -> anyJumpIsValid tail

    anyJumpIsValid jumpCoords

let internal hasValidKingJump startCoord (board :Board) =
    let jumpCoordOffsets =
        [
            {Row = -1; Column = 1};
            {Row = -1; Column = -1};
            {Row = 1; Column = 1};
            {Row = 1; Column = -1}
        ]

    let currentPlayer = (square startCoord board).Value.Player

    let rec getJumps acc jumpOffsets =
        let rec checkBetweenCoords currentCoord rowSign colSign =
            let nextCoord = offset currentCoord {Row = rowSign; Column = colSign}
            match currentCoord, nextCoord with
            | _, c when not <| coordExists c -> None
            | cc, cn when ((square cc board).IsSome && (square cc board).Value.Player = currentPlayer) || (square cn board).IsSome -> None
            | cc, cn when (square cc board).IsSome && (square cc board).Value.Player <> currentPlayer && (square cn board).IsNone -> Some (offset currentCoord {Row = rowSign; Column = colSign})
            | _ -> checkBetweenCoords nextCoord rowSign colSign

        let head::tail = jumpOffsets
        let jumpCoord = checkBetweenCoords (offset startCoord {Row = head.Row; Column = head.Column}) head.Row head.Column
        let currentJumps =
            match jumpCoord with
            | None -> acc
            | _ -> acc @ [jumpCoord.Value]

        match tail with
        | [] -> currentJumps
        | _ -> getJumps currentJumps tail

    not (getJumps [] jumpCoordOffsets).IsEmpty

let internal hasValidJump startCoord (board :Board) =
    let piece = square startCoord board
    match piece.Value.PieceType with
    | Checker -> hasValidCheckerJump startCoord board
    | King -> hasValidKingJump startCoord board

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 rec loop coord =
        match coord with
        | None -> false
        | Some c ->
            match pieceHasJump c.Row c.Column with
            | true -> true
            | false -> loop (nextPoint c Rows Columns)

    loop <| Some {Row = 0; Column = 0}

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 rec loop coord =
        match coord with
        | None -> false
        | Some c ->
            match pieceHasMove c.Row c.Column with
            | true -> true
            | false -> loop (nextPoint c Rows Columns)

    loop <| Some {Row = 0; Column = 0}

let winningPlayer (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 newBoard = Array2D.copy board

    newBoard.[coord.Row, coord.Column] <- piece
    newBoard

let internal playerTurnEnds (move :Move) (originalBoard :Board) (currentBoard :Board) =
    let lastMoveWasJump = 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 internal jump startCoord endCoord (board :Board) =
    let kingRowIndex = kingRowIndex((square startCoord board).Value.Player)

    let piece = (square startCoord board)
    let jumpedCoord = getJumpedCoord startCoord endCoord

    let currentBoard =
        board
        |> setPieceAt startCoord None
        |> setPieceAt endCoord piece
        |> setPieceAt jumpedCoord None

    if playerTurnEnds [startCoord; endCoord] board currentBoard && endCoord.Row = kingRowIndex then
        setPieceAt endCoord (Some <| Promote piece.Value) currentBoard
    else
        currentBoard

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 public isValidMove startCoord endCoord (board :Board) =
    coordExists startCoord &&
    coordExists endCoord &&
    moveIsDiagonal startCoord endCoord &&
    (square startCoord board).IsSome &&
    match abs(startCoord.Row - endCoord.Row) with
    | 1 -> isValidHop startCoord endCoord board && not <| jumpAvailable (square startCoord board).Value.Player board
    | _-> isValidJump startCoord endCoord board

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

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

    match board with
    | None -> None
    | _ ->
        match coords.Length with
        | c when c >= 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 abs(startCoord.Row - endCoord.Row) with
    | 1 -> hop startCoord endCoord board
    | _ -> 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

The AI-specific stuff is in PoolCheckersAI.fs:

module Checkers.AIs.PoolCheckersAI
open Checkers.Generic
open Checkers.Piece
open Checkers.Board
open Checkers.FSharpExtensions
open Checkers.Variants.PoolCheckers

let checkerWeights =
    array2D [
        [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 =
    array2D [
        [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 calculateCheckerWeight piece coord =
    let kingRow = kingRowIndex piece.Player

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

let calculateKingWeight piece coord =
    let weight = 8.0 + (square coord kingWeights)

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

let calculatePieceWeight piece coord =
    match piece.PieceType with
    | Checker -> calculateCheckerWeight piece coord
    | King -> calculateKingWeight piece coord

let calculateWeight player (board :Board) =
    let rec loop (weight :float) coord :float =
        match nextPoint coord Rows Columns with
        | None -> weight
        | Some c ->
            let piece = square coord board
            match piece with
            | Some p when p.Player = player -> loop (weight + (calculatePieceWeight p coord)) c
            | _ -> loop weight c

    loop 0.0 {Row = 0; Column = 0}

let calculateWeightDifference (board :Board) =
    let rec loop (weight :float) coord =
        match nextPoint coord Rows Columns with
        | None -> weight
        | Some c ->
            let piece = square coord board
            match piece with
            | Some p -> loop (weight + (calculatePieceWeight p coord)) c
            | None -> loop weight c

    loop 0.0 {Row = 0; Column = 0}

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 getCheckerSingleJumps coord (board :Board) =
    let moves = [{Row = -2; Column = -2}; {Row = -2; Column = 2}; {Row = 2; Column = -2}; {Row = 2; Column = 2}]

    let rec loop (acc :Move List) moves =
        let move::tail = moves
        let endCoord = offset coord move
        match coordExists endCoord && isValidJump coord endCoord board, tail with
        | true, [] -> acc @ (List.singleton [coord; endCoord])
        | true, _ -> loop (acc @ (List.singleton [coord; endCoord])) tail
        | false, [] -> acc
        | false, _ -> loop acc tail

    loop [] moves

let getKingSingleJumps startCoord (board :Board) =
    let jumpCoordOffsets =
        [
            {Row = -1; Column = 1};
            {Row = -1; Column = -1};
            {Row = 1; Column = 1};
            {Row = 1; Column = -1}
        ]

    let currentPlayer = (square startCoord board).Value.Player

    let rec getJumps acc jumpOffsets =
        let rec checkBetweenCoords currentCoord rowSign colSign =
            let nextCoord = offset currentCoord {Row = rowSign; Column = colSign}
            match currentCoord, nextCoord with
            | _, c when (not <| coordExists c) -> None
            | c, _ when (square c board).IsSome ->
                match (square c board).Value with
                | p when p.Player = currentPlayer -> None
                | _ when (square nextCoord board).IsSome -> None
                | _ -> Some <| offset currentCoord {Row = rowSign; Column = colSign}
            | _ -> checkBetweenCoords nextCoord rowSign colSign

        let head::tail = jumpOffsets
        let jumpCoord = checkBetweenCoords (offset startCoord {Row = head.Row; Column = head.Column}) head.Row head.Column
        let currentJumps =
            match jumpCoord with
            | None -> acc
            | _ -> acc @ (List.singleton [startCoord; jumpCoord.Value])

        match tail with
        | [] -> currentJumps
        | _ -> getJumps currentJumps tail

    getJumps [] jumpCoordOffsets

let getPieceSingleJumps pieceType coord (board :Board) =
    match pieceType with
    | Checker -> getCheckerSingleJumps coord board
    | King -> getKingSingleJumps coord board

let rec internal createMoveTree pieceType (move :Move) (board :Board) =
    {
        Move = move;
        Children =
            let newBoard =
                match move.Length with
                | 1 -> board
                | _ -> uncheckedMoveSequence move board

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

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

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 pieceType = (square coord board).Value.PieceType
    let moveTree = createMoveTree pieceType [coord] board
    match moveTree.Children with
    | Some _ -> loop moveTree
    | 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 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

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 Rows Columns with
                | Some c -> loop newJumpAcc newHopAcc c
                | None -> newHopAcc
            | _ ->
                match nextPoint coord Rows Columns with
                | Some c -> loop newJumpAcc [] c
                | None -> newJumpAcc
        | false ->
            match nextPoint coord Rows Columns with
            | Some c -> loop jumpAcc hopAcc c
            | None -> jumpAcc @ hopAcc

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

The API distinguishes between them by giving the GameController a Variant field:

type Variant = AmericanCheckers | PoolCheckers

These types are used to create a GameVariant, which is used in GameController to provide the correct value for various calls; this valid is primarily used in PublicAPI:

module Checkers.GameVariant
open Checkers.Generic
open Checkers.Board

type AiMembers =
    {
        uncheckedMoveSequence :Coord seq -> Board -> Board
        calculateMoves :Player -> Board -> Move List
        winningPlayer :Board -> Player Option
        calculateWeightDifference :Board -> float
    }
with
    static member AmericanCheckers =
        {
            uncheckedMoveSequence = Checkers.Variants.AmericanCheckers.uncheckedMoveSequence
            calculateMoves = Checkers.AIs.AmericanCheckersAI.calculateMoves
            winningPlayer = Checkers.Variants.AmericanCheckers.winningPlayer
            calculateWeightDifference = Checkers.AIs.AmericanCheckersAI.calculateWeightDifference
        }
    static member PoolCheckers =
        {
            uncheckedMoveSequence = Checkers.Variants.PoolCheckers.uncheckedMoveSequence
            calculateMoves = Checkers.AIs.PoolCheckersAI.calculateMoves
            winningPlayer = Checkers.Variants.PoolCheckers.winningPlayer
            calculateWeightDifference = Checkers.AIs.PoolCheckersAI.calculateWeightDifference
        }

type PdnMembers =
    {
        pdnBoard :int Option [,]
        pdnBoardCoords :Coord List
    }
with
    static member AmericanCheckers =
        {
            pdnBoard = Checkers.Variants.AmericanCheckers.pdnBoard
            pdnBoardCoords = Checkers.Variants.AmericanCheckers.pdnBoardCoords
        }
    static member PoolCheckers =
        {
            pdnBoard = Checkers.Variants.PoolCheckers.pdnBoard
            pdnBoardCoords = Checkers.Variants.PoolCheckers.pdnBoardCoords
        }

type ApiMembers =
    {
        isValidMove :Coord -> Coord -> Board -> bool
        movePiece :Coord -> Coord -> Board -> Board Option
        moveSequence :Coord seq -> Board Option -> Board Option
        isJump :Move -> bool
        winningPlayer :Board -> Player Option
        playerTurnEnds :Move -> Board -> Board -> bool
    }
with
    static member AmericanCheckers =
        {
            isValidMove = Checkers.Variants.AmericanCheckers.isValidMove
            movePiece = Checkers.Variants.AmericanCheckers.movePiece
            moveSequence = Checkers.Variants.AmericanCheckers.moveSequence
            isJump = Checkers.Variants.AmericanCheckers.isJump
            winningPlayer = Checkers.Variants.AmericanCheckers.winningPlayer
            playerTurnEnds = Checkers.Variants.AmericanCheckers.playerTurnEnds
        }
    static member PoolCheckers =
        {
            isValidMove = Checkers.Variants.PoolCheckers.isValidMove
            movePiece = Checkers.Variants.PoolCheckers.movePiece
            moveSequence = Checkers.Variants.PoolCheckers.moveSequence
            isJump = Checkers.Variants.PoolCheckers.isJump
            winningPlayer = Checkers.Variants.PoolCheckers.winningPlayer
            playerTurnEnds = Checkers.Variants.PoolCheckers.playerTurnEnds
        }

type GameVariant =
    {
        variant :Variant
        aiMembers :AiMembers
        pdnMembers :PdnMembers
        apiMembers :ApiMembers
    }
with
    static member AmericanCheckers =
        {
            variant = AmericanCheckers
            aiMembers = AiMembers.AmericanCheckers
            pdnMembers = PdnMembers.AmericanCheckers
            apiMembers = ApiMembers.AmericanCheckers
        }
    static member PoolCheckers =
        {
            variant = PoolCheckers
            aiMembers = AiMembers.PoolCheckers
            pdnMembers = PdnMembers.PoolCheckers
            apiMembers = ApiMembers.PoolCheckers
        }

This is the modified PublicAPI.fs:

module public Checkers.PublicAPI
open Checkers.Generic
open Checkers.Board
open Checkers.FSharpExtensions
open Checkers.Variants
open Checkers.GameController
open Checkers.PortableDraughtsNotation
open Checkers.GameVariant
open Checkers.Minimax
open System

let getGameVariant variant =
    match variant with
    | AmericanCheckers -> GameVariant.AmericanCheckers
    | PoolCheckers -> GameVariant.PoolCheckers

let pdnBoard variant =
    variant.pdnBoard

let pdnBoardCoords variant =
    variant.pdnBoardCoords

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

let internal getDisplayString variant (pdnTurn :int List) (move :Move) =
    String.Join((if variant.isJump move then "x" else "-"), pdnTurn)

let internal getPdnForMove gameController move boardFen =
    let gameHistory = gameController.MoveHistory
    let pdnMove = (List.map (fun item -> (square item gameController.Variant.pdnMembers.pdnBoard).Value) move)

    let moveNumber =
        match gameController.CurrentPlayer with
        | Black -> gameHistory.Length + 1
        | White -> gameHistory.Length

    let blackMove =
        match gameController.CurrentPlayer with
        | Black -> { Move = pdnMove; ResultingFen = boardFen; DisplayString = getDisplayString gameController.Variant.apiMembers pdnMove move }
        | White -> (List.last gameHistory).BlackMove

    let whiteMove =
        match gameController.CurrentPlayer with
        | Black -> None
        | White -> Some { Move = pdnMove; ResultingFen = boardFen; DisplayString = getDisplayString gameController.Variant.apiMembers pdnMove move }

    {MoveNumber = moveNumber; BlackMove = blackMove; WhiteMove = whiteMove}

let internal getPdnForContinuedMove gameController move boardFen =
    let gameHistory = gameController.MoveHistory

    let lastMovePdn = List.last gameHistory
    let pdnMove = (List.map (fun item -> (square item gameController.Variant.pdnMembers.pdnBoard).Value) move)

    let moveNumber = lastMovePdn.MoveNumber

    let blackMove =
        match gameController.CurrentPlayer with
        | Black ->
            let newPdnMove = lastMovePdn.BlackMove.Move @ pdnMove.Tail
            { Move = newPdnMove; ResultingFen = boardFen; DisplayString = getDisplayString gameController.Variant.apiMembers newPdnMove move }
        | White -> lastMovePdn.BlackMove

    let whiteMove =
        match gameController.CurrentPlayer with
        | Black -> None
        | White ->
            let newPdnMove = lastMovePdn.WhiteMove.Value.Move @ pdnMove.Tail
            Some { Move = newPdnMove; ResultingFen = boardFen; DisplayString = getDisplayString gameController.Variant.apiMembers newPdnMove move }

    {MoveNumber = moveNumber; BlackMove = blackMove; WhiteMove = whiteMove}

let internal getGameHistory gameController move boardFen =
    let isContinuedMove = gameController.CurrentCoord <> None

    let newTurnValue =
        match isContinuedMove with
        | false -> getPdnForMove gameController move boardFen
        | true -> getPdnForContinuedMove gameController move boardFen

    match gameController.CurrentPlayer, isContinuedMove with
    | Black, false -> gameController.MoveHistory @ [newTurnValue]
    | _ ->
        match gameController.MoveHistory with
        | [] -> [newTurnValue]
        | _ -> (List.take (gameController.MoveHistory.Length - 1) gameController.MoveHistory) @ [newTurnValue]

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

    match board with
    | None -> None
    | Some b ->
        let isTurnEnding = gameController.Variant.apiMembers.playerTurnEnds [startCoord; endCoord] gameController.Board b
        let nextPlayerTurn = 
            match gameController.Variant.apiMembers.playerTurnEnds [startCoord; endCoord] gameController.Board b with
            | true -> otherPlayer gameController.CurrentPlayer
            | false -> gameController.CurrentPlayer

        Some <|
            {
                Variant = gameController.Variant
                Board = b
                CurrentPlayer = nextPlayerTurn
                InitialPosition = gameController.InitialPosition
                MoveHistory = getGameHistory gameController [startCoord; endCoord] (createFen gameController.Variant.pdnMembers nextPlayerTurn b)
                CurrentCoord = if isTurnEnding then None else Some endCoord
            }

let move (move :Coord seq) (gameController) :Option<GameController> =
    let board = gameController.Variant.apiMembers.moveSequence move (Some gameController.Board)
    let moveAsList = (List.ofSeq move)

    match board with
    | None -> None
    | Some b ->
        let isTurnEnding = gameController.Variant.apiMembers.playerTurnEnds moveAsList gameController.Board b
        let nextPlayerTurn =
            match gameController.Variant.apiMembers.playerTurnEnds moveAsList gameController.Board b with
            | true -> otherPlayer gameController.CurrentPlayer
            | false -> gameController.CurrentPlayer

        Some <|
            {
                Variant = gameController.Variant
                Board = b;
                CurrentPlayer = nextPlayerTurn
                InitialPosition = gameController.InitialPosition
                MoveHistory = getGameHistory gameController moveAsList (createFen gameController.Variant.pdnMembers nextPlayerTurn b)
                CurrentCoord = if isTurnEnding then None else Some (Seq.last move)
            }

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

let takeBackMove gameController =
    let fen =
        match gameController.CurrentPlayer, gameController.MoveHistory.Length with
        | Black, l when l >= 1 -> (List.last gameController.MoveHistory).BlackMove.ResultingFen
        | White, l when l >= 2 ->(gameController.MoveHistory.[gameController.MoveHistory.Length - 2]).WhiteMove.Value.ResultingFen
        | _ -> gameController.InitialPosition

    let newMoveHistory =
        match gameController.CurrentPlayer, gameController.MoveHistory with
        | White, _ -> List.truncate (gameController.MoveHistory.Length - 1) gameController.MoveHistory
        | Black, [] -> []
        | Black, _ ->
            let lastMove = (List.last gameController.MoveHistory)
            let newLastMove = {lastMove with WhiteMove = None}
            List.truncate (gameController.MoveHistory.Length - 1) gameController.MoveHistory @ [newLastMove]

    {(controllerFromFen gameController.Variant fen) with MoveHistory = newMoveHistory}

let winningPlayer gameController =
    gameController.Variant.apiMembers.winningPlayer gameController.Board

let isWon controller =
    let player = winningPlayer controller
    player.IsSome &&
    player.Value <> controller.CurrentPlayer

let createFen variant player (board :Board) =
    createFen variant player board

let controllerFromFen variant fen =
    controllerFromFen variant fen
\$\endgroup\$
1
\$\begingroup\$

This isn't bad, but I have a few nitpicks:

let weight = 8.0 - (float <| abs(kingRow - coord.Row)) + (square coord checkerWeights)

Why not:

let weight = 8.0 - (float abs(kingRow - coord.Row)) + (square coord checkerWeights)

| _, c when not <| coordExists c -> None

See above.


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

If this were C# you wouldn't write such ugly logic, bring those talents and good behavior you have to F# as well! :)


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

Wtf? Please don't multiline those and conditions.


Overall, it's not bad. Well designed, complex and almost entirely functional, good work. :)

| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy