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. :)

\$\endgroup\$

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.