LorenzAttractor.hs

import Data.List
import Data.Fixed
import Graphics.Gloss
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.ViewPort

type Vector3 = (Float, Float, Float)

type Model = [Vector3]

rho = 28/2
sigma = 10
beta = 8/3

main :: IO ()
main =
    simulate
        (InWindow "attractor" (100, 100) (100, 100))
        black
        30
        start
        view
        step

start :: Model
start =
    [ (x, y, z) | x <- [-2, -1.5 ..2]
                , y <- [-2, -1.5 ..2]
                , z <- [-2, -1.5 ..2]
    ]

view :: Model -> Picture
view model =
    pictures $
    zipWith
        viewPoint
        (map (\x -> (x / (genericLength model))) [0..])
        model

viewPoint :: Float -> Vector3 -> Picture
viewPoint n (x, y, z) =
    let
        c = withRed 0.6 $
            --withGreen ((n `mod'` 0.33333) * 3) $
            greyN ((n `mod'` 0.11111) * 9)
    in
        color c $ translate z x $ circle 0.1

step :: ViewPort -> Float -> Model -> Model
step _ t model = map (updatePoint t) model

updatePoint :: Float -> Vector3 -> Vector3
updatePoint t (x, y, z) =
  let
    dx = (* 0.01) $ rho * (y - x)
    dy = (* 0.01) $ x * (rho - z) - y
    dz = (* 0.01) $ x * y - beta * z
  in
    (x + dx, y + dy, z + dz)