For my next project, I decided to generate an L-System using Haskell and Logo together. L-Systems, or Lindenmayer Systems, are a formal grammar for describing the growth of biological systems. They were developed in the 60s to explain the behavior of cell division in plants. We can use them to generate plausible images of plants on a computer.
L-Systems are composed of a set of symbols, an axiom which serves as a start state, and a set of rules for transforming symbols into sets of symbols. The interesting thing about the L-System grammar is that it is a parallel rewriting system, which means that the rules are applied to all symbols in the current state in parallel, rather than applying one rule to the state after another.
As an example, Lindenmayer’s original L-System was specified like this:
- variables : A B
- constants : none
- axiom : A
- rules : (A → AB), (B → A)
This says that there are two symbols, A and B, and the system starts with an A symbol. The rules are that ‘A’ becomes “AB” and ‘B’ becomes “A”.
The result of applying this in sequence is a string of As and Bs, which apparently represents algae growth.
Implementing this parallel rewriting in Haskell is very simple. First I started by defining two data types:
data Start a = Start a deriving (Show) data Rules a = Rules (a -> [a])
Start represents the initial axiom of the system and Rules contains a function for taking a symbol to a list of symbols. I don’t need to specify the variables or constants, because they’re going to be implicit in the rules and axiom.
Next I needed a way to apply the rules to the current state, which is a list of symbols:
applyLSystem :: [a] -> Rules a -> [[a]] applyLSystem  _ = [] applyLSystem (symbol : system) (Rules f) = (f symbol) : applyLSystem system (Rules f)
applyLSystem processes one symbol at a time and applies the rules function to it, producing a list of lists of symbols. Evaluating the L-System is simply a matter of concatenating the produced strings:
evaluateLSystem :: [a] -> Rules a -> [a] evaluateLSystem system rules = concat (applyLSystem system rules)
I want to do this in a loop, so that I can generate a fractal using more than one iteration, so I wrote a loop which will take the system as an input and draw the system for each iteration:
getNewLSystem :: Show a => ([a] -> IO ()) -> ([a], Rules a) -> IO ([a], Rules a) getNewLSystem draw (system, rules) = draw system >> putStr "-----\n" >> return (newSystem, rules) where newSystem = evaluateLSystem system rules lSystemLoop :: Show a => Int -> Int -> ([a] -> IO ()) -> ([a], Rules a) -> IO () lSystemLoop iter maxIter draw (system, rules) | iter < maxIter = let newSystem = (getNewLSystem draw (system, rules)) in newSystem >>= lSystemLoop (iter + 1) maxIter draw | otherwise = return ()
draw is a function which prints the system to standard output. This is simple for the algae system, because it just prints the system as a string:
drawAlgaeSystem :: [Char] -> IO () drawAlgaeSystem system = putStrLn system
The rules function for the algae system uses pattern matching to specify what to produce for each symbol:
--Lindenmayer's original Algae L-System algaeRules :: Char -> [Char] algaeRules 'A' = "AB" algaeRules 'B' = "A" algaeRules x = [x] --Any other symbol is just copied
The main function for this L-System is as follows:
main = lSystemLoop 0 10 drawAlgaeSystem ("A", Rules algaeRules)
That’s all you need to express an L-System in Haskell! Apart from I/O, there’s not much more than the actual specification of the L-System.
Making pretty pictures
That’s all you need for algae, but what about drawing larger plants?
In order to keep this simple, instead of using a vector graphics package in Haskell, I’m going to draw the L-System trees by generating Logo code and printing it out using the IO monad! The logo code can be input into a Logo renderer and you can watch the turtle trace out a fractal tree (http://www.calormen.com/jslogo/).
Logo is very simple, you can learn how it works in a few minutes and start drawing with it very quickly. The basic idea is that there is a turtle which can move around a scene in straight lines and it leaves a trail behind wherever it walked.
My first experience programming years and years ago was using a Logo-like system called the PIP robot.
The tricky part about Logo is that it isn’t a stack machine, so you can’t push and pop the position of the turtle. You can’t even get the absolute position of the turtle in Logo! This is a problem because the L-System standard for drawing trees expects that you can push and pop locations. Instead of relying on push/pop location, I manage the state in Haskell using a list as a stack.
Let’s look at how to draw a binary tree like this:
First we need to define the binary rules according to the L-System:
- variables : 0, 1
- constants: [, ]
- axiom : 0
- rules : (1 → 11), (0 → 10)
The binary rules function is a direct translation of this:
--BinaryTree L-System to Logo code binaryDistance = 1 binaryRules :: Char -> [Char] binaryRules '1' = "11" binaryRules '0' = "10" binaryRules x = [x] --Any other symbol is just copied
binaryDistance here is the distance the turtle should move forward. If we just plug this into the lSystemLoop function, it’ll produce a valid binary tree L-System!
In order to actually draw the binary system, we need to translate the symbols 0, 1, [, and ] into Logo commands. For the binary system, 0 represents moving forward, 1 represents moving forward, [ represents pushing state and turning left by 45 degrees, and ] represents popping state and turning right by 45 degrees.
In other words, ‘0’ becomes “fd 1”, ‘1’ becomes “fd 1”, ‘[‘ becomes “lt 45”, and ‘]’ becomes “rt 45”.
Here’s the code which does this:
drawBinarySymbol :: [Char] -> [Char] -> IO () drawBinarySymbol stack  = return () drawBinarySymbol stack ('0' : system) = putStrLn ("fd " ++ (show binaryDistance)) >> drawBinarySymbol ('0' : stack) system drawBinarySymbol stack ('1' : system) = putStrLn ("fd " ++ (show binaryDistance)) >> drawBinarySymbol ('1' : stack) system drawBinarySymbol stack ('[' : system) = putStrLn "lt 45" >> drawBinarySymbol ('[' : stack) system drawBinarySymbol stack (']' : system) = popBinaryStack stack >>= (\newStack -> putStrLn "rt 45" >> drawBinarySymbol (']' : newStack) system) drawBinarySystem :: [Char] -> IO () drawBinarySystem system = drawBinarySymbol  system
As you can see, the drawBinarySystem and drawBinarySymbol functions call putStrLn with the appropriate Logo commands when they encounter a symbol in the system.
drawBinarySymbol takes a list of Char as the stack, as well as the system. Each symbol is pushed on the stack in the recursive call to drawBinarySymbol after its command is printed. The tricky part here is in the pattern for ‘]’. When this symbol is matched, I need to return the turtle to the location it was at when the previous ‘[‘ symbol was matched.
The way I achieve this is by reversing all moves which were performed since the last ‘[‘ symbol by popping them off the stack in popBinaryStack:
popBinaryStack :: [Char] -> IO [Char] popBinaryStack  = return  popBinaryStack ('0' : stack) = putStrLn ("bk " ++ (show binaryDistance)) >> popBinaryStack stack popBinaryStack ('1' : stack) = putStrLn ("bk " ++ (show binaryDistance)) >> popBinaryStack stack popBinaryStack ('[' : stack) = putStrLn "rt 45" >> return stack popBinaryStack (']' : stack) = putStrLn "lt 45" >> popBinaryStack stack
popBinaryStack reverses the movement of the turtle for each symbol in reverse order until it encounters a ‘[‘ symbol, in which case it evaluates to the new stack, which is used for subsequent calls to drawBinarySymbol.
The process is almost identical for the fractal tree image:
The only difference here is that the rules include symbols + and – explicitly for turning left and right; and X, which does nothing except getting re-written.
The code for this project is available online here: https://github.com/WhatTheFunctional/LSystemHaskell