Как я могу вернуть параметр в качестве значения члена объединения?

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

В коде, который вы хотите реорганизовать, d, чтобы быть только двумя местами, где две части кода делают что-то другое: одно - соответствие шаблону (где один ищет 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! 

Это также облегчает вам переход к черным и красным шашкам.