L-Systems, or, What happened to A through K?
I was curious (for like the 100th time in my life) about L-Systems and writing (for like the 10th time, apparently because I can't remember where I put code) a simple implementation of them. I wrote one that has hideous performance in like 10 minutes. Again.
I'd explain what an L-System is, but I don't think Wikipedia will mind if you ask it instead. The only somewhat interesting thing my code does is implement a reasonably generic algebraic inverse algorithm which allows generalized simplification of the generated L-System. You can read the docstrings for that info, there isn't much there. Also, when I say generalized, I mean that your rules and inverses better not need to detect more than one character to trigger a rewrite or annihilate an inverse.
Sigh. I remember when most of the web was actually useful stuff and it was interesting to read. Arcane knowledge was not only available, but generally explained in meaningful and insightful ways. The knowledge is still there, but most of the web these days is just people blogging derivative works from Wikipedia articles, or man pages, or each other, and acting as if the knowledge was discovered by themselves. Lame. I'm totally ignoring, nay, denying, the whole political and social aspects of the web too. I feel a lot better that way and you would too.
Hrm, maybe that is why I hadn't posted in quite some time. This post is just derivative junk too. In fact, I really just wrote it so I could make sure that the blogging software I wrote in 2005 didn't succomb to bitrot.
;; This code is written by Peter Keller (psilord@cs.wisc.edu) and has an MIT
;; License
(defun perform-rewrite (src rules)
"Accept a string SRC which will be rewritten, in a left to right fashion, by
the supplied RULES. Return a string which is the rewrite. The RULES are in the
form of an assoc list: '((#\A . \"AB\") (#\B . \"A\")) and so on."
(let ((rewrite ""))
(dotimes (i (length src))
(setf rewrite
(concatenate
'string rewrite
(let ((rule (cdr (assoc (aref src i) rules
:test #'char=))))
(if rule
rule
(string (aref src i)))))))
rewrite))
(defun remove-variables-from-l-system (src variables)
"Accept a string SRC which contains constants and variables, and
another string VARIABLES, and remove all VARIABLES from the string,
returning a new string. All constants and variables are single
letters."
(let ((rewrite ""))
;; First, we get rid of any variables, leaving only constants.
(loop for i from 0 below (length src) do
(setf rewrite
(let ((current (aref src i)))
(concatenate
'string rewrite
(if (find current variables :test #'char=)
""
(string current))))))
rewrite))
(defun annihilate-inverses-from-l-system (src inverses)
"Some L-Systems have inverses, like - being turn left 90 deg, and + being
turn right 90 deg. So, if you see a -+ in a row, then they cancel. So, take
a string of SRC and an assoc list of INVERSES in the form of
'((#\- . #\+) (#\+ . #\-)) and iterate the L-System until a fixed point is
reached where no more inverses wipe each other out. The return the simplified
string. The inverses are not very intelligent. For example, if - means
turn 90 deg to the left, and + means turn 180 degrees to the right. This system
is not smart enough to know that --+ means no operation. The inverses must be
exact duals of each other."
;; Then we handle inverse annihilation
;; iterate this until no more changes happen on the result.
(let ((rewrite ""))
(loop for i from 0 below (length src) do
(setf rewrite
(let ((current (aref src i)))
(concatenate
'string rewrite
(let ((inverse
(cdr
(find current inverses :test #'char= :key #'car))))
;; If it is an inverse, we peek forward and see if
;; the next character would wipe it out, if so, wipe
;; both out and skip over them.
(if (not inverse)
;; nothing to do, just copy it.
(string current)
;; otherwise, let's check the future
;; character, is it the inverse of the
;; current character?
(if (and (< (1+ i) (length src))
(char= (aref src (+ i 1)) inverse))
;; We found that the inverse will be
;; wiped out by the character next to
;; it, increment i by an additional one
;; to skip over it and return "" to
;; represent that the current character
;; got wiped out by its next character
(progn
(incf i 1)
"")
;; The next character is either the end of
;; the string or doesn't have an inverse
;; that is equal to the current character,
;; so just propagate the current one.
(string current))))))))
rewrite))
(defun simplify-l-system (src variables inverses)
"Simplify the SRC L-System be removing all VARIABLES and annihilating
INVERES. Return the simplified string."
;; First, clean out all of the variables, leaving only constants.
(let ((rewrite (remove-variables-from-l-system src variables)))
;; Then iterate until all inverses have been annihilated.
(let ((donep NIL))
(loop :until donep :do
(let ((next-rewrite
(annihilate-inverses-from-l-system rewrite inverses)))
(setf donep (string= rewrite next-rewrite)
rewrite next-rewrite))))
;; all done!
rewrite))
;; and the final l-system, with simplification
(defun l-system (iterations axiom variables inverses rules
&key simplifyp)
"Given the AXIOM string, a set of VARIABLES, INVERSES, and RULES, iterate
an ITERATIONS number of times to produce the L-System result and then either
simplifiy it or not according to the keyword argument :simplifyp"
(let ((result axiom))
(dotimes (i iterations)
(setf result (perform-rewrite result rules)))
(if simplifyp
(simplify-l-system result variables inverses)
result)))
;; Example: 5th order Hilbert Curve
;; Simplified:
;; (l-system 5 "A" "AB" '((#\- . #\+) (#\+ . #\-)) '((#\A . "-BF+AFA+FB-") (#\B . "+AF-BFB-FA+")) :simplifyp t)
;; "-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+F+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-F-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-F-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+F+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-"
;; Unsimplified:
;; (l-system 5 "A" "AB" '((#\- . #\+) (#\+ . #\-)) '((#\A . "-BF+AFA+FB-") (#\B . "+AF-BFB-FA+")) :simplifyp nil)
;; "-+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+-"
End of Line.