Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread ok

 The difference is what's called dynamic programming (an utterly
 non-intuitive and un-insightful name).

It was meant to be.  The name was chosen to be truthful while
not revealing too much to a US Secretary of Defense of whom
Bellman wrote:
 His face would suffuse, he would turn red, and he would get
  violent if people used the term, research, in his presence.
  You can imagine how he felt, then, about the term, mathematical.
(http://en.wikipedia.org/wiki/Dynamic_programming)

Every time I try to imagine this guy having Haskell explained to
him my brain refuses to co-operate.

The word programming here is used in the same sense as in
linear programming and quadratic programming, that is,
optimisation.  Dynamic does hint at the multistage decision
process idea involved.




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Doaitse Swierstra
From the conclusion that both programs compute the same result it can be 
concluded that  the fact that you have made use of a list comprehension has 
forced  you to make a choice which should not matter, i.e. the order in which 
to place the generators. This should be apparent from your code.

My approach is such a situation is to define your own generator (assuming 
here that isSafe needs both its parameters):

pl `x` ql = [ (p,q) | p -pl, q - ql]

queens3 n =  map reverse $ queens' n
where queens' 0   = [[]]

  queens' k   = [q:qs | (qs, q) - queens' (k-1) `x` [1..n], isSafe 
q qs]  
  isSafe   try qs = not (try `elem` qs || sameDiag try qs)  

  sameDiag try qs = any (\(colDist,q) - abs (try - q) == colDist) $ 
zip [1..] qs

Of course you can make more refined versions of `x`, which perform all kinds of 
fair enumeration, but that is not the main point here. It is the fact that the 
parameters to `x` are only evaluated once which matters here.

 Doaitse

On Jan 29, 2013, at 10:25 , Junior White efi...@gmail.com wrote:

 Hi Cafe,
I have two programs for the same problem Eight queens problem,
 the link is http://www.haskell.org/haskellwiki/99_questions/90_to_94.
My two grograms only has little difference, but the performance, this is 
 my solution:
 
 -- solution 1
 queens1 :: Int - [[Int]] 
   
 queens1 n = map reverse $ queens' n   
   
 where queens' 0   = [[]]  
   
   queens' k   = [q:qs | q - [1..n], qs - queens' (k-1), isSafe 
 q qs]  
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)
   
   sameDiag try qs = any (λ(colDist, q) - abs (try - q) == colDist) $ 
 zip [1..] qs 
 
 -- solution 2--
 queens2 :: Int - [[Int]] 
   
 queens2 n = map reverse $ queens' n   
   
 where queens' 0   = [[]]  
   
   queens' k   = [q:qs | qs - queens' (k-1), q - [1..n], isSafe 
 q qs]  
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)
   
   sameDiag try qs = any (λ(colDist,q) - abs (try - q) == colDist) $ 
 zip [1..] qs 
 
 the performance difference is: (set :set +s in ghci)
 *Main length (queens1 8)
 92
 (287.85 secs, 66177031160 bytes)
 *Main length (queens2 8)
 92
 (0.07 secs, 17047968 bytes)
 *Main 
 
 The only different in the two program is in the first is q - [1..n], qs - 
 queens' (k-1), and the second is qs - queens' (k-1), q - [1..n].
 
 Does sequence in list comprehansion matter? And why?
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Adrian Keet
The whole point here is to evaluate both lists inside the list 
comprehension only once. There is a very simple way to accomplish this:


[q:qs | let qss = queens' (k-1), q - [1..n], qs - qss]

Here, queens' (k-1) is only evaluated once, and is shared for all q.

(Note: If queens' (k-1) is polymorphic (which it is) and you use 
-XNoMonomorphismRestriction, then you better add a type annotation to 
qss to ensure sharing.)


Adrian

On 2013/01/30 1:51, Doaitse Swierstra wrote:
From the conclusion that both programs compute the same result it can 
be concluded that  the fact that you have made use of a list 
comprehension has forced  you to make a choice which should not 
matter, i.e. the order in which to place the generators. This should 
be apparent from your code.


My approach is such a situation is to define your own generator 
(assuming here that isSafe needs both its parameters):


pl `x` ql = [ (p,q) | p -pl, q - ql]

queens3 n =  map reverse $ queens' n
where queens' 0   = [[]]
  queens' k   = [q:qs | (qs, q) - queens' (k-1) `x` 
[1..n], isSafe q qs]

  isSafe   try qs = not (try `elem` qs || sameDiag try qs)
  sameDiag try qs = any (\(colDist,q) - abs (try - q) == 
colDist) $ zip [1..] qs


Of course you can make more refined versions of `x`, which perform all 
kinds of fair enumeration, but that is not the main point here. It is 
the fact that the parameters to `x` are only evaluated once which 
matters here.


 Doaitse

On Jan 29, 2013, at 10:25 , Junior White efi...@gmail.com 
mailto:efi...@gmail.com wrote:



Hi Cafe,
   I have two programs for the same problem Eight queens problem,
the link is http://www.haskell.org/haskellwiki/99_questions/90_to_94.
   My two grograms only has little difference, but the performance, 
this is my solution:


-- solution 1
queens1 :: Int - [[Int]]
queens1 n = map reverse $ queens' n
where queens' 0   = [[]]
  queens' k   = [q:qs | q - [1..n], qs - queens' (k-1), 
isSafe q qs]

  isSafe   try qs = not (try `elem` qs || sameDiag try qs)
  sameDiag try qs = any (?(colDist, q) - abs (try - q) == 
colDist) $ zip [1..] qs


-- solution 
2--

queens2 :: Int - [[Int]]
queens2 n = map reverse $ queens' n
where queens' 0   = [[]]
  queens' k   = [q:qs | qs - queens' (k-1), q - [1..n], 
isSafe q qs]

  isSafe   try qs = not (try `elem` qs || sameDiag try qs)
  sameDiag try qs = any (?(colDist,q) - abs (try - q) == 
colDist) $ zip [1..] qs


the performance difference is: (set :set +s in ghci)
*Main length (queens1 8)
92
(287.85 secs, 66177031160 bytes)
*Main length (queens2 8)
92
(0.07 secs, 17047968 bytes)
*Main

The only different in the two program is in the first is q - 
[1..n], qs - queens' (k-1), and the second is qs - queens' (k-1), 
q - [1..n].


Does sequence in list comprehansion matter? And why?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org mailto:Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Junior White
On Wed, Jan 30, 2013 at 5:51 PM, Doaitse Swierstra doai...@swierstra.netwrote:

 From the conclusion that both programs compute the same result it can be
 concluded that  the fact that you have made use of a list comprehension has
 forced  you to make a choice which should not matter, i.e. the order in
 which to place the generators. This should be apparent from your code.

 My approach is such a situation is to define your own generator
 (assuming here that isSafe needs both its parameters):

 pl `x` ql = [ (p,q) | p -pl, q - ql]

 queens3 n =  map reverse $ queens' n
 where queens' 0   = [[]]

   queens' k   = [q:qs | (qs, q) - queens' (k-1) `x` [1..n],
 isSafe q qs]
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)

   sameDiag try qs = any (\(colDist,q) - abs (try - q) == colDist)
 $ zip [1..] qs

 Of course you can make more refined versions of `x`, which perform all
 kinds of fair enumeration, but that is not the main point here. It is the
 fact that the parameters to `x` are only evaluated once which matters here.


Thanks for your reply!  I must learn more to fully understand what's going
on inside the list comprehension.
But when I frist learn Haskell, it says sequence doesn't matter, but now it
is a big matter, can compiler do some thing for us? I think this behavior
is not friendly to newbies like me, I will take a very long time to work
through it.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Junior White
Thinks! I think compiler should do this for us, isn't it?


On Wed, Jan 30, 2013 at 7:54 PM, Adrian Keet ark...@gmail.com wrote:

  The whole point here is to evaluate both lists inside the list
 comprehension only once. There is a very simple way to accomplish this:

 [q:qs | let qss = queens' (k-1), q - [1..n], qs - qss]

 Here, queens' (k-1) is only evaluated once, and is shared for all q.

 (Note: If queens' (k-1) is polymorphic (which it is) and you use
 -XNoMonomorphismRestriction, then you better add a type annotation to qss
 to ensure sharing.)

 Adrian


 On 2013/01/30 1:51, Doaitse Swierstra wrote:

 From the conclusion that both programs compute the same result it can be
 concluded that  the fact that you have made use of a list comprehension has
 forced  you to make a choice which should not matter, i.e. the order in
 which to place the generators. This should be apparent from your code.

  My approach is such a situation is to define your own generator
 (assuming here that isSafe needs both its parameters):

  pl `x` ql = [ (p,q) | p -pl, q - ql]

  queens3 n =  map reverse $ queens' n
 where queens' 0   = [[]]

   queens' k   = [q:qs | (qs, q) - queens' (k-1) `x` [1..n],
 isSafe q qs]
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)

   sameDiag try qs = any (\(colDist,q) - abs (try - q) == colDist)
 $ zip [1..] qs

  Of course you can make more refined versions of `x`, which perform all
 kinds of fair enumeration, but that is not the main point here. It is the
 fact that the parameters to `x` are only evaluated once which matters here.

   Doaitse

  On Jan 29, 2013, at 10:25 , Junior White efi...@gmail.com wrote:

  Hi Cafe,
I have two programs for the same problem Eight queens problem,
 the link is http://www.haskell.org/haskellwiki/99_questions/90_to_94.
My two grograms only has little difference, but the performance, this
 is my solution:

  -- solution 1
  queens1 :: Int - [[Int]]

 queens1 n = map reverse $ queens' n

 where queens' 0   = [[]]

   queens' k   = [q:qs | q - [1..n], qs - queens' (k-1),
 isSafe q qs]
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)

   sameDiag try qs = any (λ(colDist, q) - abs (try - q) ==
 colDist) $ zip [1..] qs

  -- solution
 2--
  queens2 :: Int - [[Int]]

 queens2 n = map reverse $ queens' n

 where queens' 0   = [[]]

   queens' k   = [q:qs | qs - queens' (k-1), q - [1..n],
 isSafe q qs]
   isSafe   try qs = not (try `elem` qs || sameDiag try qs)

   sameDiag try qs = any (λ(colDist,q) - abs (try - q) == colDist)
 $ zip [1..] qs

  the performance difference is: (set :set +s in ghci)
  *Main length (queens1 8)
 92
 (287.85 secs, 66177031160 bytes)
 *Main length (queens2 8)
 92
 (0.07 secs, 17047968 bytes)
 *Main

  The only different in the two program is in the first is q - [1..n],
 qs - queens' (k-1), and the second is qs - queens' (k-1), q - [1..n].

  Does sequence in list comprehansion matter? And why?
   ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe




 ___
 Haskell-Cafe mailing 
 listHaskell-Cafe@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe



 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Brandon Allbery
On Wed, Jan 30, 2013 at 7:02 AM, Junior White efi...@gmail.com wrote:

 Thanks for your reply!  I must learn more to fully understand what's going
 on inside the list comprehension.
 But when I frist learn Haskell, it says sequence doesn't matter, but now
 it is a big matter, can compiler do some thing for us? I think this
 behavior is not friendly to newbies like me, I will take a very long time
 to work through it.


No, the compiler can't help you here.  The compiler is not an oracle; even
if it could invert your calculation (effectively swapping the loops
around), it can't know which one is more appropriate.

As to sequences:  sequence doesn't matter indeed; data dependencies matter,
and loop ordering imposes a data dependency because loops in Haskell are
encoded as data structures (lists).

-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Rustom Mody
On Wed, Jan 30, 2013 at 5:32 PM, Junior White efi...@gmail.com wrote:



 Thanks for your reply!  I must learn more to fully understand what's going
 on inside the list comprehension.
 But when I frist learn Haskell, it says sequence doesn't matter, but now
 it is a big matter, can compiler do some thing for us? I think this
 behavior is not friendly to newbies like me, I will take a very long time
 to work through it.


Good point.  Being a programmer means having to juggle many hats -- two
important ones being the mathematician-hat and the machine-hat, also called
declaration and 'imperation'  Get only the first and your programs will run
very inefficiently.  Get only the second and your program will have bugs.

Specifically in the case of list comprehensions the newbie needs
- to practice thinking of the comprehension like a set comprehension and
ignoring computation sequences
- to practice thinking of comprehension in terms of map/filter etc ie
operationally

Both views are needed.
Rusi
-- 
http://www.the-magus.in
http://blog.languager.org
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-30 Thread Junior White
Thank you everyone! I like Haskell because the following two reasons:
1. It is beautifully
2. There are many great guys like you here.

I will work harder on it, and forgive me for my broken English.



On Thu, Jan 31, 2013 at 12:41 AM, Rustom Mody rustompm...@gmail.com wrote:



 On Wed, Jan 30, 2013 at 5:32 PM, Junior White efi...@gmail.com wrote:



 Thanks for your reply!  I must learn more to fully understand what's
 going on inside the list comprehension.
 But when I frist learn Haskell, it says sequence doesn't matter, but now
 it is a big matter, can compiler do some thing for us? I think this
 behavior is not friendly to newbies like me, I will take a very long time
 to work through it.


 Good point.  Being a programmer means having to juggle many hats -- two
 important ones being the mathematician-hat and the machine-hat, also called
 declaration and 'imperation'  Get only the first and your programs will run
 very inefficiently.  Get only the second and your program will have bugs.

 Specifically in the case of list comprehensions the newbie needs
 - to practice thinking of the comprehension like a set comprehension and
 ignoring computation sequences
 - to practice thinking of comprehension in terms of map/filter etc ie
 operationally

 Both views are needed.
 Rusi
 --
 http://www.the-magus.in
 http://blog.languager.org


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Artyom Kazak
Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013  
12:25:49 +0300:



The only different in the two program is in the first is q - [1..n], qs
- queens' (k-1), and the second is qs - queens' (k-1), q - [1..n].


In the first case `queens' (k-1)` is being recomputed for every q (that  
is, n times). Of course it would matter :)


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Junior White
Hi Artyom,
   Thanks! But I don't understand why in the first case queens' (k-1) is
being recomputed n times?


On Tue, Jan 29, 2013 at 5:31 PM, Artyom Kazak artyom.ka...@gmail.comwrote:

 Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013
 12:25:49 +0300:


  The only different in the two program is in the first is q - [1..n], qs
 - queens' (k-1), and the second is qs - queens' (k-1), q - [1..n].


 In the first case `queens' (k-1)` is being recomputed for every q (that
 is, n times). Of course it would matter :)

 __**_
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Artyom Kazak
Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013  
12:40:08 +0300:



Hi Artyom,
   Thanks! But I don't understand why in the first case queens' (k-1)  
is

being recomputed n times?


Because your list comprehension is just a syntactic sugar for

concatMap (\q -
  concatMap (\qs - if isSafe q qs then [q:qs] else [])
(queens' (k-1)))
  [1..n]

Here `queens' (k-1)` does not depend on `qs`, and therefore it *could* be  
floated out of the lambda:


let queens = queens' (k-1)
in
concatMap (\q -
  concatMap (\qs - if isSafe q qs then [q:qs] else [])
queens)
  [1..n]

But it is an unsafe optimisation. Suppose that the `queens` list is very  
big. If we apply this optimisation, it will be retained in memory during  
the whole evaluation, which may be not desirable. That’s why GHC leaves  
this to you.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Junior White
Thanks again! I understand now. I'll be careful when the next time I use
list comprehension.


On Tue, Jan 29, 2013 at 5:48 PM, Artyom Kazak artyom.ka...@gmail.comwrote:

 Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013
 12:40:08 +0300:

  Hi Artyom,
Thanks! But I don't understand why in the first case queens' (k-1) is
 being recomputed n times?


 Because your list comprehension is just a syntactic sugar for

 concatMap (\q -
   concatMap (\qs - if isSafe q qs then [q:qs] else [])
 (queens' (k-1)))
   [1..n]

 Here `queens' (k-1)` does not depend on `qs`, and therefore it *could* be
 floated out of the lambda:

 let queens = queens' (k-1)
 in
 concatMap (\q -
   concatMap (\qs - if isSafe q qs then [q:qs] else [])
 queens)
   [1..n]

 But it is an unsafe optimisation. Suppose that the `queens` list is very
 big. If we apply this optimisation, it will be retained in memory during
 the whole evaluation, which may be not desirable. That's why GHC leaves
 this to you.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Junior White
So this is a problem in lazy evaluation language, it will not appear in
python or erlang, am i right?


On Tue, Jan 29, 2013 at 5:54 PM, Junior White efi...@gmail.com wrote:

 Thanks again! I understand now. I'll be careful when the next time I use
 list comprehension.


 On Tue, Jan 29, 2013 at 5:48 PM, Artyom Kazak artyom.ka...@gmail.comwrote:

 Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013
 12:40:08 +0300:

  Hi Artyom,
Thanks! But I don't understand why in the first case queens' (k-1)
 is
 being recomputed n times?


 Because your list comprehension is just a syntactic sugar for

 concatMap (\q -
   concatMap (\qs - if isSafe q qs then [q:qs] else [])
 (queens' (k-1)))
   [1..n]

 Here `queens' (k-1)` does not depend on `qs`, and therefore it *could* be
 floated out of the lambda:

 let queens = queens' (k-1)
 in
 concatMap (\q -
   concatMap (\qs - if isSafe q qs then [q:qs] else [])
 queens)
   [1..n]

 But it is an unsafe optimisation. Suppose that the `queens` list is very
 big. If we apply this optimisation, it will be retained in memory during
 the whole evaluation, which may be not desirable. That's why GHC leaves
 this to you.



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Artyom Kazak
Junior White efi...@gmail.com писал(а) в своём письме Tue, 29 Jan 2013  
12:59:31 +0300:



So this is a problem in lazy evaluation language, it will not appear in
python or erlang, am i right?


Not quite. Compilers of imperative languages don’t perform CSE (common  
subexpression elimination) either; `queens' (k-1)` could have some side  
effects, after all, and performing a side effect only once instead of n  
times is a definite bug.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread Richard O'Keefe

On 29/01/2013, at 10:59 PM, Junior White wrote:

 So this is a problem in lazy evaluation language, it will not appear in 
 python or erlang, am i right?

Wrong.  Let's take Erlang:

[f(X, Y) || X - g(), Y - h()]

Does the order of the generators matter here?
You _bet_ it does.
First off, in all of these languages, it affects
the order of the results.  Let's take a toy case:

g() - [1,2].
h() - [a,b]. % constants
f(X, Y) - {X,Y}. % a pair

[f(X, Y) || X - g(), Y - h()]
 yields [{1,a},{1,b},{2,a},{2,b}]
[f(X, Y) || Y - h(), X - g()]
 yields [{1,a},{2,a},{1,b},{2,b}]

Now let's change it by giving g/0 and h/0 (benign) side effects.
 g() - io:write('g called'), io:nl(), [1,2].
 h() - io:write('h called'), io:nl(), [a,b].
Generating X before Y yields
 'g called'
 'h called'
 'h called'
 [{1,a},{1,b},{2,a},{2,b}]
Generating Y before X yields
 'h called'
 'g called'
 'g called'
 [{1,a},{2,a},{1,b},{2,b}]

If a function call may yield side effects, then the compiler
must not re-order or coalesce calls to that function.
This applies to both Erlang and Python (and to SETL, which
had set and tuple comprehensions before Erlang, Python, or
Haskell were conceived).


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] list comprehansion performance has hug different

2013-01-29 Thread wren ng thornton

On 1/29/13 4:25 AM, Junior White wrote:

Hi Cafe,
I have two programs for the same problem Eight queens problem,
the link is http://www.haskell.org/haskellwiki/99_questions/90_to_94.
My two grograms only has little difference, but the performance, this is
my solution:


The difference is what's called dynamic programming (an utterly 
non-intuitive an un-insightful name). When we have the program:


[ f x xs | xs - g, x - h ]

we're saying, first get me a partial solution (xs), and then try every 
possible way of extending that to a larger solution (x). It should be 
obvious from this description that the computation of each partial 
solution xs will be shared among all candidates x, but that the 
computation of x will not be shared between each xs.


On the other hand, when we have the program:

[ f x xs | x - h, xs - g ]

we're saying, first get me all ways to start a solution (x), and then 
try to solve the rest of the problem (xs). It should be obvious from 
this description that the computation of each x will be shared, but the 
computation of each xs will not.


Imperatively, this is exactly the same distinction as between the 
following programs:


for xs in g:
for x in h:
yield f(x,xs)

for x in h:
for xs in g:
yield f(x,xs)

This difference in sharing can, as you've seen, cause huge differences 
in runtime. Usually it's the difference between a polytime algorithm and 
some exptime algorithm. To see why, just think about the call graph. It 
may be more helpful here to think about something like Fibbonaci 
numbers. In the memoizing version, you're storing the work from solving 
smaller problems and sharing that among the different ways of extending 
the solution; whereas in the naive version, you're recomputing the same 
thing over and over. The call graph for the former is a DAG (or more 
generally, a packed forest) whereas the call graph for the latter is the 
tree you get by unfurling all the shared structure in the DAG.


This distinction has nothing whatsoever to do with Haskell, and has 
everything to do with Intro Algorithms. Loop ordering matters in every 
language with loops, from Haskell to C to Python to Prolog.


--
Live well,
~wren

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe