我想以编程方式生成随机 Haskell 函数并评估它们。在我看来，这样做的唯一方法是基本上以编程方式生成 Haskell 代码并使用 GHC API 或外部进程运行它，返回一个字符串，并将其解析回 Haskell 数据类型。这是真的？
我的推理如下。这些函数是多态的，所以我不能使用 Typeable。更重要的是，即使我编写自己的类型检查器并用其类型注释每个函数，我也无法向 Haskell 编译器证明我的类型检查器是正确的。例如，当我从一个异构函数集合中提取两个函数并将一个函数应用到另一个时，我需要向编译器提供保证，即我用来选择这些函数的函数只选择具有相应类型的函数。但是没有办法做到这一点，对吧？
DarkOtter 的评论提到了 QuickCheckArbitrary和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 = ...
我不会写出实现，但想法是这样的：
CoArbitraryinstance ofa和Arbitraryinstance ofb我们可以创建\a -> coarbitrary a arbitrary具有 type的函数a -> Gen b。Gen b是 的StdGen -> Size -> b新类型，因此该类型a -> Gen b与 同构a -> StdGen -> Size -> b。StdGen -> Size -> a -> b。Gen (a -> b)，所以瞧，我们将重新排列的函数打包到 aGen中，我们得到了随机函数生成器！我建议您阅读 QuickCheck 的源代码以亲自查看。当你解决这个问题时，你只会遇到两个可能会让你慢下来的额外细节。首先，HaskellRandomGen类有这个方法：
-- | The split operation allows one to obtain two distinct random generators.
split :: RandomGen g => g -> (g, g)
该操作在 for 的Monad实例中使用Gen，并且相当重要。这里的技巧之一是它StdGen是一个纯伪随机数生成器；可行的方法Gen (a -> b)是，对于a我们扰动b生成器的每个可能值，使用该扰动生成器来生成b结果，但是我们永远不会推进扰动生成器的状态；基本上生成的a -> b函数是一个伪随机种子的闭包，每次我们用一些调用它时，a我们使用特定a的来确定性地创建一个新的种子，然后使用它来确定性地生成一个b依赖于a和隐藏的种子。
缩写类型Seed -> a -> b或多或少总结了正在发生的事情——伪随机函数是b从伪随机种子和a. 这不适用于命令式的有状态随机数生成器。
(a -> StdGen -> Size -> b) -> StdGen -> Size -> a -> b第二： QuickCheck 代码没有像我上面描述的那样直接具有函数，而是具有promote :: Monad m => m (Gen a) -> Gen (m a)，这是对 any 的概括Monad。m的函数实例是什么时候Monad，promote与 重合(a -> Gen b) -> Gen (a -> b)，所以真的和我上面画的一样。
感谢上面非常彻底的答案！没有任何回应，但完全符合我的要求。我在问题的评论中跟进了 DarkOtter 的建议，并unsafeCoerce避免使用类型检查器。基本思想是我们创建一个 GADT，将 Haskell 函数与其类型打包在一起；我使用的类型系统非常接近 Mark P. Jones 的“在 Haskell 中键入 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 ""
这些方面的东西会满足您的需求吗？
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
编辑：基于这个想法，我们可以合并具有不同数量和类型的参数的函数......只要我们部分应用它们，以便它们都具有相同的结果类型。
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")