问题
How can I return a parameter as a union case value?
I have the following function:
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
Specifically, I want to refactor this part of the above function into one function:
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
How do I refactor the duplicated code above?
I'm stuck on how to remove the duplication and still return the two different union types (i.e. red checker and red king)
Domain:
(* 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
Tests:
[<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 } })
回答1:
In the code that you want to refactor, there seemed to be only two places where the two parts of the code do something different - one is the pattern matching (where one looks for RedChecker and another for RedKing) and the other part is the body of the first and the third line of the pattern matching (where one returns RedChecker and another RedKing).
The code also works over different types, but those are all the same type:
type BlackChecker = { Position:Position }
type RedChecker = { Position:Position }
type BlackKing = { Position:Position }
type RedKing = { Position:Position }
Extracting the common part will be a lot easier if you just use the same type for all of these:
type Piece = { Position:Position }
type BlackChecker = Piece
type RedChecker = Piece
type BlackKing = Piece
type RedKing = Piece
So, you need to parameterize the code by two things - both of them can be represented as functions of the following types:
detector : Checker -> Piece option
wrapper : Piece -> Checker
The key trick here is that these two functions behave like the discriminated union case - the first one behaves as pattern matching using DU case and the second one behaves like a constructor of the DU case.
Now you can extract the common functionality into something like:
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
I have not tested everything, but hopefully this at least shows the line of thought that you can follow to extract the common functionality from the two parts. That said, I would not be all too worried about refactoring the code - if you repeat similar thing just twice, I feel it is often easier just to keep two copies...
回答2:
Alright your model is really complicated... I made the following simplification:
type Position = { X:int; Y:int }
type Color =
| Red
| Black
type PieceType =
| King
| Checker
type Piece = Color*PieceType*Position
Then translating your jumpBlack function I get:
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!
But now, it's really easy to refactor the code since we see that if pos isn't equal to the minY value, it stays the same PieceType, but if it reaches minY it always becomes a 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!
This also makes it much easier for you to make jump take in both black and red checkers.
来源：https://stackoverflow.com/questions/38657045/how-can-i-return-a-parameter-as-a-union-case-value