[Haskell-cafe] turning an imperative loop to Haskell

Dougal Stanton ithika at gmail.com
Thu Sep 6 09:11:47 EDT 2007


On 06/09/07, Axel Gerstenberger <axel.gerstenberger at gmx.de> wrote:

> module Main where
>
> import System.IO
> import Text.Printf
>
> main :: IO ()
> main = do
>      let all_results1 = take 20000 $ step [1]
>      --print $ length all_results1 -- BTW: if not commented out,
>                                    --      all values of all_results
>                                    --      are already
>                                    --      calculated here
>      loop [1..50] $ \i -> do
>          let x = all_results1!!i
>          putStrLn $ show i ++ "  " ++ show x
>
> -- create an infinite list with values u_{n+1} ++ [u_n,u_{n-1},...,u_1]
> -- where u_{n+1} = f (u_n)
> step history =
>      case history of
>          []   -> error "no start values"
>          xs   -> xs ++ (step [ f (head $ reverse (xs) )])

To create an infinite list where each f(u) depends on the previous u,
with a single seed value, use 'iterate':

Prelude> let us = iterate f 3

That produces your infinite list of values, starting with [f 3, f(f3),
f(f(f 3)), ...]. Pretty neat.

Then all you really need is

main = mapM_ (uncurry (printf "%d %f\n")) (zip [1..50] (iterate f 3))

You can probably shorten this a bit more with arrows but I've got a
cold at the moment and not really thinking straight.

Cheers,

D.


More information about the Haskell-Cafe mailing list