5
\$\begingroup\$

How do I refactor common code with different union types?

I'm still struggling with refactoring F# code with different types but same behavior.

I have the following function that I would like to refactor:

let movePiece destination positions piece =

    let foundPiece = positions |> List.filter (fun space -> space = Allocated piece)
                               |> List.head
    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Allocated p  -> coordinateOf p

    let canCrown =
        let yValue = snd destinationXY
        (yValue = 0 || yValue = 7) && 
        not (isKing piece)

    match foundPiece with
    | Allocated (Black (ch, xy)) -> let checkerType = match canCrown with
                                                      | true  -> BlackKing
                                                      | false -> BlackSoldier

                                    (positions |> List.filter (fun space -> space <> Allocated (Black (ch, xy)))
                                               |> List.filter (fun space -> space <> destination))
                                               @  [Available (xy) ; (Allocated (Black (checkerType, destinationXY)))]

    | Allocated (Red   (ch, xy)) -> let checkerType = match canCrown with
                                                      | true  -> RedKing
                                                      | false -> RedSoldier

                                    (positions |> List.filter (fun space -> space <> Allocated (Red (ch, xy)))
                                               |> List.filter (fun space -> space <> destination))
                                               @  [Available (xy) ; (Allocated (Red   (checkerType, destinationXY)))]
    | _ -> positions

Here's the entire domain:

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier

type Coordinate = int * int

type Piece =
    | Black of Black * Coordinate
    | Red   of Red   * Coordinate

type Space =
    | Allocated of Piece
    | Available of Coordinate

type Status =
    | BlacksTurn | RedsTurn
    | BlackWins  | RedWins

(* Private *)
let private black coordinate = Allocated (Black (BlackSoldier , coordinate))
let private red   coordinate = Allocated (Red   (RedSoldier   , coordinate))

let private yDirection = function
    | Black _ -> -1
    | Red   _ ->  1

let private toAvailable = function
    | Available pos -> true
    | _             -> false

let available positions = positions |> List.filter toAvailable

let private availableSelection = function
    | Available pos -> Some pos
    | Allocated _   -> None

let private availablePositions positions = 
    positions |> List.filter toAvailable
              |> List.choose availableSelection

let private getCoordinate = function
    | Available xy -> Some xy
    | _            -> None

let coordinateOf = function
    | Black (checker , pos) -> pos
    | Red   (checker , pos) -> pos

let optionsForSoldier piece = 

    let (sourceX , sourceY) = coordinateOf piece

    (fun pos -> pos = ((sourceX - 1) , (sourceY + (piece |> yDirection) )) ||
                pos = ((sourceX + 1) , (sourceY + (piece |> yDirection) )))

let optionsForKing piece = 

    let (sourceX , sourceY) = coordinateOf piece

    (fun pos -> pos = ((sourceX - 1) , (sourceY + 1 )) ||
                pos = ((sourceX + 1) , (sourceY + 1 )) ||
                pos = ((sourceX - 1) , (sourceY - 1 )) ||
                pos = ((sourceX + 1) , (sourceY - 1 )))

let jumpOptions (sourceX , sourceY) space =
    match space with
    | Allocated p -> match p with
                     | Red   (ch,xy) -> xy = (sourceX + 1, sourceY - 1) ||
                                        xy = (sourceX - 1, sourceY - 1)

                     | Black (ch,xy) -> xy = (sourceX + 1, sourceY + 1) ||
                                        xy = (sourceX - 1, sourceY + 1)
    | _ -> false

let jumpsForSoldier piece positions =
    match piece with
    | Black (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
    | Red   (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))

let private isKing piece = 
    match piece with
    | Black (checker , _) -> match checker with
                             | BlackSoldier -> false
                             | BlackKing    -> true

    | Red   (checker , _) -> match checker with
                             | RedSoldier   -> false
                             | RedKing      -> true

(* Public *)
let startGame () =
    [ red (0,0);  red (2,0);  red (4,0);  red (6,0)
      red (1,1);  red (3,1);  red (5,1);  red (7,1)
      red (0,2);  red (2,2);  red (4,2);  red (6,2)

      Available (1,3); Available (3,3); Available (5,3); Available (7,3)
      Available (0,4); Available (2,4); Available (4,4); Available (6,4)

      black (1,5);  black (3,5);  black (5,5);  black (7,5)
      black (0,6);  black (2,6);  black (4,6);  black (6,6)
      black (1,7);  black (3,7);  black (5,7);  black (7,7) ] , BlacksTurn

let optionsFor piece positions =

    let sourceX , sourceY = coordinateOf piece

    match piece |> isKing with
    | false -> positions |> availablePositions 
                         |> List.filter (optionsForSoldier piece)

    | true ->  positions |> availablePositions 
                         |> List.filter (optionsForKing piece)

let movePiece destination positions piece =

    let foundPiece = positions |> List.filter (fun space -> space = Allocated piece)
                               |> List.head
    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Allocated p  -> coordinateOf p

    let canCrown =
        let yValue = snd destinationXY
        (yValue = 0 || yValue = 7) && 
        not (isKing piece)

    match foundPiece with
    | Allocated (Black (ch, xy)) -> let checkerType = match canCrown with
                                                      | true  -> BlackKing
                                                      | false -> BlackSoldier

                                    (positions |> List.filter (fun space -> space <> Allocated (Black (ch, xy)))
                                               |> List.filter (fun space -> space <> destination))
                                               @  [Available (xy) ; (Allocated (Black (checkerType, destinationXY)))]

    | Allocated (Red   (ch, xy)) -> let checkerType = match canCrown with
                                                      | true  -> RedKing
                                                      | false -> RedSoldier

                                    (positions |> List.filter (fun space -> space <> Allocated (Red (ch, xy)))
                                               |> List.filter (fun space -> space <> destination))
                                               @  [Available (xy) ; (Allocated (Red   (checkerType, destinationXY)))]
    | _ -> positions

let move piece destination positions =

    let options   = optionsFor piece positions
    let canMoveTo = (fun target -> options |> List.exists (fun xy -> xy = target))

    match getCoordinate destination with
    | Some target -> match canMoveTo target with
                     | true  -> (positions , piece) ||> movePiece destination 
                     | false -> positions
    | None -> positions

let jump (target:Piece) (positions:Space list) (source:Piece) =

    let canJump = 
        positions |> jumpsForSoldier source
                  |> List.exists (fun s -> match s with
                                           | Allocated target -> true
                                           | _                -> false)

    let (|NorthEast|NorthWest|SouthEast|SouthWest|Origin|) (origin , barrier) =

        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier

        if   barrierY = sourceY + 1 &&
             barrierX = sourceX - 1
        then SouthWest

        elif barrierY = sourceY + 1 &&
             barrierX = sourceX + 1 
        then SouthEast

        elif barrierY = sourceY - 1 &&
             barrierX = sourceX - 1
        then NorthWest

        elif barrierY = sourceY - 1 &&
             barrierX = sourceX + 1
        then NorthEast

        else Origin

    let jumpToPostion origin barrier =

        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier

        match (origin , barrier) with
        | SouthWest -> (barrierX + 1, barrierY - 1)
        | SouthEast -> (barrierX + 1, barrierY + 1)
        | NorthWest -> (barrierX - 1, barrierY - 1)
        | NorthEast -> (barrierX - 1, barrierY + 1)
        | Origin    -> origin

    if canJump then
        let destination = Available (jumpToPostion (coordinateOf source) (coordinateOf target))
        let result = (positions, source) ||> movePiece destination
                                          |> List.filter (fun s -> s <> Allocated target)
        Available (coordinateOf target)::result


    else positions

Here are my tests:

(* Tests *)
open NUnit.Framework
open FsUnit

[<Test>]
let ``black goes first`` () =
    startGame () |> snd
                 |> should equal BlacksTurn
[<Test>]
let ``get avaialable positions`` () =
    startGame () |> fst
                 |> available
                 |> List.length 
                 |> should equal 8
[<Test>]
let ``get avaialable positions for black soldier`` () =
    // Setup
    let piece = Black ( BlackSoldier , (1,5) )

    // Test
    let available = startGame () |> fst
                                 |> available
                                 |> optionsFor piece
    // Verify
    let northWestAvailable = available |> List.exists (fun pos -> pos = (0,4))
    let northEastAvailable = available |> List.exists (fun pos -> pos = (2,4))

    (northWestAvailable && northEastAvailable) |> should equal true
[<Test>]
let ``get avaialable positions for red soldier`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )

    // Test
    startGame () |> fst
                 |> available
                 |> optionsFor piece
                 |> List.exists (fun pos -> pos = (1,3))
                 |> should equal true
[<Test>]
let ``get avaialable positions for red king`` () =
    // Setup
    let piece = Red ( RedKing , (2,4) )
    let positions = [Available (0,2);  Available (2,2);  Available (4,2);  Available (6,2)

                     Available (1,3);  Available (3,3);  Available (5,3);  Available (7,3)
                     Available (0,4);  Allocated piece;  Available (4,4);  Available (6,4)

                     Available (1,5);  Available (3,5);  Available (5,5);  Available (7,5)]

    // Test
    positions |> optionsFor piece
              |> List.length
              |> should equal 4
[<Test>]
let ``move red soldier`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> fst
                 |> move piece destination
                 |> List.exists (fun pos -> pos = Allocated (Red (RedSoldier , (1,3) )))
                 |> should equal true
[<Test>]
let ``moving red soldier leaves space available`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> fst
                 |> move piece destination
                 |> List.exists (fun pos -> pos = Available (0,2))
                 |> should equal true
[<Test>]
let ``moving red soldier maintains piece count`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)

    // Test
    startGame () |> fst
                 |> move piece destination
                 |> List.length
                 |> should equal 32
[<Test>]
let ``get jump options for red soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let positions = [Allocated redPiece; Allocated blackPiece]

    // Test
    positions |> jumpsForSoldier redPiece
              |> should equal [Allocated blackPiece]
[<Test>]
let ``red soldier gets new destination when it jumps black soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected = Allocated (Red (RedSoldier , (2,4)))
    let positions = [Allocated redPiece; Allocated blackPiece; Available (2,4)]

    // Test
    (positions,redPiece) ||> jump blackPiece
                          |> List.exists (fun s -> s = expected)
                          |> should equal true

let ``black soldier gets new destination when it jumps red soldier`` () =

    let redPiece =   Red   ( RedSoldier   , (2,2) )
    let blackPiece = Black ( BlackSoldier , (3,3) )
    let expected =   Allocated (Black ( BlackSoldier , (1,1) ))
    let positions =  [Allocated redPiece; Allocated blackPiece; Available (1,1)]

    // Test
    (positions, blackPiece) ||> jump redPiece
                             |> List.exists (fun s -> s = expected)
                             |> should equal true
[<Test>]
let ``black soldier removed after being jumped by red soldier`` () =

    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (1,3)
    let positions =  [Allocated redPiece; Allocated blackPiece]

    // Test
    (positions,redPiece) ||> jump blackPiece
                          |> List.exists (fun s -> s = expected)
                          |> should equal true
[<Test>]
let ``red soldier removed after being jumped by black soldier`` () =

    let redPiece =   Red   ( RedSoldier   , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (0,2)
    let positions =  [Allocated redPiece; Allocated blackPiece; expected]

    // Test
    (positions, blackPiece) ||> jump redPiece
                             |> List.exists (fun s -> s = expected)
                             |> should equal true

[<Test>]
let ``movng black soldier to endzone makes king`` () =
    // Setup
    let piece = Black ( BlackSoldier , (1,1) )
    let destinationCoordinate = (0,0)
    let destination = Available destinationCoordinate
    let positions = [destination; Allocated piece]
    let expected = Allocated (Black (BlackKing , destinationCoordinate))

    // Test
    positions |> move piece destination
              |> List.exists (fun pos -> pos = expected)
              |> should equal true

[<Test>]
let ``movng red soldier to endzone makes king`` () =
    // Setup
    let piece = Red ( RedSoldier , (6,6) )
    let destinationCoordinate = (7,7)
    let destination = Available destinationCoordinate
    let positions = [destination; Allocated piece]
    let expected = Allocated (Red (RedKing , destinationCoordinate))

    // Test
    positions |> move piece destination
              |> List.exists (fun pos -> pos = expected)
              |> should equal true
\$\endgroup\$
  • 1
    \$\begingroup\$ Also, I think you could have split Solider Type from BlackSolider and RedKing such that it would be color * rank so that Piece would have the signature color * rank * coordinates The effect of that would make it easy to merge the two match cases into one \$\endgroup\$ – Ody Aug 5 '16 at 19:32
3
\$\begingroup\$

I do not think you necessary need to avoid all code duplication in the two match cases, because this is duplicated just twice - that's not worth making the code more complex and eliminating the code duplication.

I would probably avoid some of the duplication by extracting the double List.filter, but aside from that, I would just change the indentation so that it looks more regular:

let movePiece destination positions piece =
    let foundPiece = 
        positions |> List.find (fun space -> space = Allocated piece)

    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Allocated p  -> coordinateOf p

    let canCrown =
        let yValue = snd destinationXY
        (yValue = 0 || yValue = 7) && 
        not (isKing piece)

    let positionsNot a b = 
      positions |> List.filter (fun space -> space <> a && space <> b)

    match foundPiece with
    | Allocated(Black(ch, xy)) -> 
        let checkerType = if canCrown then BlackKing else BlackSoldier
        Available(xy) :: (Allocated(Black(checkerType, destinationXY))) ::
          positionsNot (Allocated(Black(ch, xy))) desitnation

    | Allocated(Red(ch, xy)) -> 
        let checkerType = if canCrown then RedKing else RedSoldier
        Available(xy) :: (Allocated(Red(checkerType, destinationXY))) ::
          positionsNot (Allocated(Red(ch, xy))) desitnation
    | _ -> positions

The changes are:

  • Do not use match for pattern matching on booleans - if is simlper
  • Add a newline after -> so that we do not need that much indentation
  • Add positionsNot function that performs the double filtering
  • Use List.find instead of List.filter followed by List.head
\$\endgroup\$
4
\$\begingroup\$

The biggest flaw in your model is that you don't model Color as a type. If you do that, you can eliminate a lot of duplication in other pieces and can make most code color agnostic.

The second big change I'd make is not coupling the coordinate so tightly with pieces or spaces. I'd only add this information in the places that require it.

type Color = Black | Red

type PieceKind = Soldier | King

type Piece = Color * PieceKind

type SquareContent = // If you want, you can use `Option<Piece>` here.
    | Occupied of Piece
    | Empty

type Coordinate = int * int

type Result = // If you want, you can inline `Result` into `Status`, but I wouldn't recommend it.
    | Win of Color
    | Draw

type Status =
    | Turn of Color
    | Ended of Result

I'd represent the board as a mapping from Coordinate to SquareContent, not as a list of Coordinate * SquareContent tuples.


If you don't use the above redesign, you should rename your current Black and Red, because they don't represent those colors, they represent a piece with that color. So call them BlackPiece and RedPiece.

\$\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.