我想以编程方式生成随机Haskell函数并对其进行评估。在我看来，唯一的方法是基本上以编程方式生成Haskell代码并使用GHC API或外部进程运行它，返回一个字符串，并将其解析回Haskell数据类型。这是真的？
我的理由如下。函数是多态的，所以我不能使用Typeable。更重要的是，即使我编写自己的类型检查器并使用其类型注释每个函数，我也无法向Haskell编译器证明我的类型检查器是正确的。例如，当我从一个异构函数集中提取两个函数并将一个函数应用于另一个函数时，我需要为编译器提供一个保证，即我用来选择这些函数的函数只选择具有相应类型的函数。但是没有办法做到这一点，对吧？
答案 0 :(得分：23)
DarkOtter的评论提到了QuickCheck的Arbitrary和CoArbitrary类，这些肯定是你应该尝试的第一件事。 QuickCheck有这个例子：
instance (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where ...
碰巧的是，我昨天正在阅读QuickCheck代码以了解它是如何工作的，所以我可以分享我学到的东西，而这在我的脑海中是新鲜的。 QuickCheck是围绕这样的类型构建的（这将不完全相同）：
type Size = Int
-- | A generator for random values of type @a@.
newtype Gen a =
MkGen { -- | Generate a random @a@ using the given randomness source and
-- size.
unGen :: StdGen -> Size -> a
}
class Arbitrary a where
arbitrary :: a -> Gen a
第一个技巧是QuickCheck有一个像这样工作的功能（我没有弄清楚它是如何实现的）：
-- | Use the given 'Int' to \"perturb\" the generator, i.e., to make a new
-- generator that produces different pseudorandom results than the original.
variant :: Int -> Gen a -> Gen a
然后他们用它来实现这个CoArbitrary类的各种实例：
class CoArbitrary a where
-- | Use the given `a` to perturb some generator.
coarbitrary :: a -> Gen b -> Gen b
-- Example instance: we just treat each 'Bool' value as an 'Int' to perturb with.
instance CoArbitrary Bool where
coarbitrary False = variant 0
coarbitrary True = variant 1
现在有了这些部分，我们想要这个：
instance (Coarbitrary a, Arbitrary b) => Arbitrary (a -> b) where
arbitrary = ...
我不会写出实现，但想法是这样的：
CoArbitrary a实例和Arbitrary b实例，我们可以创建\a -> coarbitrary a arbitrary函数，其类型为a -> Gen b Gen b是StdGen -> Size -> b的新类型，因此类型a -> Gen b与a -> StdGen -> Size -> b同构。StdGen -> Size -> a -> b的函数。Gen (a -> b)是同构的，所以我们将重新排列的函数打包成Gen，我们得到了随机函数生成器！我建议你阅读QuickCheck的来源，亲眼看看。当你解决这个问题时，你只会遇到两个额外的细节，可能会减慢你的速度。首先，Haskell RandomGen类具有以下方法：
-- | The split operation allows one to obtain two distinct random generators.
split :: RandomGen g => g -> (g, g)
此操作用于Monad的{{1}}实例，非常重要。这里的一个技巧是Gen是纯伪随机数生成器; StdGen的工作方式是，对于Gen (a -> b)我们扰乱a生成器的每个可能值，使用该扰动生成器生成b结果，但接着我们从不提前扰乱发电机的状态;基本上生成的b函数是对伪随机种子的闭包，每次我们用一些a -> b调用它时，我们使用特定的a来确定性地创建一个新的种子，然后用它来确定性地生成依赖于a和隐藏种子的b。
缩写类型a或多或少总结了正在发生的事情 - 伪随机函数是用于从伪随机种子和Seed -> a -> b生成b的规则。这不适用于命令式风格的有状态随机数生成器。
第二：如上所述，QuickCheck代码不是直接拥有a函数，而是(a -> StdGen -> Size -> b) -> StdGen -> Size -> a -> b，这是对任何promote :: Monad m => m (Gen a) -> Gen (m a)的概括。当Monad是m的函数实例时，Monad与promote重合，所以它与上面的草图完全相同。
答案 1 :(得分：1)
这些方面的某些内容会满足您的需求吗？
import Control.Monad.Random
randomFunction :: (RandomGen r, Random a, Num a, Floating a) => Rand r (a -> a)
randomFunction = do
(a:b:c:d:_) <- getRandoms
fromList [(\x -> a + b*x, 1), (\x -> a - c*x, 1), (\x -> sin (a*x), 1)]
-- Add more functions as needed
main = do
let f = evalRand randomFunction (mkStdGen 1) :: Double -> Double
putStrLn . show $ f 7.3
编辑：在此想法的基础上，我们可以合并具有不同数量和类型参数的函数...只要我们部分应用它们，以便它们都具有相同的结果类型。 / p>
import Control.Monad.Random
type Value = (Int, Double, String) -- add more as needed
type Function = Value -> String -- or whatever the result type is
f1 :: Int -> Int -> (Int, a, b) -> Int
f1 a b (x, _, _) = a*x + b
f2 :: String -> (a, b, String) -> String
f2 s (_, _, t) = s ++ t
f3 :: Double -> (a, Double, b) -> Double
f3 a (_, x, _) = sin (a*x)
randomFunction :: RandomGen r => Rand r Function
randomFunction = do
(a:b:c:d:_) <- getRandoms -- some integers
(w:x:y:z:_) <- getRandoms -- some floats
n <- getRandomR (0,100)
cs <- getRandoms -- some characters
let s = take n cs
fromList [(show . f1 a b, 1), (show . f2 s, 1), (show . f3 w, 1)]
-- Add more functions as needed
main = do
f <- evalRandIO randomFunction :: IO Function
g <- evalRandIO randomFunction :: IO Function
h <- evalRandIO randomFunction :: IO Function
putStrLn . show $ f (3, 7.3, "hello")
putStrLn . show $ g (3, 7.3, "hello")
putStrLn . show $ h (3, 7.3, "hello")
答案 2 :(得分：1)
感谢上面非常彻底的答案！尽管如此，没有一个回应，做了我想要的。我在评论问题中跟踪了DarkOtter的建议，并使用unsafeCoerce避免了类型检查。基本思想是我们创建一个GADT，用它们的类型打包Haskell函数;我使用的类型系统非常接近Mark P. Jones'"Typing Haskell in Haskell."每当我想要一个Haskell函数集合时，我首先将它们强制转换为Any类型，然后我做我需要做的事情，拼接它们一起随机。当我去评估新功能时，首先我将它们强制回到我想要的类型。当然，这不安全;如果我的类型检查器错误或我用不正确的类型注释haskell函数，那么我最终会废话。
我已经粘贴了我在下面测试过的代码。请注意，导入了两个本地模块Strappy.Type和Strappy.Utils。第一个是上面提到的类型系统。第二个为随机程序带来帮助。
注意：在下面的代码中，我使用组合逻辑作为基本语言。这就是为什么我的表达式语言只有应用程序而没有变量或lambda抽象。
{-# Language GADTs, ScopedTypeVariables #-}
import Prelude hiding (flip)
import qualified Data.List as List
import Unsafe.Coerce (unsafeCoerce)
import GHC.Prim
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Control.Monad.Identity
import Control.Monad.Random
import Strappy.Type
import Strappy.Utils (flip)
-- | Helper for turning a Haskell type to Any.
mkAny :: a -> Any
mkAny x = unsafeCoerce x
-- | Main data type. Holds primitive functions (Term), their
-- application (App) and annotations.
data Expr a where
Term :: {eName :: String,
eType :: Type,
eThing :: a} -> Expr a
App :: {eLeft :: (Expr (b -> a)),
eRight :: (Expr b),
eType :: Type} -> Expr a
-- | smart constructor for applications
a <> b = App a b (fst . runIdentity . runTI $ typeOfApp a b)
instance Show (Expr a) where
show Term{eName=s} = s
show App{eLeft=el, eRight=er} = "(" ++ show el ++ " " ++ show er ++ ")"
-- | Return the resulting type of an application. Run's type
-- unification.
typeOfApp :: Monad m => Expr a -> Expr b -> TypeInference m Type
typeOfApp e_left e_right
= do t <- newTVar Star
case mgu (eType e_left) (eType e_right ->- t) of
(Just sub) -> return $ toType (apply sub (eType e_left))
Nothing -> error $ "typeOfApp: cannot unify " ++
show e_left ++ ":: " ++ show (eType e_left)
++ " with " ++
show e_right ++ ":: " ++ show (eType e_right ->- t)
eval :: Expr a -> a
eval Term{eThing=f} = f
eval App{eLeft=el, eRight=er} = (eval el) (eval er)
filterExprsByType :: [Any] -> Type -> TypeInference [] Any
filterExprsByType (e:es) t
= do et <- freshInst (eType (unsafeCoerce e :: Expr a))
let e' = unsafeCoerce e :: Expr a
case mgu et t of
Just sub -> do let eOut = unsafeCoerce e'{eType = apply sub et} :: Any
return eOut `mplus` rest
Nothing -> rest
where rest = filterExprsByType es t
filterExprsByType [] t = lift []
----------------------------------------------------------------------
-- Library of functions
data Library = Library { probOfApp :: Double, -- ^ probability of an expansion
libFunctions :: [Any] }
cInt2Expr :: Int -> Expr Int
-- | Convert numbers to expressions.
cInt2Expr i = Term (show i) tInt i
-- Some basic library entires.
t = mkTVar 0
t1 = mkTVar 1
t2 = mkTVar 2
t3 = mkTVar 3
cI = Term "I" (t ->- t) id
cS = Term "S" (((t2 ->- t1 ->- t) ->- (t2 ->- t1) ->- t2 ->- t)) $ \f g x -> (f x) (g x)
cB = Term "B" ((t1 ->- t) ->- (t2 ->- t1) ->- t2 ->- t) $ \f g x -> f (g x)
cC = Term "C" ((t2 ->- t1 ->- t2 ->- t) ->- t1 ->- t2 ->- t) $ \f g x -> (f x) g x
cTimes :: Expr (Int -> Int -> Int)
cTimes = Term "*" (tInt ->- tInt ->- tInt) (*)
cPlus :: Expr (Int -> Int -> Int)
cPlus = Term "+" (tInt ->- tInt ->- tInt) (+)
cCons = Term ":" (t ->- TAp tList t ->- TAp tList t) (:)
cAppend = Term "++" (TAp tList t ->- TAp tList t ->- TAp tList t) (++)
cHead = Term "head" (TAp tList t ->- t) head
cMap = Term "map" ((t ->- t1) ->- TAp tList t ->- TAp tList t1) map
cEmpty = Term "[]" (TAp tList t) []
cSingle = Term "single" (t ->- TAp tList t) $ \x -> [x]
cRep = Term "rep" (tInt ->- t ->- TAp tList t) $ \n x -> take n (repeat x)
cFoldl = Term "foldl" ((t ->- t1 ->- t) ->- t ->- (TAp tList t1) ->- t) $ List.foldl'
cNums = [cInt2Expr i | i <- [1..10]]
-- A basic library
exprs :: [Any]
exprs = [mkAny cI,
mkAny cS,
mkAny cB,
mkAny cC,
mkAny cTimes,
mkAny cCons,
mkAny cEmpty,
mkAny cAppend,
-- mkAny cHead,
mkAny cMap,
mkAny cFoldl,
mkAny cSingle,
mkAny cRep
]
++ map mkAny cNums
library = Library 0.3 exprs
-- | Initializing a TypeInference monad with a Library. We need to
-- grab all type variables in the library and make sure that the type
-- variable counter in the state of the TypeInference monad is greater
-- that that counter.
initializeTI :: Monad m => Library -> TypeInference m ()
initializeTI Library{libFunctions=es} = do put (i + 1)
return ()
where go n (expr:rest) = let tvs = getTVars (unsafeCoerce expr :: Expr a)
getTVars expr = tv . eType $ expr
m = maximum $ map (readId . tyVarId) tvs
in if null tvs then 0 else go (max n m) rest
go n [] = n
i = go 0 es
----------------------------------------------------------------------
----------------------------------------------------------------------
-- Main functions.
sampleFromExprs :: (MonadPlus m, MonadRandom m) =>
Library -> Type -> TypeInference m (Expr a)
-- | Samples a combinator of type t from a stochastic grammar G.
sampleFromExprs lib@Library{probOfApp=prApp, libFunctions=exprs} tp
= do initializeTI lib
tp' <- freshInst tp
sample tp'
where sample tp = do
shouldExpand <- flip prApp
case shouldExpand of
True -> do t <- newTVar Star
(e_left :: Expr (b -> a)) <- unsafeCoerce $ sample (t ->- tp)
(e_right :: Expr b) <- unsafeCoerce $ sample (fromType (eType e_left))
return $ e_left <> e_right -- return application
False -> do let cs = map fst . runTI $ filterExprsByType exprs tp
guard (not . null $ cs)
i <- getRandomR (0, length cs - 1)
return $ unsafeCoerce (cs !! i)
----------------------------------------------------------------------
----------------------------------------------------------------------
main = replicateM 100 $
do let out = runTI $ do sampleFromExprs library (TAp tList tInt)
x <- catch (liftM (Just . fst) out)
(\_ -> putStrLn "error" >> return Nothing)
case x of
Just y -> putStrLn $ show x ++ " " ++ show (unsafeCoerce (eval y) :: [Int])
Nothing -> putStrLn ""