Skip to content

[Haskell] Barnsley Fern #851

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Nov 21, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 7 additions & 5 deletions contents/barnsley/barnsley.md
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ In this chapter, I hope to provide a slightly more satisfying answer by introduc

| Hutchinson Operator | Attractor |
| ------------------- | --------- |
| $$\begin{align} f_1(P) &= \begin{bmatrix} 0 &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix} \\ f_2(P) &= \begin{bmatrix} 0.85 &0.04 \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix} \\ f_3(P) &= \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &022 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix} \\ f_4(P) &= \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0.44 \end{bmatrix} \end{align}$$ | <img class="center" src="res/full_fern.png" alt="Barnsley Chaos Game" style="width:100%"> |
| $$\begin{align} f_1(P) &= \begin{bmatrix} 0 &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix} \\ f_2(P) &= \begin{bmatrix} 0.85 &0.04 \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix} \\ f_3(P) &= \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &0.22 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix} \\ f_4(P) &= \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0.44 \end{bmatrix} \end{align}$$ | <img class="center" src="res/full_fern.png" alt="Barnsley Chaos Game" style="width:100%"> |

At first glance, this set of functions looks like an incomprehensible mess of magic numbers to create a specific result, and in a sense, that is precisely correct.
That said, we will go through each function and explain how it works, while also providing a simple chaos game implementation in code.
Expand Down Expand Up @@ -54,7 +54,7 @@ Now let's hop into disecting the Barnsley fern by seeing how each transform affe
| -------- | --------- |
| $$f_1(P) = \begin{bmatrix} 0 &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix}$$ <p> This operation moves every point to a single line. | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_rnd_0.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_2(P) = \begin{bmatrix} 0.85 &0.04 \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ <p> This operation moves every point up and to the right. | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_rnd_1.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &022 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ <p> This operation rotates every point to the left. | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_rnd_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &0.22 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ <p> This operation rotates every point to the left. | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_rnd_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_4(P) = \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0.44 \end{bmatrix}$$ <p> This operation flips every point and rotates to the right.| <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_rnd_3.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |

At this stage, it *might* be clear what is going on, but it's not exactly obvious.
Expand All @@ -71,7 +71,7 @@ The easiest way to make sense of this is to show the operations on the Barnsley
| -------- | --------- |
| $$f_1(P) = \begin{bmatrix} 0 &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix}$$ | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_fern_0.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_2(P) = \begin{bmatrix} 0.85 &0.04 \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_fern_1.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &022 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_fern_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &0.22 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_fern_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_4(P) = \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0.44 \end{bmatrix}$$ | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/affine_fern_3.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |

Here, the self-similar nature of the fern becomes apparent.
Expand All @@ -86,7 +86,7 @@ To account for this, each function is also given a probability of being chosen:
| -------- | ----------- |
| $$f_1(P) = \begin{bmatrix} 0 &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix}$$ | 0.01 |
| $$f_2(P) = \begin{bmatrix} 0.85 &0.04 \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | 0.85 |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &022 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | 0.07 |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &0.22 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ | 0.07 |
| $$f_4(P) = \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0.44 \end{bmatrix}$$ | 0.07 |

## Playing around a bit...
Expand All @@ -98,7 +98,7 @@ Here are a few examples of ferns that can be generated by modifying constituent
| -------- | --------- |
| $$f_1(P) = \begin{bmatrix} \tau &0 \\ 0 &0.16 \end{bmatrix}P + \begin{bmatrix} 0 \\ 0 \end{bmatrix}$$ <p> where $$-0.5 < \tau < 0.5 $$ <p> Turning stems to leaves | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/fern_twiddle_0.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_2(P) = \begin{bmatrix} 0.85 & \tau \\ -0.04 &0.85 \end{bmatrix}P + \begin{bmatrix} 0 \\ 1.6 \end{bmatrix}$$ <p> where $$ -0.01 < \tau < 0.09 $$ <p> Changing fern tilt | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/fern_twiddle_1.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &022 \end{bmatrix}P + \begin{bmatrix} \tau \\ 1.6 \end{bmatrix}$$ <p> where $$-0.5 < \tau < 0.5$$ <p> Plucking left leaves | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/fern_twiddle_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_3(P) = \begin{bmatrix} 0.2 &-0.26 \\ 0.23 &0.22 \end{bmatrix}P + \begin{bmatrix} \tau \\ 1.6 \end{bmatrix}$$ <p> where $$-0.5 < \tau < 0.5$$ <p> Plucking left leaves | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/fern_twiddle_2.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |
| $$f_4(P) = \begin{bmatrix} -0.15 &0.28 \\ 0.26 &0.24 \end{bmatrix}P + \begin{bmatrix} \tau \\ 0.44 \end{bmatrix}$$ <p> where $$-0.5 < \tau < 0.5$$ <p> Plucking right leaves | <div style="text-align:center"> <video style="width:100%" controls loop> <source src="res/fern_twiddle_3.mp4" type="video/mp4"> Your browser does not support the video tag. </video> </div> |

As an important note: the idea of modifying a resulting image by twiddling the knobs of an affine transform is the heart of many interesting methods, including fractal image compression where a low resolution version of an image is stored along with a reconstructing function set to generate high-quality images on-the-fly {{ "fractal-compression" | cite }}{{ "saupe1994review" | cite }}.
Expand Down Expand Up @@ -135,6 +135,8 @@ The biggest differences between the two code implementations is that the Barnsle
[import, lang:"java"](code/java/Barnsley.java)
{% sample lang="coco" %}
[import, lang:"coconut"](code/coconut/barnsley.coco)
{% sample lang="hs" %}
[import, lang:"haskell"](code/haskell/Barnsley.hs)
{% endmethod %}

### Bibliography
Expand Down
40 changes: 40 additions & 0 deletions contents/barnsley/code/haskell/Barnsley.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
import Data.Array (Array, bounds, elems, listArray, (!))
import Data.List (intercalate)
import System.Random

data Point = Point Double Double

chaosGame :: RandomGen g => g -> Int -> Array Int (Double, (Point -> Point)) -> [Point]
chaosGame g n hutchinson = take n points
where
(x, g') = random g
(y, g'') = random g'

cumulProbabilities = scanl1 (+) $ map fst $ elems hutchinson
to_choice x = length $ takeWhile (x >) cumulProbabilities

picks = map to_choice $ randomRs (0, 1) g''
step = fmap snd hutchinson

points = Point x y : zipWith (step !) picks points

affine :: (Double, Double, Double, Double) -> (Double, Double) -> Point -> Point
affine (xx, xy, yx, yy) (a, b) (Point x y) = Point (a + xx * x + xy * y) (b + yx * x + yy * y)

showPoint :: Point -> String
showPoint (Point x y) = show x ++ "\t" ++ show y

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

{-

Here is alternative code with IO monad instead of explicit Random Generator.
You do random generation in sequence anyway (through g, g' and g''),
so why not let IO monad care about the sequential stuff for you?
Then you won't even need newStdGen in main function, you work in IO already.

(This is the code without taking into account my other comments)


chaosGame :: Int -> [Double] -> Array Int (Point -> Point) -> IO [Point]
chaosGame n probabilities hutchinson = do
x <- randomIO
y <- randomIO

picks <- replicateM n $ randomRIO (0, 1)
let cumulProbabilities = scanl1 (+) probabilities
to_choice x = (+ 1) $ length $ takeWhile (x >) cumulProbabilities

points = Point x y : zipWith (hutchinson !) (map to_choice picks) points
return points
-}

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I usually try to stay away from IO until the very end. I feel code is more portable when it's pure. Yes, it's true that I'm doing IO in the end, but I want to focus more on the algorithm, and less on the task...

main :: IO ()
main = do
g <- newStdGen
let barnsley =
listArray
(0, 3)
[ (0.01, affine (0, 0, 0, 0.16) (0, 0)),
(0.85, affine (0.85, 0.04, -0.04, 0.85) (0, 1.6)),
(0.07, affine (0.2, -0.26, 0.23, 0.22) (0, 1.6)),
(0.07, affine (-0.15, 0.28, 0.26, 0.24) (0, 0.44))
]
points = chaosGame g 100000 barnsley

writeFile "out.dat" $ intercalate "\n" $ map showPoint points