यादृच्छिक, टाइप किए गए फ़ंक्शंस कैसे उत्पन्न करें

Question

मैं प्रोग्रामेटिक रूप से यादृच्छिक हास्केल फ़ंक्शंस जेनरेट करना चाहता हूं और उनका मूल्यांकन करना चाहता हूं। ऐसा लगता है कि ऐसा करने का एकमात्र तरीका मूल रूप से हास्केल कोड को प्रोग्रामेटिक रूप से उत्पन्न करना है और इसे जीएचसी एपीआई या बाहरी प्रक्रिया का उपयोग करके चलाएं, एक स्ट्रिंग लौटाना, और इसे वापस हास्केल डेटा प्रकार में पार्स करना। क्या ये सच है?

मेरा तर्क निम्नानुसार है। फ़ंक्शन पॉलिमॉर्फिक हैं इसलिए मैं टाइप करने योग्य का उपयोग नहीं कर सकता। सबसे महत्वपूर्ण बात यह है कि, अगर मैं अपना खुद का टाइप चेकर लिखता हूं और प्रत्येक फंक्शन को अपने प्रकार के साथ एनोटेट करता हूं, तो मैं हास्केल कंपाइलर को साबित नहीं कर सकता कि मेरा टाइप चेकर सही है। उदाहरण के लिए, जब मैं दो कार्यों को एक विषम संग्रह के संग्रह से बाहर खींचता हूं और एक दूसरे को लागू करता हूं, तो मुझे संकलक के साथ संकलक प्रदान करने की आवश्यकता होती है कि मैं इन फ़ंक्शंस को चुनने के लिए उपयोग कर रहा हूं जो फ़ंक्शन केवल इसी प्रकार के कार्यों को चुनता है। लेकिन ऐसा करने का कोई तरीका नहीं है, है ना?

Answer 1

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

मैं कार्यान्वयन लिख नहीं होगा, लेकिन विचार यह है:

1. a की CoArbitrary उदाहरण और b की Arbitrary उदाहरण का उपयोग करते हुए हम समारोह \a -> coarbitrary a arbitrary, टाइप है जो कर सकते हैं a -> Gen b।
2. याद रखें कि Gen bStdGen -> Size -> b के लिए एक नया प्रकार है, इसलिए a -> Gen ba -> StdGen -> Size -> b पर isomorphic है।
3. हम उस फ़ंक्शन को छोटे से लिख सकते हैं जो उस बाद के प्रकार का कोई भी फ़ंक्शन लेता है और StdGen -> Size -> a -> b प्रकार के फ़ंक्शन को वापस करने के लिए तर्क ऑर्डर को स्विच करता है।
4. यह पुनर्नवीनीकरण प्रकार Gen (a -> b) पर isomorphic है, इसलिए voilà, हम पुनर्नवीनीकरण फ़ंक्शन को Gen में पैक करते हैं, और हमें हमारे यादृच्छिक फ़ंक्शन जेनरेटर मिलते हैं!

मैं अनुशंसा करता हूं कि आप इसे अपने लिए देखने के लिए क्विक चेक के स्रोत को पढ़ लें। जब आप इससे निपटते हैं, तो आप केवल दो अतिरिक्त विवरणों में भागने जा रहे हैं जो आपको धीमा कर सकते हैं। सबसे पहले, हास्केल RandomGen वर्ग इस विधि है:

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

इस आपरेशन Gen के लिए Monad उदाहरण में प्रयोग किया जाता है, और नहीं बल्कि महत्वपूर्ण है। यहां चालों में से एक यह है कि 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 फ़ंक्शन के बजाय, क्विक चेक कोड में promote :: Monad m => m (Gen a) -> Gen (m a) है, जो कि Monad पर इसका सामान्यीकरण है। जब mMonad का फ़ंक्शन उदाहरण है, promote(a -> Gen b) -> Gen (a -> b) के साथ मेल खाता है, तो यह वास्तव में वही है जैसा मैं ऊपर स्केच करता हूं।

Answer 2

क्या इन पंक्तियों के साथ कुछ आपकी आवश्यकताओं को पूरा करेगा?

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

Answer 3

उपर्युक्त उत्तरों के लिए धन्यवाद! प्रतिक्रियाओं में से कोई भी नहीं, जो मैंने खोजा था, वही किया। मैंने सवाल टिप्पणी में डार्कऑटर के सुझाव पर पीछा किया, और unsafeCoerce टाइप चेकर से बचें। मूल विचार यह है कि हम एक जीएडीटी बनाते हैं जो हास्केल कार्यों को उनके प्रकार के साथ पैकेज करता है; मैं जिस प्रकार का सिस्टम उपयोग करता हूं वह बहुत करीब से मिलता है मार्क पी जोन्स '"Typing Haskell in Haskell." जब भी मैं हास्केल फ़ंक्शंस का संग्रह चाहता हूं, तो मैं उन्हें पहले Any प्रकारों में जोड़ता हूं, फिर मैं करता हूं जो मुझे करने की ज़रूरत है, उन्हें यादृच्छिक रूप से एक साथ सिलाई। जब मैं नए कार्यों का मूल्यांकन करने के लिए जाता हूं, तो पहले मैं उन प्रकारों को वापस भेजता हूं जिन्हें मैं चाहता था। बेशक, यह सुरक्षित नहीं है; अगर मेरा टाइप चेकर गलत है या मैं गलत प्रकार के साथ हैकेल फ़ंक्शन को एनोटेट करता हूं, तो मैं बकवास के साथ समाप्त होता हूं।

मैंने कोड को चिपकाया है जिसे मैंने नीचे परीक्षण किया है। ध्यान दें कि दो स्थानीय मॉड्यूल आयात किए जा रहे हैं Strappy.Type और Strappy.Utils। पहला ऊपर वर्णित प्रकार प्रणाली है। दूसरा स्टोकास्टिक कार्यक्रमों के लिए सहायकों में लाता है।

नोट: नीचे दिए गए कोड में मैं संयोजी तर्क को मूल भाषा के रूप में उपयोग कर रहा हूं। यही कारण है कि मेरी अभिव्यक्ति भाषा में केवल एप्लिकेशन और कोई चर या लैम्ब्डा अमूर्तता नहीं है।

{-# 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 ""