如何将参数作为联合案例值返回？

Question

如何将参数作为联合案例值返回？

我有以下功能：

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而另一个查找{{ 1}}）和另一部分是模式匹配的第一行和第三行的主体（其中一行返回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

这里的关键技巧是这两个函数的行为类似于区分联合情况 - 第一个表现为使用DU情况的模式匹配，第二个表现为DU情况的构造函数。

现在，您可以将常用功能提取为：

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

我还没有对所有内容进行过测试，但希望这至少表明了您可以遵循的思路，从两个部分中提取常用功能。也就是说，我不会太担心重构代码 - 如果你重复两次相似的事情，我觉得保留两份副本往往更容易......

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值，它会保持不变{{1} }，但如果它达到PieceType，它总是变为minY。

King

这也使您更容易在黑色和红色检查器中进行跳跃。