プログラムでランダムな Haskell 関数を生成して評価したいと思います。これを行う唯一の方法は、基本的にHaskellコードをプログラムで生成し、GHC APIまたは外部プロセスを使用して実行し、文字列を返し、それを解析してHaskellデータ型に戻すことだと私には思えます。これは本当ですか？
私の理屈は以下の通りです。関数は多態的であるため、Typeable を使用できません。さらに重要なことは、独自の型チェッカーを作成し、各関数にその型の注釈を付けたとしても、型チェッカーが正しいことを Haskell コンパイラに証明することはできません。たとえば、異種の関数のコレクションから 2 つの関数を取り出して、一方を他方に適用する場合、これらの関数を選択するために使用している関数が、対応する型の関数のみを選択するという保証をコンパイラに提供する必要があります。しかし、これを行う方法はありませんよね？
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 = ...
実装は書きませんが、アイデアは次のとおりです。
CoArbitraryインスタンスaと のArbitraryインスタンスを使用して、型を持つb関数を作成できます。\a -> coarbitrary a arbitrarya -> Gen bGen bは の newtype でStdGen -> Size -> bあるため、型a -> Gen bは と同形であることを思い出してくださいa -> StdGen -> Size -> b。StdGen -> Size -> a -> b。Gen (a -> b)なので、ほら、再配置された関数を にパックし、Genランダム関数ジェネレーターを取得しました!QuickCheck のソースを読んで、これを自分で確認することをお勧めします。これに取り組むと、速度を低下させる可能性のある 2 つの追加の詳細に遭遇するだけです。まず、HaskellRandomGenクラスには次のメソッドがあります。
-- | The split operation allows one to obtain two distinct random generators.
split :: RandomGen g => g -> (g, g)
この操作は のMonadインスタンスで使用され、Genかなり重要です。ここでのトリックの 1 つは、StdGenが純粋な疑似乱数ジェネレーターであることです。仕組みとしては、ジェネレーターを摂動するGen (a -> b)の可能な値ごとに、その摂動されたジェネレーターを使用して結果を生成しますが、摂動されたジェネレーターの状態を進めることはありません。基本的に、生成された関数は疑似乱数シードに対するクロージャーであり、いくつかでそれを呼び出すたびに、その固有のものを使用して新しいシードを決定論的に作成し、それを使用して依存する aと隠れたシードを決定論的に生成します。abba -> baaba
省略形Seed -> a -> bは、多かれ少なかれ何が起こっているかを要約しています。疑似乱数関数は、b疑似乱数シードと からを生成するための規則ですa。これは、命令型のステートフルな乱数ジェネレーターでは機能しません。
(a -> StdGen -> Size -> b) -> StdGen -> Size -> a -> b2 つ目:上記で説明したように関数を直接持つ代わりに、QuickCheck コードには があります。promote :: Monad m => m (Gen a) -> Gen (m a)これは、それを任意の に一般化したものMonadです。mの関数インスタンスがいつMonadとpromote一致する(a -> Gen b) -> Gen (a -> b)ので、上でスケッチしたものとまったく同じです。
上記の非常に完全な回答をありがとう！応答はありませんでしたが、私が探していたものはまったくありませんでした。質問のコメントでDarkOtterの提案をフォローアップしunsafeCoerce、タイプチェッカーを避けました。基本的な考え方は、Haskell 関数とその型をパッケージ化する GADT を作成することです。私が使用する型システムは、Mark P. Jones の「Haskell での Haskell の入力」にかなり厳密に従っています。Haskell 関数のコレクションが必要なときはいつでも、まずそれらを型に強制しAny、次に必要なことを行い、それらをランダムにつなぎ合わせます。新しい関数を評価するときは、まずそれらを必要な型に強制的に戻します。もちろん、これは安全ではありません。型チェッカーが間違っていたり、haskell 関数に間違った型の注釈を付けたりすると、ナンセンスになってしまいます。
これをテストしたコードを以下に貼り付けました。2 つのローカル モジュールがインポートされていることに注意してStrappy.TypeくださいStrappy.Utils。1 つ目は、前述の型システムです。2 つ目は、確率的プログラムのヘルパーをもたらします。
注: 以下のコードでは、組み合わせロジックを基本言語として使用しています。そのため、私の式言語にはアプリケーションのみがあり、変数やラムダ抽象化はありません。
{-# 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")