diff --git a/Attrac.cabal b/Attrac.cabal --- a/Attrac.cabal +++ b/Attrac.cabal @@ -1,5 +1,5 @@ name: Attrac -version: 0.1.1 +version: 0.1.2 author: Ruben Henner Zilibowitz maintainer: Ruben Henner Zilibowitz homepage: http://patch-tag.com/r/rhz/StrangeAttractors diff --git a/Attrac.hs b/Attrac.hs --- a/Attrac.hs +++ b/Attrac.hs @@ -34,7 +34,6 @@ b = recip (sqrt (a12*a12 + a22*a22 + a32*a32)) c = recip (sqrt (a13*a13 + a23*a23 + a33*a33)) ---fm cs (p,m) = (f cs p,normCols ((fjac cs p) <*> m)) fm cs (p,m) = (f cs p,normCols $ (fjac cs p) <*> m) (<*>) :: Mat -> Mat -> Mat @@ -142,8 +141,10 @@ grabRandoms 0 _ g = ([],g) grabRandoms n (x,y) g = let (r,g') = randomR (x,y) g in let (rs,g'') = grabRandoms (n-1) (x,y) g' in (r:rs,g'') +minValidLyapunovExponent = 1e-9 + randomiseCoeffs :: StdGen -> (Coeffs,Value) -randomiseCoeffs g = case maxLyapunovExponent cs of {Just x | x > 1e-6 -> (cs,x); _ -> randomiseCoeffs g'} +randomiseCoeffs g = case maxLyapunovExponent cs of {Just x | x > minValidLyapunovExponent -> (cs,x); _ -> randomiseCoeffs g'} where (as,g') = grabRandoms numCoeffs (-13,13) g cs = listArray (0,numCoeffs-1) (map (\a -> 0.1 * (fromIntegral a)) as) diff --git a/AttracCloudView.hs b/AttracCloudView.hs --- a/AttracCloudView.hs +++ b/AttracCloudView.hs @@ -142,7 +142,7 @@ attenuation = 40 / (lightAttenuationConstant + lightAttenuationLinear*root_pp + lightAttenuationQuadratic*pp)-} transform :: (Int,Int) -> Pt -> (Int,Int) -transform (width,height) (Pt x y _) = (round $ (fromIntegral width) * 0.5 + 100*x, round $ (fromIntegral height) * 0.5 + 100*y) +transform (width,height) (Pt x y _) = (round $ (fromIntegral width) * 0.5 + 400*x, round $ (fromIntegral height) * 0.5 + 400*y) colorSpeed = 1e-2 @@ -153,18 +153,14 @@ display state = do p <- readIORef (curP state) cs <- readIORef (coeffs state) - let (ps,q:_) = splitAt iterations (iterate (ffm cs) p) - {-let q = p - g <- newStdGen - let rs = take iterations (randomRs (-2,2.0) g) - let ps = [let u = Pt x (y/(sqrt$y*y+z*z)) (z/(sqrt$y*y+z*z)) in (u,(Pt 0 (-z/(sqrt$y*y+z*z)) (y/(sqrt$y*y+z*z)))) | Pt x y z <- zipWith3 (\a b c -> (Pt a b c)) rs (tail rs) (tail$tail rs)]-} vm1 <- readIORef (modelViewMat state) pm <- readIORef (projectionMat state) let vm = (translationMat locPt) <*%> vm1 let pvm = pm <*%> vm dims@(width,height) <- readIORef (screen state) + let (ps,q:_) = splitAt iterations (iterate (ffm cs) p) let xs = filter (\((px,py),_) -> 0<=px&&px p),shade (vm <*#> p) (vm <*#%> t)) | (p,t) <- ps] + [(transform dims (pvm <*#> p),shade (vm <*#> p) (vm <*#%> t)) | (p,t) <- ps, p<.>p>(-1), t<.>t>(-1)] -- List comprehension condition is always true. Forces computation of the values. This gets around a potential stack overflow bug. Is there a better solution to this? modifyIORef (curBuffer state) (flip (Array.accum (\(y,c) x -> (x+y,c+1))) xs) buf <- readIORef (curBuffer state) renderPrimitive Points$sequence_ [let (x,c) = buf!(px,py) @@ -229,11 +225,14 @@ putStr "\nEnter Sprott code: " hFlush stdout code <- getLine - let cs = listArray (0,numCoeffs-1) (readCode code) - putStrLn $ "\nLyapunov Exponent: " ++ show (maxLyapunovExponent cs) - writeIORef (coeffs state) cs - writeIORef (curP state) (findOrbit cs) - clearAll state + let cs = listArray (0,numCoeffs-1) ((readCode code) ++ (repeat 0)) + case maxLyapunovExponent cs of + Just x | x > minValidLyapunovExponent && not (isBadNum x) -> do + putStrLn $ "\nLyapunov Exponent: " ++ show x + writeIORef (coeffs state) cs + writeIORef (curP state) (findOrbit cs) + clearAll state + _ -> putStrLn "Invalid code" '\27' -> putStrLn "" >> exitWith ExitSuccess _ -> return () keyboardMouse state (MouseButton LeftButton) buttonState _ pos = @@ -286,7 +285,7 @@ 0 0 0 1 scaleMat :: Position -> PMat -scaleMat (Position x y) = PMat +scaleMat (Position x _) = PMat 1 0 0 0 0 1 0 0 0 0 1 0 @@ -340,4 +339,4 @@ backgroundColor = Color4 0 0 0.12 1 instructions :: String -instructions = "'m' -> output transform matrix\n'p' -> output current point\n'f' -> output frames elapsed\n'r' -> post redisplay\n' ' -> reset transform matrix\n'c' -> randomise coefficients\n's' -> select next Sprott code from list\nESC -> exit\n\n'left mouse button' -> drag mouse to translate in XY plane\n'middle mouse button' -> drag mouse to scale\n'right mouse button' -> drag mouse to rotate around X and Y axes\n" +instructions = "'m' -> output transform matrix\n'p' -> output current point\n'f' -> output frames elapsed\n'r' -> post redisplay\n' ' -> reset transform matrix\n'c' -> randomise coefficients\n's' -> select next Sprott code from list\n'e' -> Enter a Sprott code on the command line\nESC -> exit\n\n -> drag mouse to translate in XY plane\n -> drag mouse to scale\n -> drag mouse to rotate around X and Y axes\n" diff --git a/README b/README --- a/README +++ b/README @@ -12,11 +12,11 @@ ' ' -> reset transform matrix 'c' -> randomise coefficients 's' -> select next Sprott code from list +'e' -> Enter a Sprott code on the command line ESC -> exit -'left mouse button' -> drag mouse to translate in XY plane -'middle mouse button' -> drag mouse to scale -'right mouse button' -> drag mouse to rotate around X and Y axes + -> drag mouse to translate in XY plane + -> drag mouse to scale + -> drag mouse to rotate around X and Y axes -25/02/10 Ruben Henner Zilibowitz