1

如何生成一个值,使其反映为另一个生成值的元素?

例如下面的代码:

type Space =
    | Occupied  of Piece
    | Available of Coordinate

// Setup
let pieceGen =       Arb.generate<Piece> 
let destinationGen = Arb.generate<Space>
let positionsGen =   Arb.generate<Space list>

我希望positionGen 包含由pieceGen 和spaceGen 生成的值。 但是,我对如何做到这一点一无所知。

为了给我的问题添加上下文,我的职位列表(又名棋盘)应该在其列表中包含生成的片段和生成的目的地。

这是我的测试:

[<Property(QuietOnSuccess = true, MaxTest=10000)>]
let ``moving checker retains set count`` () =

    // Setup
    let pieceGen =       Arb.generate<Piece> 
    let destinationGen = Arb.generate<Space>
    let positionsGen =   Arb.generate<Space list>
    let statusGen =      Arb.generate<Status>

    // Test
    Gen.map4 (fun a b c d -> a,b,c,d) pieceGen destinationGen positionsGen statusGen
    |> Arb.fromGen
    |> Prop.forAll 
    <| fun (piece , destination , positions , status) -> (positions, status) 
                                                         |> move piece destination
                                                         |> getPositions
                                                         |> List.length = positions.Length

附录:

(* 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 =
    | Occupied  of Piece
    | Available of Coordinate

type Status =
    | BlacksTurn | RedsTurn
    | BlackWins  | RedWins

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

let private getPositions (positions:Space list, status:Status) = positions

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

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

let private available positions = positions |> List.filter toAvailable

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

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

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

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

let private optionsForSoldier piece = 

    let (sourceX , sourceY) = coordinateOf piece

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

let private 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 private jumpOptions (sourceX , sourceY) space =
    match space with
    | Occupied 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 private 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

let private filterOut a b positions =
    positions |> List.filter(fun x -> x <> a && x <> b)

let private movePiece destination positions piece =

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

    let yValueMin , yValueMax = 0 , 7

    let canCrown =
        let yValue = snd destinationXY
        (yValue = yValueMin || 
         yValue = yValueMax) && 
         not (isKing piece)

    match positions |> List.find (fun space -> space = Occupied piece) with
    | Occupied (Black (ch, xy)) -> 
        let checkerType = if canCrown then BlackKing else BlackSoldier
        Available(xy) :: (Occupied(Black(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Black(ch, xy))) destination)     

    | Occupied (Red   (ch, xy)) -> 
        let checkerType = if canCrown then RedKing else RedSoldier
        Available(xy) :: (Occupied(Red(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Red(ch, xy))) destination) 
    | _ -> positions

(* 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 move piece destination (positions,status) =

    let currentStatus = match status with
                        | BlacksTurn -> RedsTurn
                        | RedsTurn   -> BlacksTurn
                        | BlackWins  -> BlackWins
                        | RedWins    -> RedWins

    let canProceed =  match piece with
                      | Red   _ -> currentStatus = RedsTurn  
                      | Black _ -> currentStatus = BlacksTurn

    if not canProceed then (positions , currentStatus)
    else let options   = optionsFor piece positions
         let canMoveTo = (fun target -> options |> List.exists (fun xy -> xy = target))

         match getCoordinate destination with
         | Some target -> if canMoveTo target then
                             let updatedBoard = ((positions , piece) ||> movePiece destination)
                             (updatedBoard , currentStatus)

                          else (positions , currentStatus)
         | None -> (positions , currentStatus)

let jump target positions source =

    let canJump = 
        positions |> jumpsForSoldier source
                  |> List.exists (fun s -> match s with
                                           | Occupied 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 <> Occupied target)
        Available (coordinateOf target)::result
    else positions
4

1 回答 1

5

如上一个答案中所述,您可以使用gen计算表达式来表达更复杂的生成器。

在此特定示例中,您声明需要positionsGen包含由pieceGenand生成的值spaceGen。你可以这样做:

[<Property(QuietOnSuccess = true, MaxTest=10000)>]
let ``moving checker retains set count`` () =
    gen {
        let! piece = Arb.generate<Piece>
        let! destination = Arb.generate<Space>

        let! otherPositions = Arb.generate<Space list>
        let! positions =
            Occupied piece :: destination :: otherPositions |> Gen.shuffle

        let! status = Arb.generate<Status>
        return piece, destination, positions |> Array.toList, status }
    |> Arb.fromGen
    |> Prop.forAll
    // ... the rest of the test goes here...

计算表达式首先生成 apiece和 a destination。由于let!在计算表达式中的使用,该上下文中,它们是正常的PieceSpace值,并且可以这样对待。

接下来,表达式用于let!“生成”一个Space list值,该值将包含其他值(如果有;生成的列表可能为空)。

这为您提供了生成包含至少两个所需值以及其他值的列表所需的所有构建块。要创建这样一个列表,您可以将两个“已知”值 cons ( ::) 放到列表中,然后将结果打乱以进行良好测量。

然后计算表达式中的最终表达式gen返回一个四元素元组。该表达式的类型是Gen<Piece * Space * Space list * Status>。它可以变成Arbitrary<Piece * Space * Space list * Status>by Arb.fromGen,并进一步通过管道传输到Prop.forAll.

这解决了moving checker retains set count属性在内部抛出异常的问题。


顺便说一句,这表明该属性是可证伪的:

Test 'Ploeh.StackOverflow.Q38857462.Properties.moving checker retains set count' failed: FsCheck.Xunit.PropertyFailedException : 
Falsifiable, after 70 tests (0 shrinks) (StdGen (1318556550,296190265)):
Original:
<null>
(Black (BlackKing,(-1, 1)), Available (0, 0),
 [Occupied (Red (RedSoldier,(-1, 0))); Available (0, 0);
  Occupied (Black (BlackKing,(-1, 1))); Available (0, 0)], RedsTurn)

这是测试问题还是实施问题是一个不同的问题......

于 2016-08-09T18:53:30.243 回答