[Haskell-beginners] Re: (Integral b, RealFrac b) to Int
Daniel Fischer
daniel.is.fischer at web.de
Tue Feb 9 07:23:50 EST 2010
Am Dienstag 09 Februar 2010 08:53:13 schrieb han:
> I made a mistake in copying the original code.
>
> The correct version is:
>
> line (sx, sy) (tx, ty)
>
> | abs (sx - tx) > abs (sy - ty) =
>
> zip xs [round (sy + (sy - ty) * x / xd) | x <- [0 .. xd]]
>
> | otherwise =
>
> zip [round (sx + (sx - tx) * y / yd) | y <- [0 .. yd]] ys
> where
> xs = target sx tx
> ys = target sy ty
> xd = abs (sx - tx)
> yd = abs (sy - ty)
The type of (/) is
Prelude> :t (/)
(/) :: (Fractional a) => a -> a -> a
and that of round
Prelude> :t round
round :: (RealFrac a, Integral b) => a -> b
So the expression
(sy + (sy - ty) * x / xd)
forces sy, ty and xd to have the same Fractional type, fr.
Since xd = abs (sx-tx), sx and tx have the same type.
Now you apply round to that expression, which can give you any Integral
type you desire. In the first branch, round (...) becomes the second
component of the result pairs, in the second branch the first component.
Probably target has type
target :: (Num/Integral/? a) => a -> a -> [a]
, which forces all types to be the same, giving the overall type
line :: (Integral b, RealFrac b) => (b, b) -> (b, b) -> [(b, b)]
Usually, no type is an instance of Integral and RealFrac at the same time,
so it's not a usable function.
You want the type
line :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
One way to find out what went wrong is to give that type signature in the
source and see what error message you get.
It will probably be
No instance for (Fractional Int)
arising from a use of `/' at (source location)
Possible fix: add an instance declaration for (Fractional Int)
In the expression: ...
So you can't divide Ints with (/). You can either use the integral division
"div": (sy + (sy - ty) * x `div` xd), or, if the round is important and you
can't use integral division - which gives floor -, convert the arguments to
(/) to a Fractional type before dividing:
(sy + round (fromIntegral ((sy - ty) * x) / fromIntegral xd))
>
> On Tue, Feb 9, 2010 at 4:40 PM, han <e at xtendo.org> wrote:
> > I have this code:
> >
> > line (sx, sy) (tx, ty)
> > | abs (sx - tx) > abs (sy - ty) =
> > zip xs [(sy + (sy - ty) * x / xd) | x <- [0 .. xd]]
> > | otherwise =
> > zip [(sx + (sx - tx) * y / yd) | y <- [0 .. yd]] ys
> > where
> > xs = target sx tx
> > ys = target sy ty
> > xd = abs (sx - tx)
> > yd = abs (sy - ty)
> >
> > It currently has the inferred type signature of
> >
> > (Integral b, RealFrac b) => (b, b) -> (b, b) -> [(b, b)]
> >
> > and I want it to be
> >
> > (Int, Int) -> (Int, Int) -> [(Int, Int)]
> >
> > which, when coerced, causes an error.
> >
> > Any idea?
More information about the Beginners
mailing list