esempio applicativo di List viene eseguito sempre nella prova di legge composizione con QuickCheck/Checkers

Question

Voglio realizzare l'istanza applicativa regolare per gli elenchi, usando il mio customly elenco definito:

import Control.Monad 

import Test.QuickCheck 
import Test.QuickCheck.Checkers 
import Test.QuickCheck.Classes 

data List a = 
    Nil 
    | Cons a (List a) 
    deriving (Eq, Ord, Show) 


instance Functor List where 
    fmap f (Cons x xs) = Cons (f x) (fmap f xs) 
    fmap f Nil = Nil 


instance Applicative List where 
    pure x = Cons x Nil 
    (<*>) Nil _ = Nil 
    (<*>) _ Nil = Nil 
    (<*>) (Cons f fs) xs = (+++) (fmap f xs) (fs <*> xs) 

(+++) :: List a -> List a -> List a 
(+++) (Cons x Nil) ys = Cons x ys 
(+++) (Cons x xs) ys = Cons x xs' 
    where xs' = (+++) xs ys 

instance Arbitrary a => Arbitrary (List a) where 
    arbitrary = sized go 
    where go 0 = pure Nil 
      go n = do 
      xs <- go (n - 1) 
      x <- arbitrary 
      return (Cons x xs) 

instance (Eq a) => EqProp (List a) where 
    (=-=) = eq 

main = do 
    let trigger = undefined :: List (Int, String, Int) 
    quickBatch $ applicative trigger 

Il mio codice supera tutti i test applicativi in ​​Checkers tranne uno, la legge sulla composizione. Nessun errore si verifica durante il test della legge sulla composizione, ma non finisce mai.

Il mio codice si ripresenta eternamente in un modo che non sono in grado di vedere, o è solo veeeramente lento per testare la legge sulla composizione?

Questo è il messaggio di errore ricevo se Control-C durante l'esecuzione Dama:

applicative: 
    identity:  +++ OK, passed 500 tests. 
    composition: *** Failed! Exception: 'user interrupt' (after 66 tests): 
Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> Nil)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 
Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> Nil)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 
Cons (-61) (Cons (-24) (Cons 56 (Cons (-10) (Cons 28 (Cons 5 (Cons (-5) (Cons 33 (Cons 18 (Cons 47 (Cons 43 (Cons 43 (Cons (-58) (Cons 35 (Cons (-52) (Cons (-52) (Cons (-41) (Cons 3 (Cons (-7) (Cons (-53) (Cons (-22) (Cons (-20) (Cons (-12) (Cons 46 (Cons (-53) (Cons 35 (Cons (-31) (Cons (-10) (Cons 43 (Cons (-16) (Cons 47 (Cons 53 (Cons 22 (Cons 8 (Cons 1 (Cons (-64) (Cons (-39) (Cons (-57) (Cons 34 (Cons (-31) (Cons 20 (Cons (-39) (Cons (-47) (Cons (-59) (Cons 15 (Cons (-42) (Cons (-31) (Cons 4 (Cons (-62) (Cons (-14) (Cons (-24) (Cons 47 (Cons 42 (Cons 61 (Cons 29 (Cons (-25) (Cons 30 (Cons (-20) (Cons 16 (Cons (-30) (Cons (-38) (Cons (-7) (Cons 16 (Cons 19 (Cons 20 Nil)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 
    homomorphism: +++ OK, passed 500 tests. 
    interchange: +++ OK, passed 500 tests. 
    functor:  +++ OK, passed 500 tests. 

Se una delle funzioni è lento, credo che sia il (+++), ma io non so come GHC esegue il codice abbastanza bene da capire perché.

Aggiornamento:

La legge composizione è:

pure (.) <*> u <*> v <*> w = u <*> (v <*> w) 

Che posso mostrare opere con il mio codice per semplici esempi:

Cons (+1) Nil <*> (Cons (*2) Nil <*> Cons 1 (Cons 2 (Cons 3 Nil))) 

e

pure (.) <*> Cons (+1) Nil <*> Cons (*2) Nil <*> Cons 1 (Cons 2 (Cons 3 Nil)) 

Entrambi dare lo stesso risultato, quindi perché la legge sulla composizione non finisce mai mi ha abbandonato. Potrebbe essere un problema con la libreria checkers?

Answer 1

Il mio primo pensiero è stato che go stava ottenendo un argomento negativo e in loop. Tuttavia, quando lo si modifica per utilizzare trace e si genera un errore se n < 0, ho scoperto che è molto più semplice: il codice è solo molto lento.

qui è la parte ho modificato (go' è stato utilizzato per il tracciamento, ma io in corto circuito per il benchmarking):

import Debug.Trace 

(+++) :: List a -> List a -> List a 
{-# INLINE (+++) #-} 
(+++) (Cons x Nil) ys = Cons x ys 
(+++) (Cons x xs) ys = Cons x xs' 
    where xs' = (+++) xs ys 

maxListSize = 10 

instance Arbitrary a => Arbitrary (List a) where 
    arbitrary = sized go'' 
    where 
     go'' n = go' $ mod n maxListSize 
     go' n = if n < 0 then error ("bad n:" ++ show n) else trace (show n ++ " , ") $ go n 
     go 0 = pure Nil 
     go n = do 
     xs <- go' (n - 1) 
     x <- arbitrary 
     return (Cons x xs) 

Controllo della traccia per una sorta di loop infinito, ho scoperto che le cose non hanno mai smesso progredire, n continua a diminuire, quindi torna indietro per il test successivo. Ci sono voluti solo secondi per un singolo test quando si è rallentato. Ricorda che stai tentando di eseguire 500 di ciascun test.

I miei punti di riferimento non sono rigorosi, ma ecco quello che ho ottenuto (x è il modulo, nella gamma [1..18]):

regressione rapida trovato 5.72238 - 2.8458 x + 0.365263 x^2. Quando ho eseguito la traccia, n continuava ad aumentare. Anche se non sono sicuro di come vengono eseguiti i test, se aumenta il test n, allora n otterrebbe fino a 500.

La formula non è giusta, ma supponiamo che sia un limite accettabile. (Penso che dovrebbe essere dato che l'algoritmo è O(n^2).)

Quindi eseguire tutti i test richiederebbe circa 25 ore, sulla mia macchina.

P.S. Poiché tutti i test passano per limiti ragionevoli su n e non riesco a trovare un bug, penso che il tuo codice sia corretto.