
Hello all! I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene. To use input for controling camera position I need variables. An equivalent code in C: void main_loop() { int loop_num = 0; bool run = 1; SDLEvent e; while(run) { while(SDL_PollEvent(&e)) { if(e.type == SDL_KeyDown) { if(... == SDLK_Left) camera_pos_x--; } else if ... ... } drawScene(); loop_num++; } } How to implement camera_pos_x, y and z as variables, which chage values in run? This is only simplified example, but it's important to implement it in as most imperative form as possible. Thank fo all answers. Matej 'Yin' Gagyi

yin wrote:
Hello all!
I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene. To use input for controling camera position I need variables. An equivalent code in C:
void main_loop() { int loop_num = 0; bool run = 1; SDLEvent e;
while(run) { while(SDL_PollEvent(&e)) { if(e.type == SDL_KeyDown) { if(... == SDLK_Left) camera_pos_x--; } else if ... ... }
drawScene();
loop_num++; } }
How to implement camera_pos_x, y and z as variables, which chage values in run? This is only simplified example, but it's important to implement it in as most imperative form as possible.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html Consider, however, that this kind of construct can be done without mutable variables. (warning, made-up code ahead) main = loop 0 0 0 -- initial values where loop loop_num xpos ypos = do e <- pollEvent let xpos' = <calculate new xpos> ypos' = <calculate new ypos> someActionInvolvingPosition xpos' ypos' when breakCondition (return ()) loop (loop_num+1) xpos' ypos'

robert dockins wrote:
yin wrote:
Hello all!
I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html
Consider, however, that this kind of construct can be done without mutable variables. (warning, made-up code ahead)
main = loop 0 0 0 -- initial values where loop loop_num xpos ypos = do e <- pollEvent let xpos' = <calculate new xpos> ypos' = <calculate new ypos> someActionInvolvingPosition xpos' ypos' when breakCondition (return ()) loop (loop_num+1) xpos' ypos'
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more) I tried something like this: main = withInit [InitVideo] $ do progname <- getProgName createAWindow progname mainLoop 0 mainLoop :: Int -> IO () mainLoop ll = do event <- pollEvent quit <- case event of VideoResize w h -> resizeGLScene w h >> return False KeyDown (Keysym SDLK_q _ _) -> return True Quit -> return True _ -> drawGLScreen ((fromIntegral ll) / 10) >> return False when (not quit) (mainLoop (ll + 1)) drawGLScreen :: Double -> IO () drawGLScreen = do clear [ColorBuffer,DepthBuffer] loadIdentity translate $ (\(x,y,z) -> Vector3 x y z) getCameraPos rotate blah, blah, ... renderPrimitive Polygon $ mapM_ (\(x,y,z) -> vertex$Vertex3 x y z) polygonPoints glSwapBuffers getCameraPos :: (GLfloat, GLfloat, GLfloat) getCameraPos = readIORef refCameraPos setCameraPos :: (GLfloat, GLfloat, GLfloat) -> IO () setCameraPos (a, b, c) = writeIORef refCameraPos (a, b, c) And there si the problem - how to initialize refCameraPos with newIORef, and then using it. If I write "refCameraPos = newIORef (0, 0, 0)" it will initialize new IORef every time. I need Just persistent, mutualy variable. I was covered on this list , but I've deleted the messages. Matej 'Yin' Gagyi

I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html
Consider, however, that this kind of construct can be done without mutable variables. (warning, made-up code ahead)
main = loop 0 0 0 -- initial values where loop loop_num xpos ypos = do e <- pollEvent let xpos' = <calculate new xpos> ypos' = <calculate new ypos> someActionInvolvingPosition xpos' ypos' when breakCondition (return ()) loop (loop_num+1) xpos' ypos'
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more)
Then you probably want a big labeled record, data ProgramState = ProgramState { var1 :: IORef Int , var2 :: IORef Int , var3 :: IORef Int , objects :: IORef [Object] , etc ....} with a big nasty init function that calls newIORef a bunch of times with the initial values. Then you just pass around your ProgramState value. initProgramState :: IO ProgramState initProgramState = do ref1 <- newIORef 0 ref2 <- newIORef 12345 ref3 <- newIORef 1111 ..... return ProgramState { var1 = ref1, var2 = ref2, var3 = ref3, ... } main = ps <- initProgramState mainLoop ps This has the nice property that you can add new fields to your record without having to change the signature of dozens of functions. Of course, you can alternately just create a big labeled record of pure values, and stick the whole thing in an IORef, or use recursive argument passing trick and skip the IORefs altogether. I'm not sure I'm competent to give a breakdown of the advantages and disadvantages of each method, although I am personally inclined toward avoiding IORefs. Some people may suggest that you to create top-level IORefs using unsafePerformIO, but I don't recommend that for this situation.

robert dockins wrote:
I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more)
Then you probably want a big labeled record,
Uhm... and what if I write some runtines in plain C, then bind them to Haskell and and use then as in OOP: camera.c: struct camera { GLfloat x, y, z; } struct camera getCameraPos() {... /* returns camera position */} void setCameraPos(struct camera c) {... /* sets position of camera */} camera.hs: -- just define bindings Main.hs: mainLoop = do -- read events -- on KeyDown (SDLK_Keft) -> do -- (x, y, z) <- getCameraPos -- setCameraPos (x + 1, y, z) -- ... -- drawGLScreen drawGLScreen = do -- glTranslate to getCameraPos... Is this apoarch safe enougth, what do you think? Matej 'Yin' Gagyi

I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more)
Then you probably want a big labeled record,
Uhm... and what if I write some runtines in plain C, then bind them to Haskell and and use then as in OOP: [snip]
Is this apoarch safe enougth, what do you think?
If you do it carefully. But why? It sounds like you are planning to write a transliteration of the code you would write in C, without leveraging the advantages of Haskell. Which brings us to the critical question; what properties of Haskell cause you to want to develop your program using it? The answer to that question should direct your design choices.

robert dockins wrote:
I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
Then you want IORef. http://www.haskell.org/ghc/docs/latest/html/libraries/base/Data.IORef.html
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more)
Then you probably want a big labeled record,
Uhm... and what if I write some runtines in plain C, then bind them to Haskell and and use then as in OOP:
[snip]
Is this apoarch safe enougth, what do you think?
If you do it carefully. But why? It sounds like you are planning to write a transliteration of the code you would write in C, without leveraging the advantages of Haskell. Which brings us to the critical question; what properties of Haskell cause you to want to develop your program using it? The answer to that question should direct your design choices.
A 3D engine aproach is a bit problematic (I can't describe it correctly in English... I'm a slovak...). Behind polygons, textures, HUD GUI and efects are mathematic functions, methods to solve problems, physics, data representations, heuristic algoritms, "unkown time living meta data", skripting language and sometimes expert systems, like simplified neuron networks. Behind these is memory handling, loops, heavy algorithm optimaliations and bugs. I need to write functions fast and efective. Math, heuristic, metadata and expert systems are better in haskell. If I could use haskel from C, I would do it. The problem are optimalizations, which are a critical change in algorithm. Other (and me too) won't understand my concepts. The speed and usability of Haskell is a good argument to use and learn it. I made a 3D engine in C++, but it was a broken aproach. I rewrote ti in C and it had many memory leaks and too many optimalizations. I shoudn't implement MainLoop and rendering state in Haskell. Haskell has the same leaks like imperative languages, but in other "programing universe". If we combine these universes together, we become an perfect world... with some new, but hidden problems. I try to combine my old "Imperium" and Haskells new "Functioning". I'm sure I get an "Functioning Imperium". Did you understand my metaphors?... I can't describe all my problem in english, I sad, my english is poor. Matej 'Yin' Gagyi

Uhm... and what if I write some runtines in plain C, then bind them to Haskell and and use then as in OOP:
[snip]
Is this apoarch safe enougth, what do you think?
If you do it carefully. But why? It sounds like you are planning to write a transliteration of the code you would write in C, without leveraging the advantages of Haskell. Which brings us to the critical question; what properties of Haskell cause you to want to develop your program using it? The answer to that question should direct your design choices.
A 3D engine aproach is a bit problematic (I can't describe it correctly in English... I'm a slovak...). Behind polygons, textures, HUD GUI and efects are mathematic functions, methods to solve problems, physics, data representations, heuristic algoritms, "unkown time living meta data", skripting language and sometimes expert systems, like simplified neuron networks. Behind these is memory handling, loops, heavy algorithm optimaliations and bugs.
I need to write functions fast and efective. Math, heuristic, metadata and expert systems are better in haskell. If I could use haskel from C, I would do it. The problem are optimalizations, which are a critical change in algorithm. Other (and me too) won't understand my concepts. The speed and usability of Haskell is a good argument to use and learn it.
I can buy that. Well, one can actually call into Haskell from C. It is less commonly done, but very possible. Skim through the FFI addendum; you can export static functions (foreign export) or arbitrary thunks (with the confusingly named foreign import "wrapper"). If you are real adventurous, you can tie directly into the GHC API from the C side as well (although I'm not sure I can seriously recommend this method). Having said that, if you feel that Haskell has sufficient advantages to warrant its use, I don't think you lose much by writing your main loops etc. in Haskell as well, and I would recommend you go with the labeled record technique to contain your program state.

On Monday 18 Jul 2005 8:06 pm, robert dockins wrote:
Some people may suggest that you to create top-level IORefs using unsafePerformIO, but I don't recommend that for this situation.
Well I can't imagine which particular people you have in mind :-) But, as a vocal advocate of sound support for top level mutable state, I would just like to go on record as saying I certainly would not advocate it for this problem. But then again, I wouldn't advocate the use of explicit "entire program state" record passing either :-) Regards -- Adrian Hey

Some people may suggest that you to create top-level IORefs using unsafePerformIO, but I don't recommend that for this situation.
Well I can't imagine which particular people you have in mind :-)
But, as a vocal advocate of sound support for top level mutable state, I would just like to go on record as saying I certainly would not advocate it for this problem.
But then again, I wouldn't advocate the use of explicit "entire program state" record passing either :-)
Fair enough. The main reason I suggested it is a fairly painless way to emulate global variables within a main control loop, which was the OPs stated goal. ("it's important to implement it in as most imperative form as possible...") I would personally attempt to adopt a more functional way of approaching the problem (Arrows and whatnot), but those are still pretty murky waters.

On Tue, 19 Jul 2005, robert dockins wrote: [ ... re explicit "entire program state" record passing ... ]
Fair enough. The main reason I suggested it is a fairly painless way to emulate global variables within a main control loop, which was the OPs stated goal. ("it's important to implement it in as most imperative form as possible...")
I would personally attempt to adopt a more functional way of approaching the problem (Arrows and whatnot), but those are still pretty murky waters.
Bummer. It's as simple and obvious as it could be in O'Haskell, which as I understand it basically packages up your record of IORefs, in its reactive object. The I/O event driven execution model seems meant for problems like this, too. I hope if the links people ever spawn a new FP language and it's anything like Haskell, they'll take an approach somewhat like this and leave the Haskell world fumbling around with its Arrows and whatnot. But, to try to answer the recent question about O'Haskell, I wouldn't expect it to serve very well as a bridge to OO languages. There are some OO elements, but for example if you read to the bottom of http://www.cs.chalmers.se/~nordland/ohaskell/survey.html, there are also some significant omissions. For example, he doesn't use this phrase, but I think there's no "open recursion". I can't imagine using this language's OO features in a C++ toolkit wrapper. But I never tried it, and it might be an interesting demonstration project. Donn Cave, donn@drizzle.com

I'm doing a 3D simulation. Now I need something like variables in imperative languages. My mainLoop check for new events and renders scene.
I saw it. The problem is, I need an amount of 100*X of mutable variables to implement the system (camera position, rotation, aceleration, ..., position and deformetion infomations for every object, ..., renderer situations [like temprary fading and other efects], ... and more)
| Then you probably want a big labeled record, depending on your needs, you might even want to go a step further, and design a scene description format for your 3d simulation. instead of updating and interpreting global variables, or passing a large record around, you would pass around a higher-level description of the state of your simulated environment. your mainLoop would compute both the current scene to be rendered and the follow-on state to be passed to the next round. much easier to read, as all the low-level updates are confined to the mainLoop, and both the scene description and its interpretation/rendering are composed from smaller parts. the scene description language would be the interface between implementing your 3d simulator and describing what is to be simulated. perhaps the following might give you an idea of the possibilities: http://www.conal.net/papers/ (Fran, Vertigo, Pan) http://www.conal.net/papers/tse-modeled-animation/ http://users.info.unicaen.fr/~karczma/arpap/ (Clastic) http://www.cs.kent.ac.uk/~cr3/FunWorlds/ cheers, claus

Hello yin, Tuesday, July 19, 2005, 12:39:24 AM, you wrote: y> I saw it. The problem is, I need an amount of 100*X of mutable variables y> to implement the system (camera position, rotation, aceleration, ..., y> position and deformetion infomations for every object, ..., renderer y> situations [like temprary fading and other efects], ... and more) you can use global variables, records, impicit parameters. careful deisigning in terms which procedure needs which variables and which variables must be joined in records because them used together will help you. some data can belong just to modules where used, some data are better to convert into functions (for example, i convert regular expressions into functions checking match with that regular expressions) i recommend you to see examples of imperative programs written in Haskell, including my own (freearc.narod.ru), Yi editor (ftp://ftp.cse.unsw.edu.au/pub/users/dons/yi/yi-0.1.0.tar.gz), web server written by authors of GHC, PostMaster mail server (http://postmaster.cryp.to/postmaster-2005-02-14.tar.gz) my own program are extensively commented in Russian, plus contains examples of calling C routines which then calls back to Haskell using given code thunks (see Compress.hs) writing imperative program in Haskell is not as convenient as in C because all I/O and reading/writing variables must be coded as separate actions. but on the other side, you will get all the benefits of power data manipulations and also can invent your own control structures. you can find in my Utils.hs a number of such small helpers -- Best regards, Bulat mailto:bulatz@HotPOP.com

Hello robert, Monday, July 18, 2005, 10:14:43 PM, you wrote: rd> main = loop 0 0 0 -- initial values rd> where loop loop_num xpos ypos = rd> do e <- pollEvent rd> let xpos' = <calculate new xpos> rd> ypos' = <calculate new ypos> rd> someActionInvolvingPosition xpos' ypos' rd> when breakCondition (return ()) rd> loop (loop_num+1) xpos' ypos' the last two lines should be if breakCondition then return () else loop (loop_num+1) xpos' ypos' `when` can only conditionally execute some code, it can't be used to return from center of `do` body! -- Best regards, Bulat mailto:bulatz@HotPOP.com

On Tue, 2005-07-19 at 09:48 +0400, Bulat Ziganshin wrote:
Hello robert,
Monday, July 18, 2005, 10:14:43 PM, you wrote:
rd> main = loop 0 0 0 -- initial values rd> where loop loop_num xpos ypos = rd> do e <- pollEvent rd> let xpos' = <calculate new xpos> rd> ypos' = <calculate new ypos> rd> someActionInvolvingPosition xpos' ypos' rd> when breakCondition (return ()) rd> loop (loop_num+1) xpos' ypos'
the last two lines should be
if breakCondition then return () else loop (loop_num+1) xpos' ypos'
Or even better: unless breakCondition $ loop (loop_num+1) xpos' ypos' Bernie.

This is my function to convert a fraction (0

Opps, its 0:f t not 0:: f t and the same for 1:f (t-1)
From: "Dinh Tien Tuan Anh"
To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Error with Float Date: Tue, 19 Jul 2005 14:48:55 +0000 This is my function to convert a fraction (0
f x Št<1 = 0::f t Šotherwise = 1::f (t-1) where t = 2*x
I guess there's nothing wrong with that, but when traced, it has something like 0.6*2 - 1 = 0.600001 This error got accumulated and made my f function wrong (will eventually evaluate an infinite 0, no matter what value of x)
Please tell me there's some ways to deal with that.
Thanks a lot
_________________________________________________________________ Want to block unwanted pop-ups? Download the free MSN Toolbar now! http://toolbar.msn.co.uk/
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Want to block unwanted pop-ups? Download the free MSN Toolbar now! http://toolbar.msn.co.uk/

Perhaps you mean:
f x
| x < 1 = 0 : f (2*x)
| otherwise = 1 : f (2*(x-1))
Note that in the second case, the 1 is subtracted before multiplication by 2.
If you were referring to the problem that this eventually gives
constantly 0 for values like 0.6, try importing the Ratio module and
applying it to 6%10, which is the exact rational value rather than a
floating point representation.
- Cale
On 19/07/05, Dinh Tien Tuan Anh
This is my function to convert a fraction (0
f x ¦t<1 = 0::f t ¦otherwise = 1::f (t-1) where t = 2*x
I guess there's nothing wrong with that, but when traced, it has something like 0.6*2 - 1 = 0.600001 This error got accumulated and made my f function wrong (will eventually evaluate an infinite 0, no matter what value of x)
Please tell me there's some ways to deal with that.
Thanks a lot
_________________________________________________________________ Want to block unwanted pop-ups? Download the free MSN Toolbar now! http://toolbar.msn.co.uk/
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Here's what i got writeln x = putStr (x++ "\n") f:: Double -> IO Double f x = do let t = 2*x if (t<1) then return t else return (t-1) gen :: Double -> IO() gen x = do c<-f x writeln ("Value is: " ++ show c) if (c /= 0.0) then gen c else return () Main> gen 0.1 Value is: 0.2 Value is: 0.4 Value is: 0.8 Value is: 0.6 Value is: 0.2 Value is: 0.4 Value is: 0.800000000000001 Value is: 0.600000000000001 Value is: 0.200000000000003 Value is: 0.400000000000006 Value is: 0.800000000000011 Value is: 0.600000000000023 Value is: 0.200000000000045 Value is: 0.400000000000091 Value is: 0.800000000000182 Value is: 0.600000000000364 Value is: 0.200000000000728 Value is: 0.400000000001455 Value is: 0.80000000000291 Value is: 0.600000000005821 Value is: 0.200000000011642 Value is: 0.400000000023283 Value is: 0.800000000046566 Value is: 0.600000000093132 Value is: 0.200000000186265 Value is: 0.400000000372529 Value is: 0.800000000745058 Value is: 0.600000001490116 Value is: 0.200000002980232 Value is: 0.400000005960464 Value is: 0.800000011920929 Value is: 0.600000023841858 Value is: 0.200000047683716 Value is: 0.400000095367432 Value is: 0.800000190734863 Value is: 0.600000381469727 Value is: 0.200000762939453 Value is: 0.400001525878906 Value is: 0.800003051757813 Value is: 0.600006103515625 Value is: 0.20001220703125 Value is: 0.4000244140625 Value is: 0.800048828125 Value is: 0.60009765625 Value is: 0.2001953125 Value is: 0.400390625 Value is: 0.80078125 Value is: 0.6015625 Value is: 0.203125 Value is: 0.40625 Value is: 0.8125 Value is: 0.625 Value is: 0.25 Value is: 0.5 Value is: 0.0
From: Cale Gibbard
Reply-To: Cale Gibbard To: Dinh Tien Tuan Anh CC: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Error with Float Date: Tue, 19 Jul 2005 11:00:34 -0400 Perhaps you mean: f x | x < 1 = 0 : f (2*x) | otherwise = 1 : f (2*(x-1))
Note that in the second case, the 1 is subtracted before multiplication by 2.
If you were referring to the problem that this eventually gives constantly 0 for values like 0.6, try importing the Ratio module and applying it to 6%10, which is the exact rational value rather than a floating point representation.
- Cale
_________________________________________________________________ Winks & nudges are here - download MSN Messenger 7.0 today! http://messenger.msn.co.uk

To get exact fractions, use the Ratio module (import Ratio) and the
Rational type which is defined there.
The code you wrote below has a serious style problem that I thought
I'd point out: you shouldn't use the IO monad for pure functions. You
can define f as follows:
f x = let t = 2 * x
in if t < 1
then t
else t - 1
or with guards:
f x | t < 1 = t
| otherwise = t - 1
where t = 2 * x
Note that there isn't any problem with using pure functions from the
IO monad. You can write gen as follows:
gen :: Double -> IO ()
gen x | c == 0.0 = return ()
| otherwise = do putStrLn $ "Value is: " ++ show c; gen c
where c = f x
(writeln is called putStrLn in the standard prelude)
Or syntactically closer to your original code:
gen :: Double -> IO ()
gen x = do let c = f x
putStrLn ("Value is: " ++ show c)
if (c /= 0.0)
then gen c
else return ()
You don't use the c <- f x notation because (f x) is directly the
value you want, not an IO action which executes to produce that value.
So long as you don't put a type signature on it (causing it to get
inferred), or if you give it the type signature:
f :: (Num a, Ord a) => a -> a
it will work with any ordered type of numbers, which allows you to
load up the Ratio module in ghci (":m + Ratio") and try it with things
like 1%3 (which represents one-third exactly).
Hope this is useful,
- Cale
On 19/07/05, Dinh Tien Tuan Anh
Here's what i got
writeln x = putStr (x++ "\n")
f:: Double -> IO Double f x = do let t = 2*x if (t<1) then return t else return (t-1)
gen :: Double -> IO() gen x = do c<-f x writeln ("Value is: " ++ show c) if (c /= 0.0) then gen c else return ()
-snip-

On 7/19/05, Cale Gibbard
The code you wrote below has a serious style problem that I thought I'd point out: you shouldn't use the IO monad for pure functions. You can define f as follows: [snip]
I agree on the stylistic front. Another approach is to make the generator function return the list of values. gen :: Double -> [Double] gen x = (takeWhile (/= 0.0) $ iterate f x) ++ [0.0] where f x = let t = 2 * x in if t < 1 then t else t-1 showSteps :: [Double] -> [String] showSteps xs = map showStep $ zip [1..] xs where showStep (n, x) = (show n) ++ ". Value is: " ++ (show x) iogen :: Double -> IO () iogen x = mapM_ putStrLn $ showSteps $ gen x I added the ++ [0.0] to gen so that it will generate the same list as the original version. To illustrate the generality of the floating-point inexactness problem, I added the step numbering to compare with another programming language. In Python: def gen(x, n=1): t = x * 2. if t < 1.: c = t else: c = t - 1 print '%d. Value is: %.16f' % (n, c) if c != 0: gen(c, n + 1) Both programs terminate in the same number of steps, since their floating-point types have the same underlying implementation. Python has no Rational type to fall back on, however. Josh Hoyt

To get exact fractions, use the Ratio module (import Ratio) and the Rational type which is defined there.
Thanks dude, it works
The code you wrote below has a serious style problem that I thought I'd point out: you shouldn't use the IO monad for pure functions.
I've never known that, thanks a lot TuanAnh _________________________________________________________________ It's fast, it's easy and it's free. Get MSN Messenger 7.0 today! http://messenger.msn.co.uk
participants (10)
-
Adrian Hey
-
Bernard Pope
-
Bulat Ziganshin
-
Cale Gibbard
-
Claus Reinke
-
Dinh Tien Tuan Anh
-
Donn Cave
-
Josh Hoyt
-
robert dockins
-
yin