cách Idiomatic co lại mức kỷ lục trong QuickCheck

Question

Giả sử tôi có một loại kỷ lục:

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

Một cách gọn gàng viết một ví dụ Arbitrary sử dụng Control.Applicative như thế này:

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

Danh mục co lại cho một Foo là như vậy, sản phẩm Descartes của tất cả các co lại của các thành viên của nó.

Nhưng nếu một trong những thu nhỏ này trả về [] thì sẽ không có sự co lại cho toàn bộ Foo. Vì vậy, điều này không hoạt động.

tôi có thể cố gắng tiết kiệm nó bằng cách bao gồm các giá trị ban đầu trong danh sách co:

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

Nhưng bây giờ thu nhỏ (Foo 0 0 0) sẽ trở lại [Foo 0 0 0], có nghĩa là thu hẹp sẽ không bao giờ chấm dứt. Vì vậy, điều đó không hoạt động.

Có vẻ như có gì đó khác hơn < *> đang được sử dụng tại đây, nhưng tôi không thể nhìn thấy gì.

Answer 1

Tôi không biết những gì sẽ được coi là thành ngữ, nhưng nếu bạn muốn đảm bảo rằng tất cả các thu hẹp lại giảm ít nhất một lĩnh vực mà không làm tăng những người khác,

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

sẽ làm điều đó. Ví dụ Applicative cho danh sách sao cho giá trị ban đầu là giá trị đầu tiên trong danh sách kết quả, do đó, chỉ việc giảm giá trị đó sẽ đưa bạn một danh sách các giá trị thực sự bị thu hẹp, do đó thu hẹp kết thúc.

Nếu bạn muốn tất cả các trường bị thu hẹp nếu có thể và chỉ các trường không thể tách rời được giữ nguyên, phức tạp hơn một chút, bạn cần liên lạc cho dù bạn đã thu nhỏ thành công hay không và trong trường hợp bạn 't nhận được bất kỳ ở cuối, trả lại một danh sách trống. Những gì rơi ra khỏi đỉnh đầu của tôi là

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 

có thể ai đó đến với một cách tốt hơn để làm điều đó.

Answer 2

Nếu bạn muốn một functor applicative rằng sẽ co lại trong đúng một vị trí, bạn có thể thưởng thức một này mà tôi vừa tạo ra để làm xước một cách chính xác rằng ngứ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 

Tôi đang sử dụng nó trong mã trông như thế này , để thu nhỏ hoặc trong phần tử bên trái của tuple, hoặc trong một trong các trường của phần tử bên phải của bộ dữ liệu:

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

Hoạt động tuyệt vời cho đến nay!

Thực tế, nó hoạt động tốt đến nỗi tôi đã tải nó lên làm a hackage package.