[Haskell-cafe] How to choose an arbitrary Arbitrary?

Ryan Ingram ryani.spam at gmail.com
Wed Dec 17 17:05:41 EST 2008


It's absolutely possible.  However, I think you do need to enumerate
the possible types somehow.

Here's an example that demonstrates the idea:

> {-# LANGUAGE ScopedTypeVariables #-}
> sizedTree :: forall a. Arbitrary a => Int -> Gen (Tree a)
> sizedTree n | n <= 0 = liftM Val arbitrary
> sizedTree n = oneof trees
>   where
>     m = n `div` 2
>     mkTree :: forall b. Arbitrary b => b -> Gen (Tree a)
>     mkTree _ = liftM2 (:*:) (sizedTree m) (sizedTree m :: Gen (Tree b))
>
>     -- "b" can be Int, (), or Int -> Int
>     trees =
>         [ mkTree (undefined :: Int)
>         , mkTree (undefined :: ())
>         , mkTree (undefined :: Int -> Int)
>         ]

It's possible to extend this idea and generate an "arbitrary arbitrary":

> -- "held" value is always _|_
> data SomeArbitrary = forall a. Arbitrary a => SomeArbitrary a

> instance Arbitrary SomeArbitrary where
>     arbitrary = oneof
>         [ return (SomeArbitrary (undefined :: Int))
>         , return (SomeArbitrary (undefined :: ()))
>         , arbFn
>         ]
>       where
>         arbFn = do
>             SomeArbitrary t1 <- arbitrary
>             SomeArbitrary t2 <- arbitrary
>             return (SomeArbitrary (undefined `asTypeOf` fn t1 t2))
>         fn :: forall a b. a -> b -> (a -> b)
>         fn = undefined

In this code, I am relying on certain instances of Arbitrary being
present, in particular:
    instance Arbitrary Int
    instance Arbitrary ()
    instance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b)

Pattern matching on t1 and t2 brings existential type variables into
scope; you can then use those type variables to construct a new, more
complicated type and stuff it back into another existential.  The
existential, conveniently, also holds the dictionary for Arbitrary, so
you can generate values of those types while it is in scope.

A better implementation would also include some way to implement an
interesting "coarbitrary", but I'll leave that as an exercise.

This all said, once things get stuffed into the existential in "Tree",
there isn't much you can do with them.  As declared, Tree is
isomorphic to (Either a a) because there is no way to provide a
different object of type b to call the (b -> a) function with (aside
from unsafeCoerce shenanigans).

  -- ryan

On Wed, Dec 17, 2008 at 10:20 AM, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
> Hello,
>
> I was playing with the following tree type (attached below) which can
> be seen as the reification of an applicative. I wondered if I could
> define a QuickCheck Arbitrary instance for it.
>
> The only way I got it to type check however, was to give 'arg' a
> monomorphic type (for example: 'Gen (Tree ())'). If I left it
> polymorphic I got a "Ambiguous type variable in constraints" error.
> This is understandable because if the subtrees have polymorphic types
> they can be of any type: Tree Int, Tree Float, Tree String, etc. The
> system then doesn't know which Arbitrary to choose.
>
> My question is, is it possible to keep 'arg' polymorphic (i.e. 'Gen
> (Tree b)') and let the system somehow choose an arbitrary Arbitrary?
>
> I guess not, however I like to be proven wrong.
>
> regards,
>
> Bas
>
> ----------------------------------------------------
>
> {-# LANGUAGE ExistentialQuantification #-}
>
> module Tree where
>
> import Control.Monad
> import Test.QuickCheck -- I'm using QuickCheck-2.1.0.1
>
> data Tree a = Val a
>            | forall b. Tree (b -> a) :*: Tree b
>
> instance Arbitrary a => Arbitrary (Tree a) where
>    arbitrary = sized sizedTree
>
> sizedTree :: (Arbitrary a) => Int -> Gen (Tree a)
> sizedTree n | n <= 0    = liftM  Val arbitrary
>            | otherwise = liftM2 (:*:) func arg
>    where
>      m = n `div` 2
>
>      func = sizedTree m
>
>      arg :: Gen (Tree ()) -- how to make this:
>                           -- Gen (Tree b) ???
>      arg = sizedTree m
>
> ----------------------------------------------------
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list