Skip to content

Instantly share code, notes, and snippets.

@shicks
Last active October 25, 2023 05:37
Show Gist options
  • Save shicks/817ac853088e1f1d23b9964cb05a3653 to your computer and use it in GitHub Desktop.
Save shicks/817ac853088e1f1d23b9964cb05a3653 to your computer and use it in GitHub Desktop.
Console Fractals
-- Defines a data structure for plotting data in a text console using braille
module Dots where
import Control.Monad.State (State, modify, execState)
import Data.Ix (range)
import qualified Data.Set as S
data Dots = Dots (Int, Int) (S.Set (Int, Int))
-- Ordered list of the 8 bits.
bits :: [(Int, Int)]
bits = [(0, 0), (1, 0), (2, 0), (0, 1), (1, 1), (2, 1), (3, 0), (3, 1)]
instance Show Dots where
show (Dots (rows, cols) points) = show' 0 0
where show' row col
| row > rows = ""
| col > cols = '\n' : show' (row + 4) 0
| otherwise = char row col : show' row (col + 2)
char r c = toEnum $ (0x2800+) $ codepoint bits 1 r c
codepoint [] _ _ _ = 0
codepoint ((dr, dc) : bs) n r c = inc + codepoint bs (2 * n) r c
where inc | (r + dr, c + dc) `S.member` points = n
| otherwise = 0
alloc :: Int -> Int -> Dots
alloc rows cols = Dots (rows, cols) S.empty
empty :: Dots
empty = alloc 0 0
add :: Int -> Int -> Dots -> Dots
add r c (Dots (rs, cs) s) = Dots (max r rs, max c cs) $ (r, c) `S.insert` s
graph :: Bool -> (Int -> Int -> Bool) -> (Int, Int) -> IO ()
graph label func (mx, my) = putStrLn $ box $
foldl maybeAdd (alloc my mx) $
range ((0, 0), (my - 1, mx - 1))
where maybeAdd d (y, x) = if func x (fromIntegral (my - 1) - y)
then add (y + (4 - my) `mod` 4) x d
else d
box :: Dots -> String
box d = box' $ lines $ show d
box' [] = "++\n++\n"
box' ls = tl : header ++ tr : '\n' :
concat (map (\l -> '|' : l ++ "|\n") ls) ++
bl : header ++ br : ""
where header = replicate (length $ head ls) '-'
tl = if label then 'y' else '+'
tr = '+'
bl = if label then '0' else '+'
br = if label then 'x' else '+'
module Fractal where
import Data.Complex (Complex(..), magnitude)
import Dots (graph)
type C = Complex Double
data Fractal = Fractal C C (C -> Bool)
fractal :: (Double, Double) -> (Double, Double) -> (C -> Bool) -> Fractal
fractal min max f = Fractal (complex min) (complex max) f
where complex = uncurry (:+)
plot :: Fractal -> Int -> IO ()
plot (Fractal min max f) n = graph False pred (n, n)
where pred x y = f $ min + (fromIntegral x * dx :+ fromIntegral y * dy)
dx :+ dy = (max - min) / (fromIntegral n - 1)
converges :: (C -> C) -> C -> Int -> Bool
converges _ z _ | magnitude z > 2 = False
converges _ _ 0 = True
converges f z n = converges f (f z) (n - 1)
sq :: Num a => a -> a -> a
sq c z = z * z + c
mandelbrot :: Fractal
mandelbrot = fractal (-2.25, -1.5) (0.75, 1.5) $ \z -> converges (sq z) 0 20
julia :: C -> Fractal
julia c = fractal (-1.5, -1.5) (1.5, 1.5) $ \z -> converges (sq c) z 20
module Main where
import Data.Complex (Complex(..))
import Fractal (plot, mandelbrot, julia)
main :: IO ()
main = do plot mandelbrot 151
plot (julia $ 0.14 :+ 0.66) 151
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment