[Haskell-beginners] Re: Beginners Digest, Vol 19, Issue 30

Gabi bugspynet at gmail.com
Fri Jan 29 11:03:12 EST 2010


I copy pasted Daniel's code. Changed the code to use Mersenne
genrerator and got 4200% (!) improvement:

import System.Random.Mersenne
import System( getArgs )

inCirc :: Double -> Double -> Int
inCirc x y
    | dx*dx + dy*dy < 0.25  = 1
    | otherwise             = 0
      where
        dx = x - 0.5
        dy = y - 0.5

-- transform a list of coordinates into a list of indicators
-- whether the point is inside the circle (sorry for the
-- stupid name)
inCircles :: [Double] -> [Int]
inCircles (x:y:zs) = inCirc x y : inCircles zs
inCircles _ = []

-- given a count of experiments and an infinite list of coordinates,
-- calculate an approximation to pi
calcPi :: Int -> [Double] -> Double
calcPi n ds = fromIntegral ct / fromIntegral n * 4
      where
        ct = sum . take n $ inCircles ds

-- now the IO part is only
-- * getting the number of experiments and
-- * getting the StdGen
main :: IO ()
main = do
    args <- getArgs
    sg <- getStdGen
    let n = case args of
                (a:_) -> read a
                _ -> 10000
    rands  <- randoms sg :: IO [Double]
    print $ calcPi n rands


time ./slow-pi +RTS -K1G -RTS 1000000
3.14222

real	0m6.886s
user	0m6.680s
sys	0m0.200s

time ./improved-pi 1000000
3.14364

real	0m0.163s
user	0m0.160s
sys	0m0.000s


Thanks all for the help !


On Fri, Jan 29, 2010 at 12:31 PM,  <beginners-request at haskell.org> wrote:
> Send Beginners mailing list submissions to
>        beginners at haskell.org
>
> To subscribe or unsubscribe via the World Wide Web, visit
>        http://www.haskell.org/mailman/listinfo/beginners
> or, via email, send a message with subject or body 'help' to
>        beginners-request at haskell.org
>
> You can reach the person managing the list at
>        beginners-owner at haskell.org
>
> When replying, please edit your Subject line so it is more specific
> than "Re: Contents of Beginners digest..."
>
>
> Today's Topics:
>
>   1.  Could not deduce (Matrix m (Maybe a)) from the   context
>      (Matrix m a) (Lyndon Maydwell)
>   2. Re:  subset - a little add (Daniel Fischer)
>   3. Re:  Could not deduce (Matrix m (Maybe a)) from   the context
>      (Matrix m a) (Daniel Fischer)
>   4. Re:  Could not deduce (Matrix m (Maybe a)) from   the context
>      (Matrix m a) (Lyndon Maydwell)
>   5.  subset - a little add (Luca Ciciriello)
>   6. Re:  Could not deduce (Matrix m (Maybe a)) from   the context
>      (Matrix m a) (Daniel Fischer)
>   7.  PI calculation - Newbie question (Gabi)
>
>
> ----------------------------------------------------------------------
>
> Message: 1
> Date: Fri, 29 Jan 2010 16:52:37 +0800
> From: Lyndon Maydwell <maydwell at gmail.com>
> Subject: [Haskell-beginners] Could not deduce (Matrix m (Maybe a))
>        from the        context (Matrix m a)
> To: beginners at haskell.org
> Message-ID:
>        <da8fea9e1001290052x233f51ev8e4c04e2649277e7 at mail.gmail.com>
> Content-Type: text/plain; charset=UTF-8
>
> Hi Beginners.
>
> I'm writing a matrix class for a game of life implementation. When I
> try to compile it I get the error "Could not deduce (Matrix m (Maybe
> a)) from the context (Matrix m a)" for the method vicinityMatrix.
>
> However, when I query the type of an identical implementation to
> vicinityMatrix in ghci it is successful:
>
> :t \m x y -> fromRows $ vicinityRows m x y
> \m x y -> fromRows $ vicinityRows m x y
>  :: forall (m :: * -> *) (m1 :: * -> *) a.
>     (Matrix m (Maybe a), Matrix m1 a) =>
>     m1 a -> Integer -> Integer -> m (Maybe a)
>
> What might be preventing the class from compiling?
>
> Thanks guys.
>
> ---
>
> My Matrix class definition follows below:
>
> module Matrix (Matrix) where
>
> import Data.Array
> import Data.Maybe (catMaybes)
> import Control.Monad (guard)
>
> class Matrix m a
>  where
>    fromRows       :: [[a]] -> m a
>    toList         :: m a   -> [a]
>    rows           :: m a   -> Integer
>    columns        :: m a   -> Integer
>    row            :: m a   -> Integer -> [a]
>    column         :: m a   -> Integer -> [a]
>    at             :: m a   -> Integer -> Integer -> a
>    (!!!)          :: m a   -> Integer -> Integer -> a
>    vicinityRows   :: m a   -> Integer -> Integer -> [[Maybe a]]
>    vicinityMatrix :: m a   -> Integer -> Integer -> m (Maybe a)
>    neighbours     :: m a   -> Integer -> Integer -> [a]
>
>    toList m = do
>      x <- [0 .. columns m - 1]
>      y <- [0 .. rows m - 1]
>      return $ at m x y
>
>    row    m n = [at m x n | x <- [0 .. columns m - 1]]
>    column m n = [at m n y | y <- [0 .. rows    m - 1]]
>
>    at    = (!!!)
>    (!!!) = at
>
>    vicinityRows m x y = do
>      x' <- [x - 1 .. x + 1]
>      return $ do
>        y' <- [y - 1 .. y + 1]
>        return cell where
>          cell
>            | x <  0         = Nothing
>            | y <  0         = Nothing
>            | x >= columns m = Nothing
>            | y >= rows m    = Nothing
>            | otherwise      = Just $ at m x y
>
>    vicinityMatrix m x y = fromRows $ vicinityRows m x y
>
>    -- neighbours = catMaybes . toListN . vicinityMatrix
>
> toListN :: Matrix m a => m a -> [a]
> toListN m = do
>  x <- [0 .. columns m - 1]
>  y <- [0 .. rows m - 1]
>  guard $ x /= 1 && y /= 1
>  return $ at m x y
>
>
> ------------------------------
>
> Message: 2
> Date: Fri, 29 Jan 2010 10:06:29 +0100
> From: Daniel Fischer <daniel.is.fischer at web.de>
> Subject: Re: [Haskell-beginners] subset - a little add
> To: beginners at haskell.org
> Message-ID: <201001291006.30011.daniel.is.fischer at web.de>
> Content-Type: text/plain;  charset="utf-8"
>
> Am Freitag 29 Januar 2010 08:36:35 schrieb Luca Ciciriello:
>> Just a little add to may previous mail.
>>
>> The solution I've found from myself is:
>>
>>
>>
>> subset :: [String] -> [String] -> Bool
>> subset xs ys = and [elem x ys | x <- xs]
>>
>
> Variant:
>
> subset xs ys = all (`elem` ys) xs
>
> but is that really what you want? That says subset [1,1,1,1] [1] ~> True.
> If you regard your lists as representatives of sets (as the name suggests),
> then that's correct, otherwise not.
>
> However, this is O(length xs * length ys). If you need it only for types
> belonging to Ord, a much better way is
>
> import qualified Data.Set as Set
> import Data.Set (fromList, isSubsetOf, ...)
>
> subset xs ys = fromList xs `isSubsetOf` fromList ys
>
> or, if you don't want to depend on Data.Set,
>
> subset xs ys = sort xs `isOrderedSublistOf` sort ys
>
> xxs@(x:xs) `isOrderedSublistOf` (y:ys)
>    | x < y     = False
>    | x == y    = xs `isOrderedSublistOf` ys
>    | otherwise = xxs `isOrderedSublistOf` ys
> [] `isOrderedSublistOf` _ = True
> _ `isOrderedSublistOf` [] = False
>
>>
>>
>> My question is if exists a more elegant way to do that.
>>
>>
>>
>> Luca.
>
>
>
> ------------------------------
>
> Message: 3
> Date: Fri, 29 Jan 2010 10:17:10 +0100
> From: Daniel Fischer <daniel.is.fischer at web.de>
> Subject: Re: [Haskell-beginners] Could not deduce (Matrix m (Maybe a))
>        from    the context (Matrix m a)
> To: beginners at haskell.org
> Message-ID: <201001291017.10744.daniel.is.fischer at web.de>
> Content-Type: text/plain;  charset="utf-8"
>
> Am Freitag 29 Januar 2010 09:52:37 schrieb Lyndon Maydwell:
>> Hi Beginners.
>>
>> I'm writing a matrix class for a game of life implementation. When I
>> try to compile it I get the error "Could not deduce (Matrix m (Maybe
>> a)) from the context (Matrix m a)" for the method vicinityMatrix.
>>
>> However, when I query the type of an identical implementation to
>>
>> vicinityMatrix in ghci it is successful:
>> :t \m x y -> fromRows $ vicinityRows m x y
>>
>> \m x y -> fromRows $ vicinityRows m x y
>>
>>   :: forall (m :: * -> *) (m1 :: * -> *) a.
>>
>>      (Matrix m (Maybe a), Matrix m1 a) =>
>>      m1 a -> Integer -> Integer -> m (Maybe a)
>>
>> What might be preventing the class from compiling?
>
> Well, the error says the compiler (the type checker) can't deduce the
> context (Matrix m (Maybe a)) from the givens. If you supply that
> information,
>
> vicinityMatrix :: Matrix m (Maybe a) =>
>               m a -> Integer -> Integer -> m (Maybe a)
>
> it'll work.
>
>>
>> Thanks guys.
>>
>> ---
>>
>> My Matrix class definition follows below:
>>
>> module Matrix (Matrix) where
>>
>> import Data.Array
>> import Data.Maybe (catMaybes)
>> import Control.Monad (guard)
>>
>> class Matrix m a
>>   where
>>     fromRows       :: [[a]] -> m a
>>     toList         :: m a   -> [a]
>>     rows           :: m a   -> Integer
>>     columns        :: m a   -> Integer
>>     row            :: m a   -> Integer -> [a]
>>     column         :: m a   -> Integer -> [a]
>>     at             :: m a   -> Integer -> Integer -> a
>>     (!!!)          :: m a   -> Integer -> Integer -> a
>>     vicinityRows   :: m a   -> Integer -> Integer -> [[Maybe a]]
>>     vicinityMatrix :: m a   -> Integer -> Integer -> m (Maybe a)
>>     neighbours     :: m a   -> Integer -> Integer -> [a]
>>
>>     toList m = do
>>       x <- [0 .. columns m - 1]
>>       y <- [0 .. rows m - 1]
>>       return $ at m x y
>>
>>     row    m n = [at m x n | x <- [0 .. columns m - 1]]
>>     column m n = [at m n y | y <- [0 .. rows    m - 1]]
>>
>>     at    = (!!!)
>>     (!!!) = at
>>
>>     vicinityRows m x y = do
>>       x' <- [x - 1 .. x + 1]
>>       return $ do
>>         y' <- [y - 1 .. y + 1]
>>         return cell where
>>           cell
>>
>>             | x <  0         = Nothing
>>             | y <  0         = Nothing
>>             | x >= columns m = Nothing
>>             | y >= rows m    = Nothing
>>             | otherwise      = Just $ at m x y
>>
>>     vicinityMatrix m x y = fromRows $ vicinityRows m x y
>>
>>     -- neighbours = catMaybes . toListN . vicinityMatrix
>>
>> toListN :: Matrix m a => m a -> [a]
>> toListN m = do
>>   x <- [0 .. columns m - 1]
>>   y <- [0 .. rows m - 1]
>>   guard $ x /= 1 && y /= 1
>>   return $ at m x y
>
>
>
>
> ------------------------------
>
> Message: 4
> Date: Fri, 29 Jan 2010 17:45:32 +0800
> From: Lyndon Maydwell <maydwell at gmail.com>
> Subject: Re: [Haskell-beginners] Could not deduce (Matrix m (Maybe a))
>        from    the context (Matrix m a)
> To: Daniel Fischer <daniel.is.fischer at web.de>
> Cc: beginners at haskell.org
> Message-ID:
>        <da8fea9e1001290145n4597e3abk51f6bbc87ef78f89 at mail.gmail.com>
> Content-Type: text/plain; charset=UTF-8
>
> Thanks Daniel.
>
> It works, but I'm a bit confused as to why the extra type information is needed.
>
> On Fri, Jan 29, 2010 at 5:17 PM, Daniel Fischer
> <daniel.is.fischer at web.de> wrote:
>> Am Freitag 29 Januar 2010 09:52:37 schrieb Lyndon Maydwell:
>>> Hi Beginners.
>>>
>>> I'm writing a matrix class for a game of life implementation. When I
>>> try to compile it I get the error "Could not deduce (Matrix m (Maybe
>>> a)) from the context (Matrix m a)" for the method vicinityMatrix.
>>>
>>> However, when I query the type of an identical implementation to
>>>
>>> vicinityMatrix in ghci it is successful:
>>> :t \m x y -> fromRows $ vicinityRows m x y
>>>
>>> \m x y -> fromRows $ vicinityRows m x y
>>>
>>>   :: forall (m :: * -> *) (m1 :: * -> *) a.
>>>
>>>      (Matrix m (Maybe a), Matrix m1 a) =>
>>>      m1 a -> Integer -> Integer -> m (Maybe a)
>>>
>>> What might be preventing the class from compiling?
>>
>> Well, the error says the compiler (the type checker) can't deduce the
>> context (Matrix m (Maybe a)) from the givens. If you supply that
>> information,
>>
>> vicinityMatrix :: Matrix m (Maybe a) =>
>>               m a -> Integer -> Integer -> m (Maybe a)
>>
>> it'll work.
>>
>>>
>>> Thanks guys.
>>>
>>> ---
>>>
>>> My Matrix class definition follows below:
>>>
>>> module Matrix (Matrix) where
>>>
>>> import Data.Array
>>> import Data.Maybe (catMaybes)
>>> import Control.Monad (guard)
>>>
>>> class Matrix m a
>>>   where
>>>     fromRows       :: [[a]] -> m a
>>>     toList         :: m a   -> [a]
>>>     rows           :: m a   -> Integer
>>>     columns        :: m a   -> Integer
>>>     row            :: m a   -> Integer -> [a]
>>>     column         :: m a   -> Integer -> [a]
>>>     at             :: m a   -> Integer -> Integer -> a
>>>     (!!!)          :: m a   -> Integer -> Integer -> a
>>>     vicinityRows   :: m a   -> Integer -> Integer -> [[Maybe a]]
>>>     vicinityMatrix :: m a   -> Integer -> Integer -> m (Maybe a)
>>>     neighbours     :: m a   -> Integer -> Integer -> [a]
>>>
>>>     toList m = do
>>>       x <- [0 .. columns m - 1]
>>>       y <- [0 .. rows m - 1]
>>>       return $ at m x y
>>>
>>>     row    m n = [at m x n | x <- [0 .. columns m - 1]]
>>>     column m n = [at m n y | y <- [0 .. rows    m - 1]]
>>>
>>>     at    = (!!!)
>>>     (!!!) = at
>>>
>>>     vicinityRows m x y = do
>>>       x' <- [x - 1 .. x + 1]
>>>       return $ do
>>>         y' <- [y - 1 .. y + 1]
>>>         return cell where
>>>           cell
>>>
>>>             | x <  0         = Nothing
>>>             | y <  0         = Nothing
>>>             | x >= columns m = Nothing
>>>             | y >= rows m    = Nothing
>>>             | otherwise      = Just $ at m x y
>>>
>>>     vicinityMatrix m x y = fromRows $ vicinityRows m x y
>>>
>>>     -- neighbours = catMaybes . toListN . vicinityMatrix
>>>
>>> toListN :: Matrix m a => m a -> [a]
>>> toListN m = do
>>>   x <- [0 .. columns m - 1]
>>>   y <- [0 .. rows m - 1]
>>>   guard $ x /= 1 && y /= 1
>>>   return $ at m x y
>>
>>
>>
>
>
> ------------------------------
>
> Message: 5
> Date: Fri, 29 Jan 2010 10:01:36 +0000
> From: Luca Ciciriello <luca_ciciriello at hotmail.com>
> Subject: [Haskell-beginners] subset - a little add
> To: <beginners at haskell.org>
> Message-ID: <SNT128-W4078FB7A2593E1F547AAA29A5B0 at phx.gbl>
> Content-Type: text/plain; charset="iso-8859-1"
>
>
> Thanks Daniel.
>
> Yes my function operate only in a set-theory contest and your solution:
>
> subset xs ys = all (`elem` ys) xs
>
> is indeed more elegant than mine.
>
> Thanks again for your help.
>
> Luca.
>
>> From: daniel.is.fischer at web.de
>> To: beginners at haskell.org
>> Subject: Re: [Haskell-beginners] subset - a little add
>> Date: Fri, 29 Jan 2010 10:06:29 +0100
>> CC: luca_ciciriello at hotmail.com
>>
>> Am Freitag 29 Januar 2010 08:36:35 schrieb Luca Ciciriello:
>> > Just a little add to may previous mail.
>> >
>> > The solution I've found from myself is:
>> >
>> >
>> >
>> > subset :: [String] -> [String] -> Bool
>> > subset xs ys = and [elem x ys | x <- xs]
>> >
>>
>> Variant:
>>
>> subset xs ys = all (`elem` ys) xs
>>
>> but is that really what you want? That says subset [1,1,1,1] [1] ~> True.
>> If you regard your lists as representatives of sets (as the name suggests),
>> then that's correct, otherwise not.
>>
>> However, this is O(length xs * length ys). If you need it only for types
>> belonging to Ord, a much better way is
>>
>> import qualified Data.Set as Set
>> import Data.Set (fromList, isSubsetOf, ...)
>>
>> subset xs ys = fromList xs `isSubsetOf` fromList ys
>>
>> or, if you don't want to depend on Data.Set,
>>
>> subset xs ys = sort xs `isOrderedSublistOf` sort ys
>>
>> xxs@(x:xs) `isOrderedSublistOf` (y:ys)
>> | x < y = False
>> | x == y = xs `isOrderedSublistOf` ys
>> | otherwise = xxs `isOrderedSublistOf` ys
>> [] `isOrderedSublistOf` _ = True
>> _ `isOrderedSublistOf` [] = False
>>
>> >
>> >
>> > My question is if exists a more elegant way to do that.
>> >
>> >
>> >
>> > Luca.
>>
>
>
>
> Not got a Hotmail account? Sign-up now - Free
>
> _________________________________________________________________
> Send us your Hotmail stories and be featured in our newsletter
> http://clk.atdmt.com/UKM/go/195013117/direct/01/
> -------------- next part --------------
> An HTML attachment was scrubbed...
> URL: http://www.haskell.org/pipermail/beginners/attachments/20100129/5941baf3/attachment-0001.html
>
> ------------------------------
>
> Message: 6
> Date: Fri, 29 Jan 2010 11:31:33 +0100
> From: Daniel Fischer <daniel.is.fischer at web.de>
> Subject: Re: [Haskell-beginners] Could not deduce (Matrix m (Maybe a))
>        from    the context (Matrix m a)
> To: Lyndon Maydwell <maydwell at gmail.com>
> Cc: beginners at haskell.org
> Message-ID: <201001291131.33815.daniel.is.fischer at web.de>
> Content-Type: text/plain;  charset="utf-8"
>
> Am Freitag 29 Januar 2010 10:45:32 schrieb Lyndon Maydwell:
>> Thanks Daniel.
>>
>> It works, but I'm a bit confused as to why the extra type information is
>> needed.
>
> Well, you call fromRows on the result of vicinityRows.
>
> vicinityRows m x y :: [[Maybe a]]
>
> fromRows :: Matrix mat b => [[b]] -> mat b
>
> So for
>
> fromRows (vicinityRows m x y)
>
> to be well typed, you need an
>
> instance Matrix matr (Maybe a) where ...
>
> for some matrix type matr. That has to come from somewhere. It might come
> from an
>
> instance Matrix m a => Matrix m (Maybe a) where ...
>
> or you can supply it as a constraint on the function vicinityMatrix.
>
> However, having a look, none of the methods in the class look like they
> depend on the actual type a, so it might be better to have
>
> class Matrix m where
>    fromRows :: [[a]] -> m a
>    toList :: m a -> [a]
>    rows :: m a -> Integer
>    columns :: m a -> Integer
>    row :: m a -> Integer -> [a]
>    column :: m a -> Integer -> [a]
>    at :: m a -> Integer -> Integer -> a
>    (!!!) :: m a -> Integer -> Integer -> a
>    vicinityRows :: m a -> Integer -> Integer -> [[Maybe a]]
>    vicinityMatrix :: m a -> Integer -> Integer -> m (Maybe a)
>    -- No constraint needed!!
>    neighbours :: m a -> Integer -> Integer -> [a]
>
>>
>> On Fri, Jan 29, 2010 at 5:17 PM, Daniel Fischer
>>
>> <daniel.is.fischer at web.de> wrote:
>> >
>> > Well, the error says the compiler (the type checker) can't deduce the
>> > context (Matrix m (Maybe a)) from the givens. If you supply that
>> > information,
>> >
>> > vicinityMatrix :: Matrix m (Maybe a) =>
>> >               m a -> Integer -> Integer -> m (Maybe a)
>> >
>> > it'll work.
>> >
>> >> Thanks guys.
>> >>
>> >> ---
>> >>
>> >> My Matrix class definition follows below:
>> >>
>> >> module Matrix (Matrix) where
>> >>
>> >> import Data.Array
>> >> import Data.Maybe (catMaybes)
>> >> import Control.Monad (guard)
>> >>
>> >> class Matrix m a
>> >>   where
>> >>     fromRows       :: [[a]] -> m a
> <snip>
>> >>     vicinityRows   :: m a   -> Integer -> Integer -> [[Maybe a]]
>> >>     vicinityMatrix :: m a   -> Integer -> Integer -> m (Maybe a)
>
>
> ------------------------------
>
> Message: 7
> Date: Fri, 29 Jan 2010 12:59:30 +0200
> From: Gabi <bugspynet at gmail.com>
> Subject: [Haskell-beginners] PI calculation - Newbie question
> To: beginners at haskell.org
> Message-ID:
>        <22d241861001290259k1f8b4f0dx47366619ffb8d0af at mail.gmail.com>
> Content-Type: text/plain; charset=ISO-8859-1
>
> Hi Group,
>
> I am just trying to learn the lang and Implemented this PI calculator.
> It is really slow and very memory consuming (much much slower than its
> equivalent in Clojure for instance)
>
> I think the problem is in  "rs <- sequence (replicate n isRandIn)"  -
> But I don't know how to get around it (how do I get a lazy sequence of
> rs? Is it the problem anyway?)
>
> -- p.hs simple PI calculator, using the Monte Carlo Method
>
> import System( getArgs )
> import System.Random
> inCirc :: (Double, Double) -> Int
> inCirc (x,y) = if ((dx * dx) + (dy * dy)) < 0.25
>                        then 1
>                       else 0
>               where dx = x - 0.5
>                          dy = y - 0.5
>
>
> randPoint :: IO (Double, Double)
> randPoint = do
>           x <-getStdRandom (randomR (0, 1 :: Double))
>           y <-getStdRandom (randomR (0, 1 :: Double))
>           return (x, y)
>
>
> isRandIn = do
>          p <- randPoint
>          return (inCirc p)
>
>
> main  = do
>      args <- getArgs
>      let n = if null args
>              then 10000
>              else read $ (head args)::Int
>
>      rs <- sequence (replicate n isRandIn)
>      let pi = (fromIntegral(sum rs) / fromIntegral n) * 4
>      print pi
>
>
> ------------------------------
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>
> End of Beginners Digest, Vol 19, Issue 30
> *****************************************
>


More information about the Beginners mailing list