How can I generate a value so that it's reflected as an element of another generated value?

Question

How can I generate a value so that it's reflected as an element of another generated value?

For example take the following code:

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>

I want the positionsGen to include the values produced by the pieceGen and spaceGen. However, I am clueless on how to do this.

To add context to my question, my positions list (aka checker board) should contain both the generated piece and the generated destination within its list.

Here's my test:

[<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

Appendix:

(* 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

score 6 · Accepted Answer · edited May 23 '17 at 11:44

As explained in a previous answer, you can use the gen computation expression to express more complex generators.

In this particular example, you state that you need positionsGen to include the values produced by the pieceGen and spaceGen. You can do that like this:

[<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...

The computation expression starts by generating a piece and a destination. Due to the use of let! within the computation expression, within that context, they are normal Piece and Space values, and can be treated as such.

Next, the expression uses let! to 'generate' a Space list value, which will contain other values (if any; the generated list could be empty).

This gives you all the building blocks required to generate a list that contains at least the two desired values, as well as other values. To create such a list, you can cons (::) the two 'known' values onto the list, and then shuffle the result for good measure.

The final expression in the gen computation expression then returns a four-element tuple. The type of that expression is Gen<Piece * Space * Space list * Status>. It can be turned into an Arbitrary<Piece * Space * Space list * Status> by Arb.fromGen, and further piped into Prop.forAll.

This addresses the problem that the moving checker retains set count property throws exceptions internally.

This, incidentally, demonstrates that the property is falsifiable:

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)

Whether this is a problem with the test or with the implementation is a different question...

This property-based testing is both annoying and awesome at the same time. FsCheck is finding gaps in my logic that I never knew about. Thank you so much! — Scott Nimrod, Aug 09 '16 at 20:04
@ScottNimrod I hope you get over the annoyance at some point - I simply find it awesome :) — Mark Seemann, Aug 09 '16 at 20:08

How can I generate a value so that it's reflected as an element of another generated value?

1 Answers1