Last active
October 26, 2020 17:44
-
-
Save mbrc12/c3a40215022ea8efcddf7ad39993e4f3 to your computer and use it in GitHub Desktop.
fractal
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- | |
fractal : A fractal generator in haskell | |
Author : Mriganka Basu Roy Chowdhury | |
Install : Preferably (if you don't want cabal hell), | |
form a cabal sandbox and install JuicyPixels | |
and optparse-applicative. Then just | |
cabal exec -- ghc fractal.hs -O3 | |
Please use -O3, as otherwise, the generation | |
may take a lot of time. | |
Modifications : | |
Look into the source below, and change | |
stuff if you need to. Most of the code is | |
segmented, and documented, so that part | |
should be pretty obvious. | |
-} | |
import Codec.Picture -- needs JuicyPixels | |
import Data.Complex -- in base, so chill. | |
import Data.List -- again in base. | |
import Options.Applicative -- need optparse-applicative | |
import Data.Semigroup hiding (option) -- in base | |
import Text.Read (readMaybe) -- in base as well. | |
import Data.Maybe -- in base. | |
import Control.Monad -- in base. | |
type R = Float -- The real used, change to Double for precision | |
type C = Complex R | |
type IterF = C -> C -- Iteration function | |
type Pix = PixelRGB8 -- The pixel type used. | |
type View = (C, C) -- Upper left, lower right complex numbers | |
type Dimensions = (Int, Int) -- Width, Height | |
inf :: R | |
inf = 1e20 | |
-------------------- For general uses, just modify this part ------- | |
baseFunction :: C -> IterF -- Change this function to your wishes, but | |
-- keep the signature intact. :) | |
-- This function currently generates mandelbrot sets. | |
baseFunction c z = z**2 + c | |
-------------- ************************************ ---------------- | |
characteristic :: (C -> IterF) -- Iteration function | |
-> R -- Escape Radius | |
-> Int -- Iterations | |
-> C -- Parameter | |
-> Pix -- Pix value indicating color, | |
-- produced by calling colorFunc | |
characteristic f r n c = | |
let g = f c | |
l = map snd $ | |
takeWhile (\(i, z) -> i <= n && realPart (abs z) < r) $ | |
zip [1..] $ iterate g (0.0 :+ 0.0) | |
in colorFunc n (length l) c (last l) | |
------------------------------------------------------------------- | |
data FractalOptions | |
= FractalOptions | |
{ iterations :: Int | |
, escapeRad :: R | |
, upperLeftX :: R | |
, upperLeftY :: R | |
, lowerRightX :: R | |
, lowerRightY :: R | |
, width :: Int | |
, height :: Int | |
, output :: FilePath | |
} | |
main :: IO () | |
main = do | |
results <- execParser $ info (parser <**> helper) | |
( header "--- fractal : A fractal generator ---" | |
<> progDesc "Generates a PNG image of a fractal generated by iteration" | |
<> fullDesc | |
) | |
let (FractalOptions n r ulx uly lrx lry w h out) = results | |
image = produceFractal baseFunction n r | |
((ulx :+ uly), (lrx :+ lry)) | |
(w, h) | |
putStrLn "Generating and writing the image... Hang tight." | |
writePng out image | |
putStrLn "Done. Enjoy!" | |
---------------- The parser for optparse ------------ | |
parser :: Parser FractalOptions | |
parser = FractalOptions <$> | |
option auto | |
( long "iterations" | |
<> short 'n' | |
<> help "The number of times the iteration happens." | |
<> metavar "INTEGER" | |
<> value 30 | |
) | |
<*> | |
option auto | |
( long "escape" | |
<> short 'r' | |
<> help "Escape radius" | |
<> metavar "REAL" | |
<> value 10.0 | |
) | |
<*> | |
option auto | |
( long "upper-left-x" | |
<> short 'X' | |
<> help "The upper left x in the frame of the image generated." | |
<> metavar "REAL" | |
<> value (-1.8) | |
) | |
<*> | |
option auto | |
( long "upper-left-y" | |
<> short 'Y' | |
<> help "The upper left y in the frame of the image generated." | |
<> metavar "REAL" | |
<> value (1.3) | |
) | |
<*> | |
option auto | |
( long "lower-right-x" | |
<> short 'x' | |
<> help "The upper left x in the frame of the image generated." | |
<> metavar "REAL" | |
<> value (0.8) | |
) | |
<*> | |
option auto | |
( long "lower-right-y" | |
<> short 'y' | |
<> help "The upper left x in the frame of the image generated." | |
<> metavar "REAL" | |
<> value (-1.3) | |
) | |
<*> | |
option auto | |
( long "width" | |
<> short 'w' | |
<> help "Width of the image generated." | |
<> metavar "INTEGER" | |
<> value 600 | |
) | |
<*> | |
option auto | |
( long "height" | |
<> short 'h' | |
<> help "Height of the image generated." | |
<> metavar "INTEGER" | |
<> value 600 | |
) | |
<*> | |
strOption | |
( long "output" | |
<> short 'o' | |
<> help "Output file name of the png image" | |
<> metavar "FILENAME" | |
<> value "output.png" | |
) | |
------------- A few math functions --------------------- | |
clamp :: R -> R -> R -> R | |
clamp l r x = min r (max x l) | |
-- | |
normal :: R -- center | |
-> R -- spread | |
-> R -- value | |
-> R | |
normal c spread x = exp (- (abs (x - c))**2 / spread) | |
-- | |
sigmoidCut :: R -> R -> R -> R | |
sigmoidCut c s x = if x < c then 0.0 else -0.5 + 1.0 / (1 + exp (-(x - c)/s)) | |
-------------------------------------------------------- | |
-- The function that generates the color. | |
-- The current configuration was obtained after many trials. | |
-- So perfecting it may require trial and error / theory. | |
colorFunc :: Int -- Number of iterations max | |
-> Int -- Number of iterations taken | |
-> C -- Current complex number | |
-> C -- Final complex number after iteration | |
-> Pix -- Generated color | |
colorFunc n m z z' = | |
let w = 1 + (realPart $ abs z) | |
w'= 1 + (realPart $ abs z') | |
x = fromIntegral (n - m) / (fromIntegral n) | |
r = normal (0.8) 0.05 x | |
g = normal (0.8) 0.1 x | |
b = sigmoidCut (0.8) 0.05 x | |
r'= floor $ r * 255 | |
g'= floor $ g * 255 | |
b'= floor $ b * 255 | |
in PixelRGB8 r' g' b' | |
--------------- The function that produces the fractal ------ | |
produceFractal :: (C -> IterF) -- Iteration function | |
-> Int -- Iterations | |
-> R -- Escape radius | |
-> View -- Region being viewed for the fractal | |
-> Dimensions -- Image dimensions | |
-> Image Pix -- Output image | |
produceFractal f n r (upperLeft, lowerRight) (w, h) = | |
let viewWidth = realPart (lowerRight - upperLeft) | |
viewHeight= imagPart (upperLeft - lowerRight) | |
charProducer = characteristic f r n | |
pixelSpace = [(x, y) | x <- [0..w], y <- [0..h]] | |
genFunction :: Int -> Int -> Pix | |
genFunction x y = | |
let dx = (fromIntegral x * viewWidth) / (fromIntegral w) | |
dy = -(fromIntegral y * viewHeight) / (fromIntegral h) | |
z = upperLeft + (dx :+ dy) | |
in charProducer z | |
in generateImage genFunction w h | |
------------------------------------------------------------- | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment