[Haskell-cafe] what is the fastest way to extract variables from a proposition?

Derek Elkins derek.a.elkins at gmail.com
Wed Feb 20 23:30:41 EST 2008


On Thu, 2008-02-21 at 05:10 +0100, Cetin Sert wrote:
> plong 0 = Var 0
> plong n | even n    = Or  (Var n) (plong (n-1))
>         | otherwise = And (Var n) (plong (n-1))

compare the times again but with plong as follows:
plong 0 = Var 0
plong n | even n = Or (plong (n-1)) (Var n)
        | otherwise = And (plong (n-1)) (Var n)

>  
> 
> main = do print ((length ∘ vars) (plong 10000000))
> real    0m3.290s
> user    0m3.152s
> sys     0m0.020s
> 
> main = do print ((length ∘ vars_) (plong 10000000))
> real    0m3.732s
> user    0m3.680s
> sys     0m0.024s
> 
> --                         vrsn=varsBromage
> main = do print ((length ∘ vrsn) (plong 10000000))
> real    0m4.164s
> user    0m4.128s
> sys     0m0.008s
> 
> ghc -fglasgow-exts -O2
> ghc 6.8.2
> 
> @Andrew:
> It is astonishing to see that your version actually performs the worst
> (at least on my machine). By looking at your code I had also thought
> that yours would be the fastest in terms of runtime performance, it
> was also exactly what I tried but failed to get to here on my own.
> Maybe future ghc versions will change this in favour of your version.
> 
> I would like to have someone test it on another machine though:
> 
> fetch: svn co https://okitsune.svn.sourceforge.net/svnroot/okitsune .
> build: ghc -fglasgow-exts -O2 Common.hs Propositions.hs Test.hs
> testS: time ./a.out sert
> testH: time ./a.out hutton
> testB: time ./a.out bromage
> 
> 
> Best regards,
> Cetin Sert.
> 
> On 21/02/2008, ajb at spamcop.net <ajb at spamcop.net> wrote:
>         G'day all.
>         
>         
>         Quoting Cetin Sert <cetin.sert at gmail.com>:
>         
>         > -- proposition
>         > data Prp a = Var a
>         >            | Not (Prp a)
>         >            | Or  (Prp a) (Prp a)
>         >            | And (Prp a) (Prp a)
>         >            | Imp (Prp a) (Prp a)
>         >            | Xor (Prp a) (Prp a)
>         >            | Eqv (Prp a) (Prp a)
>         >            | Cns Bool
>         >            deriving (Show, Eq)
>         
>         
>         This is probably the fastest:
>         
>         vars :: Prp a -> [a]
>         vars p = vars' p []
>            where
>              vars' (Var a) = (a:)
>         
>              vars' (Not p) = vars' p
>         
>              vars' (Or l r) = vars' l . vars' r
>              {- etc -}
>              vars' (Cns _) = id
>         
>         Cheers,
>         Andrew Bromage
>         
>         _______________________________________________
>         Haskell-Cafe mailing list
>         Haskell-Cafe at haskell.org
>         http://www.haskell.org/mailman/listinfo/haskell-cafe
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list