Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-31 Thread Sterling Clover


On Oct 30, 2008, at 5:21 PM, Bertram Felgenhauer wrote:


George Pollard wrote:
There's also the ieee-utils package, which provides an IEEE monad  
with

`setRound`:

http://hackage.haskell.org/packages/archive/ieee-utils/0.4.0/doc/ 
html/Numeric-IEEE-RoundMode.html





When run with +RTS -N2 -RTS, the output randomly alternates
between Downward and ToNearest - for me at least.

The problem is that the setRound call will only affect one worker
thread, while the RTS will sometimes migrate RTS threads from one
worker to another.

runIEEE really has to be executed in a bound thread (see forkOS
documentation). Using `par` will also cause trouble - in fact even
more.



That's a really nice catch!

Dons has pointed out to me both the very handy forkOnIO which ensures  
the forked thread remains bound to a single CPU, and also the -qm  
flag to the RTS, which prevents thread migration between  
capabilities. Running the example program with +RTS -N2 -qm restores  
the behavior to what's intended. I'll try to get around to changing  
the documentation to reflect this. Also, it's worth noting that the  
IEEE round mode has no effect on rounding done with the `round`  
function, as that's explicitly coded to provide the behavior seen in  
the report.


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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-30 Thread Bertram Felgenhauer
George Pollard wrote:
> There's also the ieee-utils package, which provides an IEEE monad with
> `setRound`:
> 
> http://hackage.haskell.org/packages/archive/ieee-utils/0.4.0/doc/html/Numeric-IEEE-RoundMode.html

Hmm, this does not work well with the threaded RTS:

> import Numeric.IEEE.Monad
> import Numeric.IEEE.RoundMode (RoundMode (..))
> import Control.Monad
> import Control.Concurrent
> 
> main = withIeeeDo $ do
> replicateM_ 2 $ forkIO $ forever $ putChar '.'
> forkIO $ do
> runIEEE $ do
> withRoundMode Downward $
> forever $ do
> IEEE . putStr . (++ "\n") . show =<< getRound
> threadDelay 100

When run with +RTS -N2 -RTS, the output randomly alternates
between Downward and ToNearest - for me at least.

The problem is that the setRound call will only affect one worker
thread, while the RTS will sometimes migrate RTS threads from one
worker to another.

runIEEE really has to be executed in a bound thread (see forkOS
documentation). Using `par` will also cause trouble - in fact even
more.

I think that conceptually, the cleanest approach is to provide separate
data types for Double and Float in each of the rounding modes. This is
quite expensive: basically, it means setting the rounding mode on each
operation, and we would miss out on the code generator support for
floating point math. (A primop for setting the rounding mode could help
here, to some extent.)

Maybe tracking the rounding mode per RTS thread would be a useful
compromise between performance and usability for computations with
mostly uniform rounding mode - this is what the Numeric.IEEE.Monad
module seems to be aiming at. `par` would still be unusable with that
approach though.

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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread George Pollard
There's also the ieee-utils package, which provides an IEEE monad with
`setRound`:

http://hackage.haskell.org/packages/archive/ieee-utils/0.4.0/doc/html/Numeric-IEEE-RoundMode.html


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread Richard O'Keefe

Let me offer another suggestion which I think can be
fitted into Haskell quite well.  For the applications
of rounding choice that I'm aware of, you want to
choose when you write the code, not when you run it.

This was actually reflected in the design of a real
machine: the DEC Alpha.  Floating point instructions
had variants for "whatever the PSW says" and for
"this particular mode".  It would have been nice (had
DEC survived, if the Alpha were still alive) to be
able to generate the first-direction instructions, as
that's rather more efficient than switching rounding
modes twice.

Now the Haskell Way is to do things with types.
So,

newtype RoundedUp   t = RoundedUp t
newtype RoundedDown t = RoundedDown t
newtype Truncated   t = Truncated t

instance Floating t => Num (RoundedUp t)
  where ...
instance Floating t => Num (RoundedDown t)
  where ...
instance Floating t => Num (Truncated t)
  where ...
...

Then one could write

let i = round (Truncated x + Truncated y)

This is just a quick sketch.  I'm sure it has problems.
It does, however, deal with a fairly major problem in
attempting to use hardware rounding modes in Haskell,
and that is laziness.  Putting the rounding mode in the
type means that the information is right there at each
operator without having to use monadic floating point.

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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread Lennart Augustsson
I agree that the name is not the most descriptive one, and perhaps we
should have the more descriptive ones.
But when I hear "round", I assume it's the kind of rounding Haskell
does.  And I assumed this before Haskell came about.

On Tue, Oct 28, 2008 at 6:07 PM, Bart Massey <[EMAIL PROTECTED]> wrote:
> Lennart Augustsson  augustsson.net> writes:
>> On Mon, Oct 27 2008, Bart Massey  cs.pdx.edu> wrote:
>> > I think given that the Haskell 98 Report is pretty
>> > explicit about the behavior of round, we're stuck with
>> > it, but I don't like it.  It's yet another tiny
>> > impediment to Haskell newbies, as demonstrated by the
>> > original post.
>>
>> You're assuming newbies from a bad educational system that
>> hasn't taught them how to round properly. :)
>
> Naw. :-)
>
> I'm just saying that the name "round" is unfortunate, since
> there's no single universally accepted mathematical
> definition for it. For this reason many programming
> languages either don't provide it or provide a different
> version.  The names "roundHalfUp" and "roundHalfEven" are
> much better: they each correspond to a well-known
> mathematical function that is codified in an IEEE standards
> document.
>
> If it were up to me, I'd deprecate round in Haskell' and
> make the documentation point to these other rounding
> functions.
>
> Our solution in Nickle (http://nickle.org), BTW, was to
> provide floating point with user-settable mantissa precision
> and a default precision of 256 bits.  For all practical
> purposes we know of, this makes worrying about the edge
> cases for rounding pointless.  Kahan has a nice paper on
> this that I can't find right now.
>
> Of course, this solution also makes FP computation
> creepingly slow, and exposes users to occasional bugs in our
> FP math library... :-)
>
>   Bart Massey
>   bart  cs.pdx.edu
>
>
> ___
> 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] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread wren ng thornton

Bart Massey wrote:

Peter Gavin  gmail.com> writes:

The reason for doing it this way is that e.g. 2.5 is
exactly between 2 and 3, and rounding *up* every time
would cause an uneven bias toward 3.  To counteract that
effect, rounding to the nearest even integer is used,
which causes the half of the x.5 values to round up, and
the other half to round down.


Everyone keeps providing this rationale, but of course if
you want "half the values to round up and the other half
down" it does just as well to round positive values up and
negative values down.


The rational is to have half of the expected distribution of 'related' 
invocations round up/down, regardless of the (adversarial) distribution 
of input value instances. The round to zero method provides this only 
when the distribution of instances are symmetric about zero. Barring 
random number generators, these are extremely uncommon distributions in 
practice. The round to even method provides this guarantee so long as 
the adversary can't choose between Even+0.5 vs Odd+0.5 values whenever 
it wants. In terms of non-adversarial distributions, this covers almost 
all of them, and in particular it is not biased to a particular mean for 
the distribution.


Granted, not everyone is trying to get as close to the correct answer as 
possible. Sometimes it's more important to guarantee one-sided error 
than it is to minimize the error margins. But, IME, the most-correct 
answer is the general goal and when people have another goal in mind 
they're quite aware of it.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread David Roundy
On Tue, Oct 28, 2008 at 04:07:12PM +, Bart Massey wrote:
> I'm just saying that the name "round" is unfortunate, since
> there's no single universally accepted mathematical
> definition for it. For this reason many programming
> languages either don't provide it or provide a different
> version.  The names "roundHalfUp" and "roundHalfEven" are
> much better: they each correspond to a well-known
> mathematical function that is codified in an IEEE standards
> document.
> 
> If it were up to me, I'd deprecate round in Haskell' and
> make the documentation point to these other rounding
> functions.
> 
> Our solution in Nickle (http://nickle.org), BTW, was to
> provide floating point with user-settable mantissa precision
> and a default precision of 256 bits.  For all practical
> purposes we know of, this makes worrying about the edge
> cases for rounding pointless.  Kahan has a nice paper on
> this that I can't find right now.

Isn't it quite common to have numbers like 0.5 as input? (as an
example of a number that's exactly representable in any binary
floating point format, but whose rounded value depends on rounding
convention.

I don't feel strongly on the question, but was somewhat surprised to
find that round is present, for the reasons you mention.  floor (x+0.5)
is not a bad way to round... no one will mistakenly thing that it'll
do something smart with half-integers.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread Bart Massey
Lennart Augustsson  augustsson.net> writes:
> On Mon, Oct 27 2008, Bart Massey  cs.pdx.edu> wrote:
> > I think given that the Haskell 98 Report is pretty
> > explicit about the behavior of round, we're stuck with
> > it, but I don't like it.  It's yet another tiny
> > impediment to Haskell newbies, as demonstrated by the
> > original post.
> 
> You're assuming newbies from a bad educational system that
> hasn't taught them how to round properly. :)

Naw. :-)

I'm just saying that the name "round" is unfortunate, since
there's no single universally accepted mathematical
definition for it. For this reason many programming
languages either don't provide it or provide a different
version.  The names "roundHalfUp" and "roundHalfEven" are
much better: they each correspond to a well-known
mathematical function that is codified in an IEEE standards
document.

If it were up to me, I'd deprecate round in Haskell' and
make the documentation point to these other rounding
functions.

Our solution in Nickle (http://nickle.org), BTW, was to
provide floating point with user-settable mantissa precision
and a default precision of 256 bits.  For all practical
purposes we know of, this makes worrying about the edge
cases for rounding pointless.  Kahan has a nice paper on
this that I can't find right now.

Of course, this solution also makes FP computation
creepingly slow, and exposes users to occasional bugs in our
FP math library... :-)

   Bart Massey
   bart  cs.pdx.edu


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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread Felipe Lessa
On Mon, Oct 27, 2008 at 6:15 PM, Bart Massey <[EMAIL PROTECTED]> wrote:
> BTW, in case anyone is unclear, IEEE 854 supports a large
> variety of required and optional rounding modes; it takes no
> strong position on a "correct" rounding strategy. In
> particular, round-up ("round-half-up") and round-to-even
> ("round-half-even") are both required. However, there is an
> IEEE 854 subset, ANSI X3.274, that does make rounding modes
> other than round-up optional, presumably in conformance with
> common PL practice. This might make an implementation of the
> Report's round function on some FPU I've never heard of
> slightly more expensive.

I would like to see something on the lines of



data RoundMode = RoundUp | RoundDown | RoundToZero | RoundHalfEven

class (Real a, Fractional a) => RealFrac a where
  ...
  round :: (Integral b) => a -> b
  roundBy :: (Integral b) => RoundMode -> a -> b
  roundModes :: a -> [RoundMode] -- non-strict on argument
  ...


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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-28 Thread Lennart Augustsson
You're assuming newbies from a bad educational system that hasn't
taught them how to round properly. :)

  -- Lennart

On Mon, Oct 27, 2008 at 10:15 PM, Bart Massey <[EMAIL PROTECTED]> wrote:
> I think given that the Haskell 98 Report is pretty explicit
> about the behavior of round, we're stuck with it, but I
> don't like it.  It's yet another tiny impediment to Haskell
> newbies, as demonstrated by the original post.  (I'm not at
> all opposed to having a round-to-even function; it should
> just be called roundHalfEven to make it clear what it
> does. If it were up to me, I would probably elide the name
> "round" altogether in favor of roundHalfEven.)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
Daniel Fischer <[EMAIL PROTECTED]> wrote:

> Am Montag, 27. Oktober 2008 13:34 schrieb Achim Schneider:
> > >
> > > Who does such horrible things?
> > > Repeat after me: 1 is NOT a prime. Never, under no circumstances.
> >
> > Then chase it out of your prime factor products. You'd be the first
> > one to break a monoid and locate unsafeCalculate#.
> 
> Huh? I don't understand what you are trying to say here. 
> In which way do you use the term "prime factor product"?
> If you're referring the value of the product, 1 is a perfectly
> legitimate value, that of the empty product.
> If you're referring the expression \prod_{i \in I}p_i, that doesn't
> contain 1. So out of where shall "it" (I think that refers to 1, does
> it?) be chased? And what has that to do with breaking monoids?
>
I am referring to 

n = product [primeFactors n]

and the fact that

product = foldr (*) 1

or even, less haskellish,

product xs = product 1:xs

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Aaron Denney
On 2008-10-27, Bart Massey <[EMAIL PROTECTED]> wrote:
> Peter Gavin  gmail.com> writes:
>> The reason for doing it this way is that e.g. 2.5 is
>> exactly between 2 and 3, and rounding *up* every time
>> would cause an uneven bias toward 3.  To counteract that
>> effect, rounding to the nearest even integer is used,
>> which causes the half of the x.5 values to round up, and
>> the other half to round down.
>
> Everyone keeps providing this rationale, but of course if
> you want "half the values to round up and the other half
> down" it does just as well to round positive values up and
> negative values down.

Except, of course, that it is quite common to work with just positive
numbers.  Working just with numbers near (even + 0.5) or (odd + 0.5)
is extremely rare.

> I have written floating point code that depends on
> consistent rounding in the past.  Being able to depend on
>   round (1 + x) = 1 + round x
> is sometimes useful, but not possible for round-to-even.

Also not for round-up -- consider floating point values where the
precision changes and it rounds differently than you, or the point where
adjacent floating point values are now 2 apart.  You basically can't
depend on any nice behaviour once floating point enters the room.

-- 
Aaron Denney
-><-

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Bart Massey
Peter Gavin  gmail.com> writes:
> The reason for doing it this way is that e.g. 2.5 is
> exactly between 2 and 3, and rounding *up* every time
> would cause an uneven bias toward 3.  To counteract that
> effect, rounding to the nearest even integer is used,
> which causes the half of the x.5 values to round up, and
> the other half to round down.

Everyone keeps providing this rationale, but of course if
you want "half the values to round up and the other half
down" it does just as well to round positive values up and
negative values down.

I think given that the Haskell 98 Report is pretty explicit
about the behavior of round, we're stuck with it, but I
don't like it.  It's yet another tiny impediment to Haskell
newbies, as demonstrated by the original post.  (I'm not at
all opposed to having a round-to-even function; it should
just be called roundHalfEven to make it clear what it
does. If it were up to me, I would probably elide the name
"round" altogether in favor of roundHalfEven.)

I have written floating point code that depends on
consistent rounding in the past.  Being able to depend on
  round (1 + x) = 1 + round x
is sometimes useful, but not possible for round-to-even.
Also note that for a common case, rounding numbers in the
range -x..x, there's still a strange slight bias toward the
center, since round-to-even rounds both 0.5 and -0.5 to 0.

BTW, in case anyone is unclear, IEEE 854 supports a large
variety of required and optional rounding modes; it takes no
strong position on a "correct" rounding strategy. In
particular, round-up ("round-half-up") and round-to-even
("round-half-even") are both required. However, there is an
IEEE 854 subset, ANSI X3.274, that does make rounding modes
other than round-up optional, presumably in conformance with 
common PL practice. This might make an implementation of the
Report's round function on some FPU I've never heard of
slightly more expensive.

Bart Massey
bart  cs.pdx.edu


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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread ajb

G'day all.

Quoting Daniel Fischer <[EMAIL PROTECTED]>:


Who does such horrible things?
Repeat after me: 1 is NOT a prime. Never, under no circumstances.


The definition of "prime" is well-understood standard terminology, but
that doesn't escape the fact that it's arbitrary and human-defined.

I'll bet you insist on the non-triviality axiom for fields, too.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Stefan Monnier
>>> 2.4x -> x
>> That's supposed to be 2.4x -> 2, of course.
> Ah, damn it.  I was hoping for a long discussion on just what math
> would look like with rounding like that ;-)

I think it has a name...  "modulo" maybe?


Stefan

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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Lennart Augustsson
But you shouldn't use the "common round function", you should use the
Haskell round function.
That's the one that is mathematically better and has hardware support.

On Mon, Oct 27, 2008 at 2:05 PM, L.Guo <[EMAIL PROTECTED]> wrote:
> Thank you all for instructions.
>
> I am not the same education route with you, so i just heard round-to-even for 
> the very first time.
>
> Now I understand why it exists in theory.
>
> And then, in haskell, is that means, I have to use 'floor . (.5+)' instead of 
> 'round' to get the common round function ?
>
> Or else, is there any other alter-round-function in haskell to do this ?
>
> --
> L.Guo
> 2008-10-27
>
>
> ___
> 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] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Daniel Fischer
Am Montag, 27. Oktober 2008 13:34 schrieb Achim Schneider:
> >
> > Who does such horrible things?
> > Repeat after me: 1 is NOT a prime. Never, under no circumstances.
>
> Then chase it out of your prime factor products. You'd be the first one
> to break a monoid and locate unsafeCalculate#.

Huh? I don't understand what you are trying to say here. 
In which way do you use the term "prime factor product"?
If you're referring the value of the product, 1 is a perfectly legitimate 
value, that of the empty product.
If you're referring the expression \prod_{i \in I}p_i, that doesn't contain 1.
So out of where shall "it" (I think that refers to 1, does it?) be chased?
And what has that to do with breaking monoids?

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
"Felipe Lessa" <[EMAIL PROTECTED]> wrote:

> On Mon, Oct 27, 2008 at 10:20 AM, Achim Schneider <[EMAIL PROTECTED]>
> wrote:
> > Hmmm... I'm wondering whether there's a standard C way to set the
> > rounding direction.
> 
> nearbyint() and rint() may be used, and the rounding mode can be set
> by fesetround(). IIRC, this is C99.
> 
Yes, they are, thanks.

Because of stuff like this, I sometimes wish Haskell supported not only
morphisms of the type

Hask a -> Hask b

but

(Hask h, RoundDownwards h) => h a -> h b

{-# LANGUAGE CategoryClasses #-} ?

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
Daniel Fischer <[EMAIL PROTECTED]> wrote:

> Am Montag, 27. Oktober 2008 12:35 schrieb Achim Schneider:
> > Daniel Fischer <[EMAIL PROTECTED]> wrote:
> > > Am Montag, 27. Oktober 2008 11:46 schrieb Henning Thielemann:
> > > > I also know a didact which tells teachers that 1 has no prime
> > > > decomposition. Oh, I see, she may have copied that from
> > > > Wikipedia: http://en.wikipedia.org/wiki/Prime_factorisation
> > >
> > > I can believe that makes sense to somebody who considers 0 an
> > > unnatural number, an empty product must be frightening for them.
> >
> > That is just mathematical trickery and dodgery, silently defining 1
> > as prime by including it (even infinitely many times!) in any prime
> > factor,
> 
> Who does such horrible things?
> Repeat after me: 1 is NOT a prime. Never, under no circumstances.
> 
Then chase it out of your prime factor products. You'd be the first one
to break a monoid and locate unsafeCalculate#.

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Felipe Lessa
On Mon, Oct 27, 2008 at 10:20 AM, Achim Schneider <[EMAIL PROTECTED]> wrote:
> Hmmm... I'm wondering whether there's a standard C way to set the
> rounding direction.

nearbyint() and rint() may be used, and the rounding mode can be set
by fesetround(). IIRC, this is C99.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
Henning Thielemann <[EMAIL PROTECTED]> wrote:

> 
> On Mon, 27 Oct 2008, L.Guo wrote:
> 
> > And then, in haskell, is that means, I have to use 'floor . (.5+)' 
> > instead of 'round' to get the common round function ?
> 
> That's certainly the best to do.
>
Hmmm... I'm wondering whether there's a standard C way to set the
rounding direction.

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Henning Thielemann


On Mon, 27 Oct 2008, L.Guo wrote:

And then, in haskell, is that means, I have to use 'floor . (.5+)' 
instead of 'round' to get the common round function ?


That's certainly the best to do.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread L.Guo
Thank you all for instructions.

I am not the same education route with you, so i just heard round-to-even for 
the very first time.

Now I understand why it exists in theory.

And then, in haskell, is that means, I have to use 'floor . (.5+)' instead of 
'round' to get the common round function ?

Or else, is there any other alter-round-function in haskell to do this ?

--   
L.Guo
2008-10-27


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


Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Daniel Fischer
Am Montag, 27. Oktober 2008 12:35 schrieb Achim Schneider:
> Daniel Fischer <[EMAIL PROTECTED]> wrote:
> > Am Montag, 27. Oktober 2008 11:46 schrieb Henning Thielemann:
> > > I also know a didact which tells teachers that 1 has no prime
> > > decomposition. Oh, I see, she may have copied that from Wikipedia:
> > > http://en.wikipedia.org/wiki/Prime_factorisation
> >
> > I can believe that makes sense to somebody who considers 0 an
> > unnatural number, an empty product must be frightening for them.
>
> That is just mathematical trickery and dodgery, silently defining 1 as
> prime by including it (even infinitely many times!) in any prime
> factor,

Who does such horrible things?
Repeat after me: 1 is NOT a prime. Never, under no circumstances.

> denying its existence there (by defining all units to be
> non-prime) and then calling the whole algebra paradox-free, hoping that
> noone notices.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
Daniel Fischer <[EMAIL PROTECTED]> wrote:

> Am Montag, 27. Oktober 2008 11:46 schrieb Henning Thielemann:
>
> > I also know a didact which tells teachers that 1 has no prime
> > decomposition. Oh, I see, she may have copied that from Wikipedia:
> > http://en.wikipedia.org/wiki/Prime_factorisation
> 
> I can believe that makes sense to somebody who considers 0 an
> unnatural number, an empty product must be frightening for them.
>
That is just mathematical trickery and dodgery, silently defining 1 as
prime by including it (even infinitely many times!) in any prime
factor, denying its existence there (by defining all units to be
non-prime) and then calling the whole algebra paradox-free, hoping that
noone notices.

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread Achim Schneider
"L.Guo" <[EMAIL PROTECTED]> wrote:

> "round x returns the nearest integer to x, the even integer if x is
> equidistant between two integers."
> 
> 
> Is there any explanation about that ?
> 
Yes. math.h, rint() and IEEE.

The Right Way(tm) to round is rounding every other n.5 into a different
direction:

round 1.5 = 2
round 2.5 = 2
round 3.5 = 4
round 4.5 = 4

and so on. It's statistically correct, that is, but also more
computationally expensive.

In practise, such things rarely matter, so you just don't need to care.
If you have to care, pray that you know it. You're also bound to slam
your nose into much, much messier issues then, too, wishing you'd
learnt higher numerics in school, kind of like learning Haskell and
wishing the first grade math curriculum was based on categories instead
of sets.

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.

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