Re: [Haskell-cafe] Haskell and "memoization"

2009-12-17 Thread Ozgur Akgun
Sorry for the last mail, I now tried it and it returns the next value every
time I call it.

I was using an unsafeperformIO trick somewhere, and that fas the one
resulting in the previously described behaviour.

You can just ignore the previous mail.

2009/12/17 Ozgur Akgun 

> Maybe not related, but does the following prove next is called once and
> only once.
>
>
> import qualified Data.ByteString as BS
> import qualified Data.ByteString.Char8 as BSC
>
> next =
> do
> nextcache <- BS.readFile "next.cache"
> let nextint = readInt (BSC.unpack nextcache)
> BS.writeFile "next.cache" (BSC.pack (show (nextint+1)))
> return nextint
>
> readInt :: String -> Int
> readInt = read
>
>
> I put a single character, 1 in the file "next.cache" when I run this
> through ghci, and call next several times, I always get a 1. Whereas in the
> file there is a 2.
> I see that next is a trial of creating a function which returns different
> things everytime its called, but it's in the IO monad, so that should be
> doable.
>
> When I re-run ghci, now it starts to give 2 everytime I call it. Does that
> mean, it doesn't bother to re-read the file while we are in the same
> process.
>
>
> Hope it relates to the OP's question in some way :)
>
> Best,
>
> 2009/12/16 Daniel Fischer 
>
> Am Mittwoch 16 Dezember 2009 15:49:54 schrieb michael rice:
>> > Thanks all,
>> >
>> > OK, so this definition of fib
>> >
>> > fib 0 = 1
>> > fib 1 = 1
>> > fib n = fib (n-1) + fib (n-2)
>> >
>> > would involve a lot of recomputation for some large n,
>>
>> Where "large" can start as low as 20; 60 would be out of reach.
>>
>> > which memoization would eliminate?
>>
>> Right.
>> >
>> > Michael
>>
>> ___
>> Haskell-Cafe mailing list
>> Haskell-Cafe@haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
>
>
> --
> Ozgur Akgun
>



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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-17 Thread Ozgur Akgun
Maybe not related, but does the following prove next is called once and only
once.


import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

next =
do
nextcache <- BS.readFile "next.cache"
let nextint = readInt (BSC.unpack nextcache)
BS.writeFile "next.cache" (BSC.pack (show (nextint+1)))
return nextint

readInt :: String -> Int
readInt = read


I put a single character, 1 in the file "next.cache" when I run this through
ghci, and call next several times, I always get a 1. Whereas in the file
there is a 2.
I see that next is a trial of creating a function which returns different
things everytime its called, but it's in the IO monad, so that should be
doable.

When I re-run ghci, now it starts to give 2 everytime I call it. Does that
mean, it doesn't bother to re-read the file while we are in the same
process.


Hope it relates to the OP's question in some way :)

Best,

2009/12/16 Daniel Fischer 

> Am Mittwoch 16 Dezember 2009 15:49:54 schrieb michael rice:
> > Thanks all,
> >
> > OK, so this definition of fib
> >
> > fib 0 = 1
> > fib 1 = 1
> > fib n = fib (n-1) + fib (n-2)
> >
> > would involve a lot of recomputation for some large n,
>
> Where "large" can start as low as 20; 60 would be out of reach.
>
> > which memoization would eliminate?
>
> Right.
> >
> > Michael
>
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>



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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-16 Thread Daniel Fischer
Am Mittwoch 16 Dezember 2009 15:49:54 schrieb michael rice:
> Thanks all,
>
> OK, so this definition of fib
>
> fib 0 = 1
> fib 1 = 1
> fib n = fib (n-1) + fib (n-2)
>
> would involve a lot of recomputation for some large n,

Where "large" can start as low as 20; 60 would be out of reach.

> which memoization would eliminate?

Right.
>
> Michael

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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-16 Thread michael rice
Thanks all,

OK, so this definition of fib

fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

would involve a lot of recomputation for some large n, which memoization would 
eliminate?

Michael

--- On Wed, 12/16/09, michael rice  wrote:

From: michael rice 
Subject: Re: [Haskell-cafe] Haskell and "memoization"
To: "Daniel Fischer" , "Gregory Crosswhite" 

Cc: haskell-cafe@haskell.org
Date: Wednesday, December 16, 2009, 12:58 AM

Hi all,

I think this (#3 below) is where I got the idea:

http://en.wikipedia.org/wiki/Lazy_evaluation

Excerpt:

---

Lazy evaluation refers to how expressions are evaluated when they are passed as 
arguments to functions and entails the following three points:[1]

   1. The expression is only evaluated if the result is required by the calling 
function, called delayed evaluation.[2]
   2. The expression is only evaluated to the extent that is required by the 
calling function, called Short-circuit evaluation.
   3. the expression is never evaluated more than once, called 
applicative-order evaluation.[3]

---

So, I guess #3 doesn't apply to Haskell, or maybe I just misunderstood the 
meaning of the statement. I assumed that if f(p) = q (by some
 calculation) then that calculation would be replaced by q so the next time the 
function was called it could just return q, as occurs in memoization.

Michael



--- On Tue, 12/15/09, Gregory Crosswhite  wrote:

From: Gregory Crosswhite 
Subject: Re: [Haskell-cafe] Haskell and "memoization"
To: "Daniel Fischer" 
Cc: haskell-cafe@haskell.org
Date: Tuesday, December 15, 2009, 11:47 PM

Hmm, you raise an 
On Dec 15, 2009, at 8:28 PM, Daniel Fischer wrote:

> Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> 
> Not even then, necessarily. And it's not always a good idea.
> 
> f k = [1 .. 20^k]
> 

You raise a really good
 point here.  One can force sharing, as I understand it, by using a let clause:

n =
    let xs = f 20
    in length (xs ++ xs)

If I understand correctly, this should cause xs to be first evaluated, and then 
cached until the full length is computed, which in this case is obviously 
undesirable behavior.

Cheers,
Greg

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





  
-Inline Attachment Follows-

___
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] Haskell and "memoization"

2009-12-15 Thread Daniel Fischer
Am Mittwoch 16 Dezember 2009 07:22:42 schrieb Gregory Crosswhite:
> #3 is true for Haskell, it's just that when your function call appears in
> two different places, it is counted as two different expressions.  Each
> separate expression will only be evaluated once, though.  This is what is
> really meant, since the alternative --- i.e., no function ever being called
> more than once for a given set of arguments --- is way too cumbersome to be
> worth doing in practice for any language.
>
> Laziness really means that if you have, say,
>
>   f x = (g 7) + x
>
> then g 7 need only be evaluated at the first call to f, and then after that
> it can be cached.  In some circumstances, if we had
>
>   f x = (g 7) + x
>   h x = (g 7) * x
>
> Then maybe the compiler would decide not only to evaluate each (g 7)
> expression once, but also that the two expression should be merged into
> references to a single shared expression.  However, this is not required
> for laziness;  the only requirement there is that each expression
> separately only be evaluated once.

And, strictly speaking, Haskell is non-strict, not lazy.
Thus, if an implementation decides to evaluate g 7 thrice in

f x = (x,x,x)

r = f (g 7)

it doesn't violate the specs.

>
> Cheers,
> Greg

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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-15 Thread Gregory Crosswhite
#3 is true for Haskell, it's just that when your function call appears in two 
different places, it is counted as two different expressions.  Each separate 
expression will only be evaluated once, though.  This is what is really meant, 
since the alternative --- i.e., no function ever being called more than once 
for a given set of arguments --- is way too cumbersome to be worth doing in 
practice for any language.

Laziness really means that if you have, say,

f x = (g 7) + x

then g 7 need only be evaluated at the first call to f, and then after that it 
can be cached.  In some circumstances, if we had

f x = (g 7) + x
h x = (g 7) * x

Then maybe the compiler would decide not only to evaluate each (g 7) expression 
once, but also that the two expression should be merged into references to a 
single shared expression.  However, this is not required for laziness;  the 
only requirement there is that each expression separately only be evaluated 
once.

Cheers,
Greg


On Dec 15, 2009, at 9:58 PM, michael rice wrote:

> Hi all,
> 
> I think this (#3 below) is where I got the idea:
> 
> http://en.wikipedia.org/wiki/Lazy_evaluation
> 
> Excerpt:
> 
> ---
> 
> Lazy evaluation refers to how expressions are evaluated when they are passed 
> as arguments to functions and entails the following three points:[1]
> 
>1. The expression is only evaluated if the result is required by the 
> calling function, called delayed evaluation.[2]
>2. The expression is only evaluated to the extent that is required by the 
> calling function, called Short-circuit evaluation.
>3. the expression is never evaluated more than once, called 
> applicative-order evaluation.[3]
> 
> ---
> 
> So, I guess #3 doesn't apply to Haskell, or maybe I just misunderstood the 
> meaning of the statement. I assumed that if f(p) = q (by some calculation) 
> then that calculation would be replaced by q so the next time the function 
> was called it could just return q, as occurs in memoization.
> 
> Michael
> 
> 
> 
> --- On Tue, 12/15/09, Gregory Crosswhite  wrote:
> 
> From: Gregory Crosswhite 
> Subject: Re: [Haskell-cafe] Haskell and "memoization"
> To: "Daniel Fischer" 
> Cc: haskell-cafe@haskell.org
> Date: Tuesday, December 15, 2009, 11:47 PM
> 
> Hmm, you raise an 
> On Dec 15, 2009, at 8:28 PM, Daniel Fischer wrote:
> 
> > Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> > 
> > Not even then, necessarily. And it's not always a good idea.
> > 
> > f k = [1 .. 20^k]
> > 
> 
> You raise a really good point here.  One can force sharing, as I understand 
> it, by using a let clause:
> 
> n =
> let xs = f 20
> in length (xs ++ xs)
> 
> If I understand correctly, this should cause xs to be first evaluated, and 
> then cached until the full length is computed, which in this case is 
> obviously undesirable behavior.
> 
> Cheers,
> Greg
> 
> ___
> 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] Haskell and "memoization"

2009-12-15 Thread Daniel Fischer
Am Mittwoch 16 Dezember 2009 05:47:20 schrieb Gregory Crosswhite:
> On Dec 15, 2009, at 8:28 PM, Daniel Fischer wrote:
> > Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> >
> > Not even then, necessarily. And it's not always a good idea.
> >
> > f k = [1 .. 20^k]
>
> You raise a really good point here.  One can force sharing, as I understand
> it, by using a let clause:
>
> n =
>   let xs = f 20
>   in length (xs ++ xs)
>
> If I understand correctly, this should cause xs to be first evaluated,

It is evaluated during the calculation of the length. But whereas in

n = let xs = f 20
ys = f 10
in length (xs ++ ys)

every cell of xs can be immediately garbage collected - so it will only take 
insanely long 
to get a result -, in the above example the scond argument of (++) holds on to 
xs, so they 
can't be garbage collected (I wouldn't bet any body parts on that, an 
implementation is 
allowed to recalculate a named entity on every occurrence, but it's the 
expected 
behaviour) and you will run into memory problems. The good part of it is that 
it finishes 
much faster :)

> and then cached until the full length is computed, which in this case is
> obviously undesirable behavior.
>
> Cheers,
> Greg

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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-15 Thread michael rice
Hi all,

I think this (#3 below) is where I got the idea:

http://en.wikipedia.org/wiki/Lazy_evaluation

Excerpt:

---

Lazy evaluation refers to how expressions are evaluated when they are passed as 
arguments to functions and entails the following three points:[1]

   1. The expression is only evaluated if the result is required by the calling 
function, called delayed evaluation.[2]
   2. The expression is only evaluated to the extent that is required by the 
calling function, called Short-circuit evaluation.
   3. the expression is never evaluated more than once, called 
applicative-order evaluation.[3]

---

So, I guess #3 doesn't apply to Haskell, or maybe I just misunderstood the 
meaning of the statement. I assumed that if f(p) = q (by some calculation) then 
that calculation would be replaced by q so the next time the function was 
called it could just return q, as occurs in memoization.

Michael



--- On Tue, 12/15/09, Gregory Crosswhite  wrote:

From: Gregory Crosswhite 
Subject: Re: [Haskell-cafe] Haskell and "memoization"
To: "Daniel Fischer" 
Cc: haskell-cafe@haskell.org
Date: Tuesday, December 15, 2009, 11:47 PM

Hmm, you raise an 
On Dec 15, 2009, at 8:28 PM, Daniel Fischer wrote:

> Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> 
> Not even then, necessarily. And it's not always a good idea.
> 
> f k = [1 .. 20^k]
> 

You raise a really good point here.  One can force sharing, as I understand it, 
by using a let clause:

n =
    let xs = f 20
    in length (xs ++ xs)

If I understand correctly, this should cause xs to be first evaluated, and then 
cached until the full length is computed, which in this case is obviously 
undesirable behavior.

Cheers,
Greg

___
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] Haskell and "memoization"

2009-12-15 Thread Gregory Crosswhite
Hmm, you raise an 
On Dec 15, 2009, at 8:28 PM, Daniel Fischer wrote:

> Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> 
> Not even then, necessarily. And it's not always a good idea.
> 
> f k = [1 .. 20^k]
> 

You raise a really good point here.  One can force sharing, as I understand it, 
by using a let clause:

n =
let xs = f 20
in length (xs ++ xs)

If I understand correctly, this should cause xs to be first evaluated, and then 
cached until the full length is computed, which in this case is obviously 
undesirable behavior.

Cheers,
Greg

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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-15 Thread Daniel Fischer
Am Mittwoch 16 Dezember 2009 05:08:39 schrieb Gregory Crosswhite:
> Haskell does not maintain a cache mapping function calls to their values,
> so if you have some function f and call it with, say, the argument 7 in two
> different places in your code, then it will re-evaluate the function at
> each point.  The only time it will not do this is when it can see
> explicitly that the value will be shared, i.e. situations like "g (f 7) (f
> 7)" should only result in one evaluation of f 7 in simple cases, presuming
> the compiler is sufficiently smart.

Not even then, necessarily. And it's not always a good idea.

f k = [1 .. 20^k]

g xs ys = genericLength (ys ++ xs)

Finding out when to share is really hard.

>
> Cheers,
> Greg

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


Re: [Haskell-cafe] Haskell and "memoization"

2009-12-15 Thread Gregory Crosswhite
Haskell does not maintain a cache mapping function calls to their values, so if 
you have some function f and call it with, say, the argument 7 in two different 
places in your code, then it will re-evaluate the function at each point.  The 
only time it will not do this is when it can see explicitly that the value will 
be shared, i.e. situations like "g (f 7) (f 7)" should only result in one 
evaluation of f 7 in simple cases, presuming the compiler is sufficiently smart.

Cheers,
Greg


On Dec 15, 2009, at 7:32 PM, michael rice wrote:

> I'm looking here at the Fibonacci stuff:
> 
> http://www.haskell.org/haskellwiki/Memoization
> 
> Since (I've read) Haskell never computes the value
> of a function more than once, I don't understand the
> need for memoization.
> 
> Enlighten me.
> 
> Michael
> 
> 
> ___
> 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] Haskell and "memoization"

2009-12-15 Thread Daniel Peebles
It does compute the result of a function application more than once if you
ask for it more than once, and that's why we need memoization.

Dan

On Tue, Dec 15, 2009 at 10:32 PM, michael rice  wrote:

> I'm looking here at the Fibonacci stuff:
>
> http://www.haskell.org/haskellwiki/Memoization
>
> Since (I've read) Haskell never computes the value
> of a function more than once, I don't understand the
> need for memoization.
>
> Enlighten me.
>
> Michael
>
>
>
> ___
> 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