Table of Contents
In my previous experiments with
Quadtree Grammars
, each non-terminal
(pattern of this
rhs
function) had an additional fallback color /
symbols. Here the non-terminals themselves are used as fallback
symbols, like in a L-system.
Grammar rules can be encoded as a pattern matching function. Unmatched characters are repeated four times to fill their quadrant.
rhs :: Char -> String rhs 'S' = "1234" rhs c = replicate 4 c
A
String
is a
[Char]
and in turn a monad. On lists, the monadic
bind
>>=
corresponds to a map-concat (flatmap) operation.
main :: IO () main = putStrLn $ "SS" >>= rhs
12341234
To convert an expanded string into two lines, we extract two substrings of characters at even and odd positions, folding from the right so the sublists are in the correct order.
split :: [a] -> [[a]] split = foldr (\e [a, b] -> [e:b, a]) [[], []]
main :: IO () main = putStr $ unlines $ split ("S" >>= rhs)
13 24
The quadtree is stored as a
[String]
(
[[Char]]
) and converted to a
single string with
unlines
(joining the strings with newlines)
before printing.
To expand a quadtree
[String]
, we need to apply
(>>= rhs)
to each
element, split each resulting string using
split
and collect the
results into a
[String]
.
expand :: [String] -> [String] expand = (>>= split) . map (>>= rhs)
iterate :: (a -> a) -> a -> [a]
generates a lazy list by repeatedly
applying a function to an initial argument,
!! n
extracts the n-th
element of this list.
Sierpinski Triangle
rhs :: Char -> String rhs '▙' = "▙▙ ▙" split :: [a] -> [[a]] split = foldr (\e [a, b] -> [e:b, a]) [[], []] expand :: [String] -> [String] expand = (>>= split) . map (>>= rhs) main :: IO () main = putStr $ unlines $ iterate expand ["▙"] !! 5
▙ ▙▙ ▙ ▙ ▙▙▙▙ ▙ ▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙▙▙▙▙▙▙▙ ▙ ▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙▙▙▙ ▙▙▙▙ ▙ ▙ ▙ ▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙ ▙ ▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙▙▙▙ ▙▙▙▙ ▙ ▙ ▙ ▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙▙▙▙▙▙▙▙ ▙▙▙▙▙▙▙▙ ▙ ▙ ▙ ▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙▙▙▙ ▙▙▙▙ ▙▙▙▙ ▙▙▙▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙ ▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙▙
Grammar 2
rhs :: Char -> String rhs '▏' = "█ ▏▏" rhs c = replicate 4 c main :: IO () main = putStr $ unlines $ iterate expand ["▏"] !! 5
███████████████████████████████▏
██████████████████████████████ ▏
████████████████████████████ █▏
████████████████████████████ ▏
████████████████████████ ███▏
████████████████████████ ██ ▏
████████████████████████ █▏
████████████████████████ ▏
████████████████ ███████▏
████████████████ ██████ ▏
████████████████ ████ █▏
████████████████ ████ ▏
████████████████ ███▏
████████████████ ██ ▏
████████████████ █▏
████████████████ ▏
███████████████▏
██████████████ ▏
████████████ █▏
████████████ ▏
████████ ███▏
████████ ██ ▏
████████ █▏
████████ ▏
███████▏
██████ ▏
████ █▏
████ ▏
███▏
██ ▏
█▏
▏
Grammar 3
rhs :: Char -> String rhs '█' = " ██ " rhs ' ' = "█ █ " rhs c = replicate 4 c main :: IO () main = putStr $ unlines $ iterate expand ["█"] !! 5
█ ███ █ █ ███ ███ ███ █ █ ███ █
█ █ █ █ █ █ █ █ █ █ █
████ ███████ ███ ███ ███████ ███
█ █ █ █ █
██ █ █ ███ █ █ █ █ █ █ ███ █ █ █
█ █ █ █ █ █ █ █ █ █ █ █ █
███████ ███████████████ ███████
█ █ █
██ ███ ███ ███ █ █ ███ ███ ███ █
█ █ █ █ █ █ █ █ █
███ ███ ███ ███████ ███ ███ ███
█ █ █ █ █ █ █
█ █ █ █ █ █ █ ███ █ █ █ █ █ █ █
█ █ █ █ █ █ █ █ █ █ █ █ █ █ █
████████████████ ███████████████
█
██ ███ █ █ ███ █ █ ███ █ █ ███ █
█ █ █ █ █ █ █ █ █ █ █
███ ███████ ███████ ███████ ███
█ █ █ █ █
█ █ █ ███ █ █ ███ █ █ ███ █ █ █
█ █ █ █ █ █ █ █ █ █ █ █ █
████████ ███████ ███████ ███████
█ █ █
█ ███ ███ ███ ███ ███ ███ ███ █
█ █ █ █ █ █ █ █ █
████ ███ ███ ███ ███ ███ ███ ███
█ █ █ █ █ █ █
██ █ █ █ █ █ █ █ █ █ █ █ █ █ █ █
█ █ █ █ █ █ █ █ █ █ █ █ █ █ █
███████████████████████████████
█