Showing posts with label logo graphics. Show all posts
Showing posts with label logo graphics. Show all posts

Wednesday, July 8, 2015

sqrt 2, visualized

This code, inspired by my earlier post, animates the digits of √2 in an unsuual way. Each digit advances the curve in the direction given by a numeric keypad, with 5 and 0 both considered (0,0). The thumbnail at left links to a 4000x4000 window on 9856041 digits of the curve, which originates at the image center.

The program makes for an interesting screensaver, but does it follow any pattern, or illustrate any special properties of √2 ? Though I'm no mathematician, from what I've read this seems unlikely. √2 is suspected (but not proved) to be a normal number. This would mean the digits of its expansion (respective to some number base) follow a uniform distribution; no digit would be more likely to appear than any other.

Nonetheless, I'd be curious to see the results of a really long run!

Sunday, January 26, 2014

prime curve

This curve is created, Logo-style, by the trail of a turtle that makes a clockwise quarter-turn at every prime iteration; the screenshot shows the curve after about 730000 steps.
import Control.Arrow ((***))
import Control.Monad (void, liftM3, when)
import Data.Bits (shift)
import Data.Numbers.Primes (primes)
import Graphics.UI.SDL as SDL
   
(xres, yres) = (800, 800)
  
main = withInit [InitVideo] $ do
  win <- setVideoMode xres yres 32 []
  fillRect win (Just $ Rect 0 0 xres yres) (Pixel 0)
  enableEvent SDLMouseMotion False
  setCaption "Prime Curve" "Prime Curve"
  run win (xres `div` 2, yres `div` 2) [1..] nesw rgbs
 where
  nesw    = cycle $ map f [(0,-1), (1,0), (0,1), (-1,0)]
  f (x,y) = (x+) *** (+y)
   
run w p (n:ns) (d:ds) (c:cs) = do
  drawCell w p c
  let ds' = if prime n then ds else d:ds
  when (n `mod` 13 == 0) $ SDL.flip w
  e <- pollEvent
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> void save
   _                              -> run w (d p) ns ds' cs
 where
  prime n = n `elem` takeWhile (< n + 1) primes
  save    = saveBMP w "out.bmp" >> print n
   
drawCell w p c =
  draw p =<< createRGBSurface [SWSurface] 1 1 32 0 0 0 0
 where
  rect x y     = Just $ Rect x y 1 1
  draw (x,y) s = do fillRect s (rect 0 0) (Pixel c)
                    blitSurface s (rect 0 0) w (rect x y)
 
rgbs = cycle . map f $ liftM3 (,,) ns ns ns
 where
  ns        = [151, 153.. 255]
  f (r,g,b) = shift r 16 + shift g 8 + b