मुहावरेदार रास्ता

Question

मान लीजिए मैं एक रिकॉर्ड प्रकार है:

data Foo = Foo {x, y, z :: Integer} 

एक मनमाना उदाहरण लेखन की एक स्वच्छ रास्ता इस तरह Control.Applicative उपयोग करता है:

instance Arbitrary Foo where 
    arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary 
    shrink f = Foo <$> shrink (x f) <*> shrink (y f) <*> shrink (z f) 

की सूची एक फू के लिए shrinks इस प्रकार अपने सदस्यों के सभी shrinks के कार्टशियन उत्पाद है।

लेकिन यदि इनमें से कोई भी कमी आती है [] तो फू के लिए पूरी तरह से कोई कमी नहीं होगी। तो यह काम नहीं करता है।

मैं छोटा सूची में मूल मूल्य शामिल करके यह बचत की कोशिश कर सकते:

shrink f = Foo <$> ((x f) : shrink (x f)) <*> ... {and so on}. 

लेकिन अब हटना (फू 0 0 0) वापस आ जाएगी [फू 0 0 0], जिसका अर्थ है कि सिकुड़ने कभी नहीं होगा समाप्त। तो यह या तो काम नहीं करता है।

ऐसा लगता है कि < *> के अलावा कुछ और होना चाहिए, लेकिन मैं नहीं देख सकता।

Answer 1

मैं क्या मुहावरेदार पर विचार किया जाएगा पता नहीं है, लेकिन

shrink f = tail $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f) 
    where 
    shrink' a = a : shrink a 

कि क्या करना होगा अगर आप यह सुनिश्चित करें कि हर सिकुड़ने दूसरों में वृद्धि के बिना कम से कम एक क्षेत्र को कम कर देता, चाहते हैं। सूचियों के लिए Applicative उदाहरण ऐसा है कि मूल मूल्य परिणाम सूची में पहला है, इसलिए बस आपको छोड़कर मूल्यों की एक सूची वास्तव में घट जाती है, इसलिए संकीर्ण हो जाती है।

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

data Fallback a 
    = Fallback a 
    | Many [a] 

unFall :: Fallback a -> [a] 
unFall (Fallback _) = [] 
unFall (Many xs) = xs 

fall :: a -> [a] -> Fallback a 
fall u [] = Fallback u 
fall _ xs = Many xs 

instance Functor Fallback where 
    fmap f (Fallback u) = Fallback (f u) 
    fmap f (Many xs) = Many (map f xs) 

instance Applicative Fallback where 
    pure u = Many [u] 
    (Fallback f) <*> (Fallback u) = Fallback (f u) 
    (Fallback f) <*> (Many xs) = Many (map f xs) 
    (Many fs) <*> (Fallback u) = Many (map ($ u) fs) 
    (Many fs) <*> (Many xs) = Many (fs <*> xs) 

instance Arbitrary Foo where 
    arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary 
    shrink f = unFall $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f) 
     where 
     shrink' a = fall a $ shrink a 

शायद कोई ऐसा करने के लिए एक अच्छे तरीके से आता है।

data ShrinkOne a = ShrinkOne a [a] 

instance Functor ShrinkOne where 
    fmap f (ShrinkOne o s) = ShrinkOne (f o) (map f s) 

instance Applicative ShrinkOne where 
    pure x = ShrinkOne x [] 
    ShrinkOne f fs <*> ShrinkOne x xs = ShrinkOne (f x) (map ($x) fs ++ map f xs) 

shrinkOne :: Arbitrary a => a -> ShrinkOne a 
shrinkOne x = ShrinkOne x (shrink x) 

unShrinkOne :: ShrinkOne t -> [t] 
unShrinkOne (ShrinkOne _ xs) = xs 

मैं इसे उपयोग कर रहा हूँ कोड में है कि इस तरह दिखता है:

Answer 2

आप एक अनुप्रयोगी functor कि वास्तव में एक ही स्थिति में हटना होगा चाहते हैं, तो आप इस एक जो मैं बस ठीक है कि खुजली खरोंच करने के लिए बनाया का आनंद सकता है , हटना या तो टपल के बाईं तत्व में, या टपल के अधिकार के तत्व के क्षेत्रों में से एक में:

shrink (tss,m) = unShrinkOne $ 
    ((,) <$> shrinkOne tss <*> traverse shrinkOne m) 

अब तक अच्छा काम करता है!

वास्तव में, यह इतना अच्छा काम करता है कि मैंने इसे a hackage package के रूप में अपलोड किया।