如何将参数返回为联合大小写值？

Question

如何将参数返回为联合大小写值？

I具有以下功能：

let jumpBlack ((blackChecker:BlackChecker),(blackCheckers:BlackChecker list))  (redPiece:RedPiece) =

    let yIncrementValue = -1
    let minY = 0

    match redPiece with
    | RedPiece.RedChecker rc -> 
       let position = rc.Position |> jump blackChecker.Position yIncrementValue
       match position with
       | pos when pos = rc.Position -> RedPiece.RedChecker { rc with Position= position }, blackCheckers
       | pos when pos.Y = minY      -> RedPiece.RedKing    { RedKing.Position=position },  blackCheckers |> remove blackChecker
       | _ ->                          RedPiece.RedChecker { rc with Position= position }, blackCheckers |> remove blackChecker

    | RedPiece.RedKing rk -> 
       let position = rk.Position |> jump blackChecker.Position yIncrementValue
       match position with
       | pos when pos = rk.Position -> RedPiece.RedKing { rk with Position= position }, blackCheckers
       | pos when pos.Y = minY      -> RedPiece.RedKing { Position=position }, blackCheckers |> remove blackChecker
       | _                          -> RedPiece.RedKing { rk with Position= position }, blackCheckers |> remove blackChecker

特别是，我想将上述函数的这一部分重构为一个函数：

match redPiece with
| RedPiece.RedChecker rc -> 
   let position = rc.Position |> jump blackChecker.Position yIncrementValue
   match position with
   | pos when pos = rc.Position -> RedPiece.RedChecker { rc with Position= position }, blackCheckers
   | pos when pos.Y = minY      -> RedPiece.RedKing    { RedKing.Position=position },  blackCheckers |> remove blackChecker
   | _ ->                          RedPiece.RedChecker { rc with Position= position }, blackCheckers |> remove blackChecker

| RedPiece.RedKing rk -> 
   let position = rk.Position |> jump blackChecker.Position yIncrementValue
   match position with
   | pos when pos = rk.Position -> RedPiece.RedKing { rk with Position= position }, blackCheckers
   | pos when pos.Y = minY      -> RedPiece.RedKing { Position=position }, blackCheckers |> remove blackChecker
   | _                          -> RedPiece.RedKing { rk with Position= position }, blackCheckers |> remove blackChecker

如何重构上面重复的代码？

我被困在如何删除复制，并仍然返回两种不同的联合类型(即红色检查和红色国王)

域：

(* Types *)
type North = NorthEast | NorthWest
type South = SouthEast | SouthWest

type Direction = 
    | NorthEast 
    | NorthWest
    | SouthEast 
    | SouthWest

type Position =     { X:int; Y:int }

type BlackChecker = { Position:Position }
type RedChecker =   { Position:Position }
type BlackKing =    { Position:Position }
type RedKing =      { Position:Position }

type Checker =
    | BlackChecker of BlackChecker
    | RedChecker   of RedChecker
    | BlackKing    of BlackKing
    | RedKing      of RedKing

type King = 
    | BlackKing of BlackKing
    | RedKing of RedKing

type RedPiece = 
    | RedChecker of RedChecker 
    | RedKing of RedKing

(* Functions *)
let rec remove item list = list |> List.filter (fun x -> x <> item)

let setRowPosition y1 y2 y3 index =
    match index with 
    | x when x < 4 -> { X=x; Y=y1 }
    | x when x < 8 -> { X=x-4; Y=y2 }
    | _            -> { X=index-8; Y=y3 }

let initializeBlack () =
    let setPosition index =
        index |> setRowPosition 7 6 5

    let blackCheckers = List.init 12 setPosition |> List.map (fun pos -> { BlackChecker.Position= { X=pos.X; Y=pos.Y } })
    blackCheckers

let initializeRed () =
    let setPosition index =
        index |> setRowPosition 0 1 2

    let redCheckers =   List.init 12 setPosition |> List.map (fun pos -> { RedChecker.Position= { X=pos.X; Y=pos.Y } })
    redCheckers

let set (x, y) positions (position:Position) =
    match not (positions |> List.exists (fun pos -> pos = { X=x; Y=y })) with
    | true -> { X=x; Y=y }
    | false -> position

let moveBlack direction positions (checker:BlackChecker) =
    let position = checker.Position

    match direction with
    | North.NorthEast -> { BlackChecker.Position= (positions, position) ||> set ((position.X + 1), (position.Y + 1 )) } 
    | North.NorthWest -> { BlackChecker.Position= (positions, position) ||> set ((position.X - 1), (position.Y + 1 )) }

let moveRed direction positions (checker:RedChecker) =
    let position = checker.Position

    match direction with
    | South.SouthEast -> { RedChecker.Position= (positions, position) ||> set ((position.X + 1), (position.Y - 1 )) }
    | South.SouthWest -> { RedChecker.Position= (positions, position) ||> set ((position.X - 1), (position.Y - 1 )) }

let moveKing direction positions (king:King) =

    let position = match king with
                   | King.BlackKing bk -> bk.Position
                   | King.RedKing   rk -> rk.Position

    let result = match direction with
                 | NorthEast -> (positions, position) ||> set ((position.X + 1), (position.Y + 1 ))
                 | NorthWest -> (positions, position) ||> set ((position.X - 1), (position.Y + 1 ))
                 | SouthEast -> (positions, position) ||> set ((position.X + 1), (position.Y - 1 ))
                 | SouthWest -> (positions, position) ||> set ((position.X - 1), (position.Y - 1 ))

    match king with
    | King.BlackKing _ -> King.BlackKing { BlackKing.Position= result }
    | King.RedKing   _ -> King.RedKing   { RedKing.Position=   result }

let jump target yDirection source =
    let updateX value = { X=target.X + value
                          Y=target.Y + yDirection }
    match source with
    | position when position.Y + yDirection = target.Y &&
                    position.X + 1 = target.X -> updateX 1

    | position when position.Y + yDirection = target.Y &&
                    position.X - 1 = target.X -> updateX -1
    | _ -> source

let jumpRed ((redChecker:RedChecker), (redCheckers:RedChecker list)) (blackChecker:BlackChecker) =

    let yIncrementValue = 1
    let maxY = 7
    let position = blackChecker.Position |> jump redChecker.Position yIncrementValue

    match position with
    | pos when pos = blackChecker.Position -> BlackChecker { blackChecker with Position= position }, redCheckers
    | pos when pos.Y = maxY                -> Checker.BlackKing { BlackKing.Position=position }, redCheckers |> remove redChecker
    | _ -> BlackChecker { blackChecker with Position= position }, redCheckers |> remove redChecker

let jumpBlack ((blackChecker:BlackChecker),(blackCheckers:BlackChecker list))  (redPiece:RedPiece) =

    let yIncrementValue = -1
    let minY = 0

    match redPiece with
    | RedPiece.RedChecker rc -> 
       let position = rc.Position |> jump blackChecker.Position yIncrementValue
       match position with
       | pos when pos = rc.Position -> RedPiece.RedChecker { rc with Position= position }, blackCheckers
       | pos when pos.Y = minY      -> RedPiece.RedKing    { RedKing.Position=position },  blackCheckers |> remove blackChecker
       | _ ->                          RedPiece.RedChecker { rc with Position= position }, blackCheckers |> remove blackChecker

    | RedPiece.RedKing rk -> 
       let position = rk.Position |> jump blackChecker.Position yIncrementValue
       match position with
       | pos when pos = rk.Position -> RedPiece.RedKing { rk with Position= position }, blackCheckers
       | pos when pos.Y = minY      -> RedPiece.RedKing { Position=position }, blackCheckers |> remove blackChecker
       | _                          -> RedPiece.RedKing { rk with Position= position }, blackCheckers |> remove blackChecker

测试：

[<Test>
let ``red king jumps checker``() =
    let blackChecker = { BlackChecker.Position= { X=1 ; Y=1 } }
    let target = (blackChecker, [blackChecker])

    RedKing { RedKing.Position= { X=0 ; Y=2 } } |> jumpBlack target
                                                |> fst
                                                |> should equal (RedPiece.RedKing { RedKing.Position= { X=2 ; Y=0 } })

[<Test>]
let ``black checker removed after being jumped``() =
    let target = { BlackChecker.Position= { X=1 ; Y=1 } }, []
    RedChecker { RedChecker.Position= { X=2 ; Y=2 } } |> jumpBlack target
                                                      |> snd
                                                      |> should equal []
[<Test>]
let ``red checker jumps black checker southeast``() =
    let blackChecker = { BlackChecker.Position= { X=3 ; Y=2 } }
    let target = blackChecker, [blackChecker]

    RedChecker { RedChecker.Position= { X=2 ; Y=3 } } |> jumpBlack target
                                                      |> fst
                                                      |> should equal (RedChecker { RedChecker.Position= { X=4 ; Y=1 } })

Answer 1

在您想要重构的代码中，似乎只有两个地方的代码做了一些不同的事情--一个是模式匹配(其中一个查找RedChecker，另一个查找RedKing)，另一个是模式匹配的第一行和第三行的主体(其中一个返回RedChecker和另一个RedKing)。

代码也适用于不同的类型，但它们都是相同的类型：

type BlackChecker = { Position:Position }
type RedChecker =   { Position:Position }
type BlackKing =    { Position:Position }
type RedKing =      { Position:Position }

如果只对所有这些都使用相同的类型，则提取公共部分要容易得多：

type Piece = { Position:Position }
type BlackChecker = Piece
type RedChecker = Piece
type BlackKing = Piece
type RedKing = Piece

因此，您需要通过两件事来参数化代码--它们都可以表示为以下类型的函数：

detector       : Checker -> Piece option
wrapper        : Piece -> Checker

这里的关键技巧是，这两个函数的行为类似于被歧视的合并情况--第一个函数使用DU大小写作为模式匹配，第二个函数的行为类似于DU大小写的构造函数。

现在，您可以将通用功能提取为如下内容：

match detector redPiece with
| Some rk -> 
    let position = rk.Position |> jump blackChecker.Position yIncrementValue
    match position with
    | pos when pos = rk.Position -> wrapper { rk with Position= position }, blackCheckers
    | pos when pos.Y = minY      -> RedPiece.RedKing { Position=position }, blackCheckers |> remove blackChecker
    | _                          -> wrapper { rk with Position= position }, blackCheckers |> remove blackChecker

| None -> // Handle the case when it is not the piece we are interested in

我还没有测试所有的东西，但希望这至少表明了您可以遵循的思路，从这两个部分提取通用功能。话虽如此，我不会太担心重构代码--如果你重复两次类似的事情，我觉得只保留两个副本就更容易了……

Answer 2

好吧你的模型真的很复杂。我做了以下简化：

type Position = { X:int; Y:int }

type Color = 
    | Red
    | Black

type PieceType = 
    | King
    | Checker

type Piece = Color*PieceType*Position

然后翻译我得到的jumpBlack函数：

let jumpBlack ((blackChecker:Piece),(blackCheckers:Piece list))  (redPiece:Piece) =

    let yIncrementValue = -1
    let minY = 0

    match redPiece, blackChecker with
    | (Red, Checker, position), (_, _, blackCheckerPosition) -> 
       let newposition = position |> jump blackCheckerPosition yIncrementValue
       match newposition with
       | pos when pos = position ->    (Red, Checker, pos), blackCheckers
       | pos when pos.Y = minY      -> (Red, King, pos) ,  blackCheckers |> remove blackChecker
       | pos ->                          (Red, Checker, pos), blackCheckers |> remove blackChecker
    | (Red, King, position), (_, _, blackCheckerPosition) -> 
       let newposition = position |> jump blackCheckerPosition yIncrementValue
       match newposition with
       | pos when pos = position -> (Red, King, pos), blackCheckers
       | pos when pos.Y = minY      -> (Red, King, pos), blackCheckers |> remove blackChecker
       | pos                          -> (Red, King, pos), blackCheckers |> remove blackChecker
    | _ -> failwith "Invalid" //Deal with Black pieces here! 

但是现在，重构代码真的很容易，因为我们看到，如果pos不等于minY值，它将保持相同的PieceType，但是如果它到达minY，它总是变成一个King。

let jumpBlackNew ((blackChecker:Piece),(blackCheckers:Piece list))  (redPiece:Piece) =

    let yIncrementValue = -1
    let minY = 0

    match redPiece, blackChecker with
    | (Red, pieceType, position), (_, _, blackCheckerPosition) -> 
       let newposition = position |> jump blackCheckerPosition yIncrementValue
       match newposition with
       | pos when pos = position ->    (Red, pieceType, pos), blackCheckers
       | pos when pos.Y = minY      -> (Red, King, pos) ,  blackCheckers |> remove blackChecker
       | pos ->                        (Red, pieceType, pos), blackCheckers |> remove blackChecker
    | _ -> failwith "Invalid" //Deal with Black pieces here!

这也使你更容易让跳转采取的都是黑色和红色的跳棋。