[Haskell-cafe] New New newbie question/help
Balu Raman
braman09 at gmail.com
Wed Jun 27 22:33:31 EDT 2007
Thanks Paul.
Yes, I was missing a node in the polygon list.
I did change to equilateralTri :: Float -> Float -> Float -> IO() for
the scalings that you mentioned. Yes, i was doing the snowflake
problem.
thanks,
balu raman
On 6/27/07, Paul Hudak <paul.hudak at yale.edu> wrote:
> Hi Balu. It looks like you've gotten some excellent advice from
> others, but permit me to add a further comment regarding the broader
> context, now that I've had a chance to look a little closer.
>
> It looks like you're trying to solve the "fractal snowflake" exercise. One
> of the challenges in programming with numbers is deciding what
> representation to use. Ints are great because they are efficient, but if
> you need to use trigonometric functions such as sine, etc. then you need
> Floats or Doubles. The problem here is that you need both -- you need Ints
> because polygon is defined in terms of pixels, which are represented as
> Ints, and you need Floats because you need to compute the coordinates of an
> equilateral triangle, which (interestingly) can't be represented using
> integer coordinates. But also, in the case of the snowflake fractal, you
> will need to scale the size as you recurse. The reason that the latter is
> important is that it implies that the arguments to equilateralTri should
> perhaps be floats -- otherwise you will once again run into numeric
> conversion problems as you try to scale the arguments (unless you always
> start with a pixel size that is a multiple of six).
>
> So -- I would still suggest using Window -> Float -> Float -> Float -> IO()
> as the type for equilateralTri. It's only when you make the call to polygon
> that you need Ints. And there you can just use "round" to convert the
> Floats to Ints.
>
> As an aside, looking at your code a bit closer, I see this:
>
> (polygon [(x,y),(a,b),(x,y)]))
> where
> b = y + side * sin(pi/3)
> a = x + side * cos(pi/3)
>
> Something is not right here -- you repeat (x,y) as a vertex. Probably the
> third vertex should be (x+side,y). Also, note that sin (pi/3) and cos
> (pi/3) are constants (namely 0.866... and 0.5, resp.).
>
> I hope this helps,
>
> -Paul
>
>
> Balu Raman wrote:
> I am for ever obliged to this haskell community. Who would have thought that
> Prof.Hudak would reply instantly, from on-the-road. I am reading his SOE.
> Thanks so much.
>
> I went with peterv's response after trying so many things.
> I tried to change to : equilateralTri Window -> Float -> Float -> Float ->
> IO()
> which bombed because polygon wants list of integer-pairs.
>
> I read the definitions of fromIntegral and round and they are defined as :
>
> fromIntegral :: (Num b, Integral a) => a -> b
> round :: (RealFrac a, Integral b) => a->b
> Is it proper/ok to defines them as :
> fromIntegral :: (a::Integral) -> (b::Num)
> and
> round :: (a::RealFrac) -> (b::Integral) ?
> Is RealFrac is-a Num ?
> Does the order matters in (Num b,Integral a) => a -> b or
> (Integral a,Num b) => a -> b
>
> With your encouragements, I'll keep pluuging. Thanks.
> - br
>
>
> On 6/27/07, peterv <bf3 at telenet.be> wrote:
> I'm also a haskell newbie, but I'll try to help; the experts here will
> correct me if I'm wrong.
>
> The compiler cannot in all cases infer the type of a number. pi can be a
> Float, a Double, or even a complex number.
>
> Furthermore unlike in C/C++ you cannot just mix integer and floating
> operations.
>
> For example, the following works for me:
>
> f :: Int -> Int
> f side = round ( (fromIntegral side) * sin ( (pi::Float) / 3 ) )
>
> or easier
>
> f side = round ( (fromIntegral side) * sin (pi / 3.0) )
>
> I'm sure the experts here will have a better solution.
>
> Peter
> -----Original Message-----
> From: haskell-cafe-bounces at haskell.org
> [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Balu Raman
> Sent: Wednesday, June 27, 2007 1:25 PM
> To: Haskell-Cafe at haskell.org
> Subject: [Haskell-cafe] New New newbie question/help
>
> Hi,
> Hope someone can help me, just starting out with SOE.My code :
> module Main where
> import Graphics.SOE.Gtk
>
> spaceClose :: WIndow -> IO()
> spaceClose w = do k <- getKey w
> if k == ' ' then closeWindow w
> else spaceClose w
>
> equilateralTri :: Window -> Int -> Int -> Int -> IO()
> equilateralTri w x y side
> = drawInWindow w (withColor Red
> (polygon
> [(x,y),(a,b),(x,y)]))
> where
> b = y + side * sin(pi/3)
> a = x + side * cos(pi/3)
> main =
> runGraphics(
> do w <- openWindow "Equilateral
> Triangle" (400,400)
> equilateralTri w 50 300 200
> spaceClose w
> )
>
> all of the above in file triangle.hs
> when I do a :l triangle.h in ghci, I get the following error
> triangle.hs:17:36:
> No instance for (Floating Int)
> arising from use of 'pi' at triangle.hs:17:36-37
> Probable fix: add an instance declaration for (Floating Int)
> In the first argument of '(/)', namely 'pi'
> In the first argument of 'cos', namely '(pi / 3)'
> In the second argument of '(*)', namely 'cos (pi/3)'
> Failed, modules loaded: none
>
> Can someone help me what's going on to a brand new newbie. All I can
> figure out is that some type mismatch between float and int . I tried
> various
> combinations of lets and wheres and I still get the same complaints.
> I am just linearly studying SOE
> Thanks,
> - br
>
>
>
More information about the Haskell-Cafe
mailing list