Send Beginners mailing list submissions to
        beginners@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-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1. Re:  Best way to stop listening on a port.
      (Brandon S. Allbery KF8NH)
   2.  Fractal map generator in Haskell - can it be     simplified?
      (Maciej Piechotka)
   3.  Re: web server availability (Benjamin L. Russell)
   4.  Fractal map generator in Haskell - can it be     simplified?
      (Maciej Piechotka)
   5.  Fractal map generator in Haskell - can it be     simplified?
      (Maciej Piechotka)
   6. Re:  problem with System.Directory.Tree (Anand Mitra)


----------------------------------------------------------------------

Message: 1
Date: Mon, 7 Jun 2010 19:34:15 -0400
From: "Brandon S. Allbery KF8NH" <allb...@ece.cmu.edu>
Subject: Re: [Haskell-beginners] Best way to stop listening on a port.
To: aditya siram <aditya.si...@gmail.com>
Cc: beginners <beginners@haskell.org>
Message-ID: <551f7e2b-e56d-4f5b-bcb4-ae681d4cb...@ece.cmu.edu>
Content-Type: text/plain; charset="us-ascii"

On Jun 4, 2010, at 14:59 , aditya siram wrote:
> Sometimes I run this server in GHCI and interrupt it with C-c. But
> when I try and rerun the server it tells me that the port is already
> bound meaning that sClose either doesn't get called or doesn't
> complete. Terminating the interpreter seems to work.


Most systems keep a port bound for a little while after the socket  
bound to it exits, so that any stray packets still in flight for that  
port will correctly be caught and responded to.

The usual workaround for this is to set the SO_REUSEADDR flag (which  
is sO_REUSEADDR in the Haskell network library) so that you can bind  
to it immediately instead of waiting for it to time out.

-- 
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon university    KF8NH


-------------- next part --------------
A non-text attachment was scrubbed...
Name: PGP.sig
Type: application/pgp-signature
Size: 195 bytes
Desc: This is a digitally signed message part
Url : 
http://www.haskell.org/pipermail/beginners/attachments/20100607/87b07f04/PGP-0001.bin

------------------------------

Message: 2
Date: Mon, 07 Jun 2010 01:29:11 +0100
From: Maciej Piechotka <uzytkown...@gmail.com>
Subject: [Haskell-beginners] Fractal map generator in Haskell - can it
        be      simplified?
To: beginners@haskell.org
Message-ID: <1275870551.7753.25.ca...@localhost.localdomain>
Content-Type: text/plain; charset="utf-8"

I tried to implement fractal map generator in Haskell. While the code is
correct (I believe) it is not nice:

> {-# LANGUAGE FlexibleContexts #-}
> import Control.Applicative
> import Data.Array
> import Data.Bits
> import Data.Foldable
> import Data.Ix
> import Data.Random
> import Data.Traversable
> import Debug.Trace
> import Text.Printf
> import Prelude hiding (sum)
> 
> ctz :: Bits a => a -> Int
> ctz x...@0 = bitSize x
> ctz x   = let ctz' n | x .&. bit n /= 0 = n
>                      | otherwise        = ctz' (n+1)
>           in ctz' 0
> 

Count trailing zeros.

> imLog :: Integral a => a -> a -> a
> imLog b x | x < b     = 0
>           | otherwise = doDiv (x`div`(b^l)) l
>           where l = 2 * imLog (b*b) x
>                 doDiv x l | x < b = l 
>                           | otherwise = doDiv (x`div`b) (l+1)
> 

Integer logarithm (from Haskell report)
 
> genArray :: Ix i => (i, i) -> (i -> a) -> Array i a
> genArray r f = listArray r (map f (range r))
>

Helper function (generate array using function taking index)
 
> randArray :: Ix i => (i, i) -> RVar a -> RVar (Array i a)
> randArray r v = listArray r <$> sequenceA (replicate (rangeSize r) v)
> 

Generate array from random value generator.

> sizeArray :: (Bits i, Ix (i, i), Ord i) => ((i, i), (i, i)) -> Array
(i, i) i
> sizeArray r =
>     genArray r (\(x, y) -> fromIntegral (min (findSize x) (findSize
y)))
>     where findSize = fromIntegral . ctz
> 

Generate array how far we should look from this point.

> data FType = Box | Cross deriving (Eq, Show)
> 
> ftypeArray :: (Bits i, Ix (i, i), Ord i, Integral i) =>
>               (i, i) -> Array (i, i) FType
> ftypeArray n = let arr = genArray ((0, 0), n) arrF
>                    arrF (x, y)
>                         | x == y = Box
>                         | x == 0 || y == 0 = Cross
>                         | x <= 2 && y <= 2 = Cross
>                         | x > y = arr ! (x - 2^(imLog 2 x), y)
>                         | x < y = arr ! (x, y - 2^(imLog 2 y))
>                in arr
> 

Generate array should we look on diagonals or columns/rows

> fracArray :: (Bits i, Ix (i, i), Ord i, Fractional v, Integral i)
>           => i -> v -> RVar v -> RVar (Array (i, i) v)
> fracArray n d v = do
>     let size = 2^n
>     ra <- randArray ((0, 0), (size - 1, size)) v
>     let s = sizeArray ((0, 0), (size, size))
>         ft = ftypeArray (size, size)
>         arr = genArray ((0, 0), (size, size)) arrF
>         randF (x, y) = d*(ra ! (x, y))*2^(size - (s ! (x, y)))
>         average l = sum l / fromIntegral (length l)
>         arrF (x, y)
>             | x == 0 && y == 0
>                  = ra ! (0, 0)
>             | x == 0 && y == size
>                  = ra ! (0, size)
>             | x == size
>                  = arr ! (0, y)
>             | x == 0
>                  = randF (x, y) + average [arr ! (x, y - cs), 
>                                            arr ! (x, y + cs),
>                                            arr ! (x + cs, x)]
>             | y == 0
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y + cs)]
>             | y == size
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs)]
>             | ft ! (x, y) == Cross
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs),
>                                            arr ! (x, y + cs)]
>             | ft ! (x, y) == Box
>                  = randF (x, y) + average [arr ! (x - cs, y - cs),
>                                            arr ! (x - cs, y + cs),
>                                            arr ! (x + cs, y - cs),
>                                            arr ! (x + cs, y + cs)]
>             where cs = 2 ^ (s ! (x, y))
>     return arr
> 

Any advice how to improve it?

Regards

PS. Am I correct that it has O(size^2) complexity i.e. O(2^n) [which is
optimal]?

PPS. Sorry if I sent it twice but original message seems to disappear
between my computer and gmane.

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : 
http://www.haskell.org/pipermail/beginners/attachments/20100607/bd7e49ec/attachment-0001.bin

------------------------------

Message: 3
Date: Tue, 08 Jun 2010 06:30:13 +0900
From: dekudekup...@yahoo.com (Benjamin L. Russell)
Subject: [Haskell-beginners] Re: web server availability
To: beginners@haskell.org
Message-ID: <m2bpbm7cpm....@yahoo.com>
Content-Type: text/plain; charset=us-ascii

Paul Higham <polyg...@mac.com> writes:

> Is anyone else having trouble reaching the haskell.org web site? I
> have been unsuccessful in trying to reach it for over a week.  Does
> anybody know what's going on?

You're not alone; I had been experiencing the same problem until a few
seconds ago, when I tried checking this newsgroup again on Gmane.

Apparently, the server just went back up.

-- Benjamin L. Russell
-- 
Benjamin L. Russell  /   DekuDekuplex at Yahoo dot com
http://dekudekuplex.wordpress.com/
Translator/Interpreter / Mobile:  +011 81 80-3603-6725
"Furuike ya, kawazu tobikomu mizu no oto." -- Matsuo Basho^ 



------------------------------

Message: 4
Date: Sat, 05 Jun 2010 15:28:07 +0100
From: Maciej Piechotka <uzytkown...@gmail.com>
Subject: [Haskell-beginners] Fractal map generator in Haskell - can it
        be      simplified?
To: beginners@haskell.org
Message-ID: <1275748087.7753.10.ca...@localhost.localdomain>
Content-Type: text/plain; charset="utf-8"

I tried to implement fractal map generator in Haskell. While the code is
correct (I believe) it is not nice:

> {-# LANGUAGE FlexibleContexts #-}
> import Control.Applicative
> import Data.Array
> import Data.Bits
> import Data.Foldable
> import Data.Ix
> import Data.Random
> import Data.Traversable
> import Debug.Trace
> import Text.Printf
> import Prelude hiding (sum)
> 
> ctz :: Bits a => a -> Int
> ctz x...@0 = bitSize x
> ctz x   = let ctz' n | x .&. bit n /= 0 = n
>                      | otherwise        = ctz' (n+1)
>           in ctz' 0
> 

Count trailing zeros.

> imLog :: Integral a => a -> a -> a
> imLog b x | x < b     = 0
>           | otherwise = doDiv (x`div`(b^l)) l
>           where l = 2 * imLog (b*b) x
>                 doDiv x l | x < b = l 
>                           | otherwise = doDiv (x`div`b) (l+1)
> 

Integer logarithm (from Haskell report)
 
> genArray :: Ix i => (i, i) -> (i -> a) -> Array i a
> genArray r f = listArray r (map f (range r))
>

Helper function (generate array using function taking index)
 
> randArray :: Ix i => (i, i) -> RVar a -> RVar (Array i a)
> randArray r v = listArray r <$> sequenceA (replicate (rangeSize r) v)
> 

Generate array from random value generator.

> sizeArray :: (Bits i, Ix (i, i), Ord i) => ((i, i), (i, i)) -> Array
(i, i) i
> sizeArray r =
>     genArray r (\(x, y) -> fromIntegral (min (findSize x) (findSize
y)))
>     where findSize = fromIntegral . ctz
> 

Generate array how far we should look from this point.

> data FType = Box | Cross deriving (Eq, Show)
> 
> ftypeArray :: (Bits i, Ix (i, i), Ord i, Integral i) =>
>               (i, i) -> Array (i, i) FType
> ftypeArray n = let arr = genArray ((0, 0), n) arrF
>                    arrF (x, y)
>                         | x == y = Box
>                         | x == 0 || y == 0 = Cross
>                         | x <= 2 && y <= 2 = Cross
>                         | x > y = arr ! (x - 2^(imLog 2 x), y)
>                         | x < y = arr ! (x, y - 2^(imLog 2 y))
>                in arr
> 

Generate array should we look on diagonals or columns/rows

> fracArray :: (Bits i, Ix (i, i), Ord i, Fractional v, Integral i)
>           => i -> v -> RVar v -> RVar (Array (i, i) v)
> fracArray n d v = do
>     let size = 2^n
>     ra <- randArray ((0, 0), (size - 1, size)) v
>     let s = sizeArray ((0, 0), (size, size))
>         ft = ftypeArray (size, size)
>         arr = genArray ((0, 0), (size, size)) arrF
>         randF (x, y) = d*(ra ! (x, y))*2^(size - (s ! (x, y)))
>         average l = sum l / fromIntegral (length l)
>         arrF (x, y)
>             | x == 0 && y == 0
>                  = ra ! (0, 0)
>             | x == 0 && y == size
>                  = ra ! (0, size)
>             | x == size
>                  = arr ! (0, y)
>             | x == 0
>                  = randF (x, y) + average [arr ! (x, y - cs), 
>                                            arr ! (x, y + cs),
>                                            arr ! (x + cs, x)]
>             | y == 0
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y + cs)]
>             | y == size
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs)]
>             | ft ! (x, y) == Cross
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs),
>                                            arr ! (x, y + cs)]
>             | ft ! (x, y) == Box
>                  = randF (x, y) + average [arr ! (x - cs, y - cs),
>                                            arr ! (x - cs, y + cs),
>                                            arr ! (x + cs, y - cs),
>                                            arr ! (x + cs, y + cs)]
>             where cs = 2 ^ (s ! (x, y))
>     return arr
> 

Any advice how to improve it?

Regards

PS. Am I correct that it has O(size^2) complexity i.e. O(2^n) [which is
optimal]?
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : 
http://www.haskell.org/pipermail/beginners/attachments/20100607/e8c06f2f/attachment-0001.bin

------------------------------

Message: 5
Date: Mon, 07 Jun 2010 19:43:02 +0100
From: Maciej Piechotka <uzytkown...@gmail.com>
Subject: [Haskell-beginners] Fractal map generator in Haskell - can it
        be      simplified?
To: beginners@haskell.org
Message-ID: <1275936182.30865.17.ca...@localhost.localdomain>
Content-Type: text/plain; charset="utf-8"

I tried to implement fractal map generator in Haskell. While the code is
correct (I believe) it is not nice:

> {-# LANGUAGE FlexibleContexts #-}
> import Control.Applicative
> import Data.Array
> import Data.Bits
> import Data.Foldable
> import Data.Ix
> import Data.Random
> import Data.Traversable
> import Debug.Trace
> import Text.Printf
> import Prelude hiding (sum)
> 
> ctz :: Bits a => a -> Int
> ctz x...@0 = bitSize x
> ctz x   = let ctz' n | x .&. bit n /= 0 = n
>                      | otherwise        = ctz' (n+1)
>           in ctz' 0
> 

Count trailing zeros.

> imLog :: Integral a => a -> a -> a
> imLog b x | x < b     = 0
>           | otherwise = doDiv (x`div`(b^l)) l
>           where l = 2 * imLog (b*b) x
>                 doDiv x l | x < b = l 
>                           | otherwise = doDiv (x`div`b) (l+1)
> 

Integer logarithm (from Haskell report)
 
> genArray :: Ix i => (i, i) -> (i -> a) -> Array i a
> genArray r f = listArray r (map f (range r))
>

Helper function (generate array using function taking index)
 
> randArray :: Ix i => (i, i) -> RVar a -> RVar (Array i a)
> randArray r v = listArray r <$> sequenceA (replicate (rangeSize r) v)
> 

Generate array from random value generator.

> sizeArray :: (Bits i, Ix (i, i), Ord i) => ((i, i), (i, i)) -> Array
(i, i) i
> sizeArray r =
>     genArray r (\(x, y) -> fromIntegral (min (findSize x) (findSize
y)))
>     where findSize = fromIntegral . ctz
> 

Generate array how far we should look from this point.

> data FType = Box | Cross deriving (Eq, Show)
> 
> ftypeArray :: (Bits i, Ix (i, i), Ord i, Integral i) =>
>               (i, i) -> Array (i, i) FType
> ftypeArray n = let arr = genArray ((0, 0), n) arrF
>                    arrF (x, y)
>                         | x == y = Box
>                         | x == 0 || y == 0 = Cross
>                         | x <= 2 && y <= 2 = Cross
>                         | x > y = arr ! (x - 2^(imLog 2 x), y)
>                         | x < y = arr ! (x, y - 2^(imLog 2 y))
>                in arr
> 

Generate array should we look on diagonals or columns/rows

> fracArray :: (Bits i, Ix (i, i), Ord i, Fractional v, Integral i)
>           => i -> v -> RVar v -> RVar (Array (i, i) v)
> fracArray n d v = do
>     let size = 2^n
>     ra <- randArray ((0, 0), (size - 1, size)) v
>     let s = sizeArray ((0, 0), (size, size))
>         ft = ftypeArray (size, size)
>         arr = genArray ((0, 0), (size, size)) arrF
>         randF (x, y) = d*(ra ! (x, y))*2^(size - (s ! (x, y)))
>         average l = sum l / fromIntegral (length l)
>         arrF (x, y)
>             | x == 0 && y == 0
>                  = ra ! (0, 0)
>             | x == 0 && y == size
>                  = ra ! (0, size)
>             | x == size
>                  = arr ! (0, y)
>             | x == 0
>                  = randF (x, y) + average [arr ! (x, y - cs), 
>                                            arr ! (x, y + cs),
>                                            arr ! (x + cs, x)]
>             | y == 0
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y + cs)]
>             | y == size
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs)]
>             | ft ! (x, y) == Cross
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs),
>                                            arr ! (x, y + cs)]
>             | ft ! (x, y) == Box
>                  = randF (x, y) + average [arr ! (x - cs, y - cs),
>                                            arr ! (x - cs, y + cs),
>                                            arr ! (x + cs, y - cs),
>                                            arr ! (x + cs, y + cs)]
>             where cs = 2 ^ (s ! (x, y))
>     return arr
> 

Any advice how to improve it?

Regards

PS. Am I correct that it has O(size^2) complexity i.e. O(2^n) [which is
optimal]?

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : 
http://www.haskell.org/pipermail/beginners/attachments/20100607/bd156e71/attachment-0001.bin

------------------------------

Message: 6
Date: Tue, 8 Jun 2010 06:16:34 +0530
From: Anand Mitra <mi...@kqinfotech.com>
Subject: Re: [Haskell-beginners] problem with System.Directory.Tree
To: Daniel Fischer <daniel.is.fisc...@web.de>
Cc: beginners@haskell.org
Message-ID:
        <aanlktikdbyfrjhhsqfni7-cdkr4dv0jwgh9bz0ksb...@mail.gmail.com>
Content-Type: text/plain; charset="iso-8859-1"

Hi Daniel,

That works just as intended, Thanks.

On Tue, Jun 8, 2010 at 1:31 AM, Daniel Fischer <daniel.is.fisc...@web.de>wrote:

>
> Does
>
> calcMD5 =
>    readDirectoryWith (\x -> do
>        txt <- readFile x
>        return $! md5 txt)
>
> help?
>
> >
> > `----
> >
> > This work perfectly for small directories. readDirectoryWith is
> > already defined in the library and exactly what we want
> >
> > ,----
> >
> > | *Main> calcMD5 "/home/mitra/Desktop/"
> > |
> > | "/home/mitra" :/ Dir {name = "Desktop", contents = [File {name =
> > | "060_LocalMirror_Workflow.t.10.2.62.9.log", file =
> > | f687ad04bc64674134e55c9d2a06902a},File {name = "cmd_run", file =
> > | 6f334f302b5c0d2028adeff81bf2a0d9},File {name = "cmd_run~",
> >
> > `----
> >
> > However when ever I give it something more challenging it gets into
> > trouble.
> >
> > ,----
> >
> > | *Main> calcMD5 "/home/mitra/laptop/"
> > | *** Exception: /home/mitra/laptop/ell/calc-2.02f/calc.info-27:
> > |    openFile: resource exhausted (Too many open files)
> > | *Main> 29~
> >
> > `----
> >
> > If I understand what is happening it seems to be doing all the opens
> > before consuming them via md5. This works fine for small directories
> > but for any practical setup this could potentially be very large. I
> > tried forcing the md5 evaluation in the hope that the file descriptor
> > will be freed once the entire file is read. That did not help, either
> > because I could not get it right or there is some more subtle I am
> > missing.
> >
> > I also had a look at the code in module "System.Directory.Tree" and
> > although it gave me some understanding of how it works I am no closer
> > to a solution.
> >
> > regards
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20100607/9c3faa38/attachment.html

------------------------------

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners


End of Beginners Digest, Vol 24, Issue 6
****************************************

Reply via email to