Jak generować losowe, wpisane funkcje

Question

Chciałbym programowo generować losowe funkcje Haskella i je oceniać. Wydaje mi się, że jedynym sposobem, aby to zrobić, jest generalne programowanie kodu Haskella i uruchamianie go za pomocą interfejsu API GHC lub procesu zewnętrznego, zwracanie ciągu znaków i przetwarzanie go z powrotem w typ danych Haskella. Czy to prawda?

Moje rozumowanie jest następujące. Funkcje są polimorficzne, więc nie mogę używać Typeable. Co ważniejsze, nawet jeśli piszę własny sprawdzian typu i przypisuję każdą funkcję jego typem, nie mogę udowodnić kompilatorowi Haskella, że ​​mój sprawdzian typu jest poprawny. Na przykład, gdy wyciągam dwie funkcje z heterogenicznego zbioru funkcji i aplikuję jeden do drugiego, muszę zapewnić kompilatorowi gwarancję, że funkcja, której używam do wyboru tych funkcji, wybiera tylko funkcje z odpowiednimi typami. Ale nie ma sposobu, aby to zrobić, prawda?

Answer 1

komentarz DarkOtter wspomina QuickCheck za Arbitrary i CoArbitrary klas, które są z pewnością pierwszą rzeczą, jaką należy spróbować. QuickCheck ma tę instancję:

instance (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where ... 

Jak to się dzieje, właśnie wczoraj odczytaniu kodu QuickCheck zrozumieć, jak to działa, więc mogę po prostu dzielić się dowiedziałem podczas gdy to świeże w moim umyśle. QuickCheck zbudowana jest wokół rodzaju, który wygląda tak (i ​​to nie będzie dokładnie taka sama):

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 

Pierwszy trik jest QuickCheck posiada funkcję, która działa w ten sposób (i nie wyszło dokładnie jak to jest realizowane):

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

Wtedy to wykorzystać, aby realizować różne instancje tej CoArbitrary Klasa:

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 

teraz z tych elementów w miejscu, chcemy w ten sposób:

instance (Coarbitrary a, Arbitrary b) => Arbitrary (a -> b) where 
    arbitrary = ... 

nie będę pisać realizacji, ale idea jest taka:

1. Korzystanie instancję CoArbitrary z a i wystąpienie bArbitrary możemy funkcję \a -> coarbitrary a arbitrary, która ma typ a -> Gen b.
2. Należy pamiętać, że Gen b jest nowym typem dla StdGen -> Size -> b, więc typ a -> Gen b jest izomorficzny z a -> StdGen -> Size -> b.
3. Możemy trywialnie napisać funkcję, która przyjmuje dowolną funkcję tego ostatniego typu i przełącza kolejność argumentów wokół, aby zwrócić funkcję typu StdGen -> Size -> a -> b.
4. Ten przestawiony typ jest izomorficzny z Gen (a -> b), więc voilà, pakujemy zmienioną funkcję do Gen, a otrzymaliśmy generator losowych funkcji!

Zalecam przeczytanie źródła QuickCheck, aby samemu to zobaczyć. Kiedy to rozwiążesz, natrafisz tylko na dwa dodatkowe szczegóły, które mogą cię spowolnić. Po pierwsze, klasa Haskell RandomGen ma tę metodę:

-- | The split operation allows one to obtain two distinct random generators. 
split :: RandomGen g => g -> (g, g) 

Operacja ta jest wykorzystywana w przypadku Monad dla Gen i jest dość ważne. Jedną z tych sztuczek jest to, że StdGen to czysty generator liczb pseudolosowych; tak działa Gen (a -> b) dla każdej możliwej wartości a zaburzamy generator b, wykorzystujemy ten zakłócony generator do wygenerowania wyniku b, ale wtedy nigdy nie przesunie stanu zniekształconego generatora; w zasadzie wygenerowana funkcja a -> b jest zamknięciem nad pseudolosowym ziarnem i za każdym razem, gdy nazywamy je z pewnym a, używamy tego specyficznego a do deterministycznego tworzenia nowego nasienia, a następnie używamy go do deterministycznego generowania b, który zależy od a i ukryte nasienie.

skrócona rodzaj Seed -> a -> b mniej więcej podsumowuje to, co się dzieje, to funkcja pseudolosowych jest regułą generowania b z nasion pseudolosowych oraz a. To nie zadziała w przypadku imperatywnych generatorów liczb losowych.

Po drugie: zamiast bezpośrednio funkcji (a -> StdGen -> Size -> b) -> StdGen -> Size -> a -> b, jak opisałem powyżej, kod QuickCheck ma promote :: Monad m => m (Gen a) -> Gen (m a), który jest uogólnieniem tego do dowolnego Monad. Kiedy m jest instancją funkcji Monad, promote jest zbieżna z (a -> Gen b) -> Gen (a -> b), więc jest naprawdę taka sama jak szkicuję powyżej.

Answer 2

Czy coś takiego pasuje do twoich potrzeb?

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 

---

EDIT: Opierając się na tej idei, możemy włączyć funkcje, które mają różną liczbę i typy parametrów ... tak długo, jak zastosować je częściowo tak, że wszystkie one mają ten sam typ wynik .

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") 

Answer 3

Dzięki za bardzo dokładne odpowiedzi powyżej! Żadna z odpowiedzi nie zrobiła tego, czego szukałem. Podążyłem za sugestią DarkOttera w komentarzu i użyłem unsafeCoerce, aby uniknąć sprawdzania typu. Podstawową ideą jest to, że tworzymy GADT, który pakuje funkcje Haskella do ich typów; system typu, którego używam, śledzi się z bliska Mark P. Jones '"Typing Haskell in Haskell." Kiedy tylko chcę mieć kolekcję funkcji Haskella, najpierw zmuszam je do typów Any, a potem robię to, co muszę, łącząc je losowo. Kiedy idę do oceny nowych funkcji, najpierw przymuszam je do pożądanego typu. Oczywiście nie jest to bezpieczne; jeśli mój kontroler jest nieprawidłowy lub przypisuję funkcje haskell niepoprawnym typom, to kończę z nonsensem.

Skopiowałem kod, który przetestowałem poniżej. Zauważ, że są importowane dwa lokalne moduły: Strappy.Type i Strappy.Utils. Pierwszym z nich jest wspomniany wyżej system typów. Drugi wprowadza pomocników do programów stochastycznych.

Uwaga: w poniższym kodzie używam logiki kombinatorycznej jako podstawowego języka. Dlatego mój język ekspresji ma tylko aplikację i żadnych zmiennych ani abstrakcji 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 ""