Clojure L-systems Procedural generation

Improving generated Lindenmeyer rules

In the previous post I randomly generated some Lindenmeyer systems, but only about a third of seeds I tried generating something other than a line or squares. Others were somewhat chaotic, without the pleasing regularity we like to see in fractals. Rather than generating L-system definitions purely randomly, let's see if there are higher-order patterns in attractive systems.

One idea is to look at how steps follow each other in expansion rules. Here's a function to collect that info from an L-system rule:

(defn successors [rule]
  {:start (first rule)
   :successors (reduce
                 (fn [res [a b]]
                   (update res a (fnil conj []) b))
                 {}
                 (partition 2 1 rule))})

Let's check for higher-order patterns in the simpler of the L-systems we've seen so far, the Koch snowflake and Koch curve:

(koch-snowflake :rules)

{F [F + F - - F + F]}

(successors (get (koch-snowflake :rules) 'F))

{:start F, :successors {F [+ - +], + [F F], - [- F]}}

(koch-curve :rules)

{F [F + F - F - F F + F + F - F]}

(successors (get (koch-curve :rules) 'F))

{:start F, :successors {F [+ - - F + + -], + [F F F], - [F F F]}}

The symmetry of the original rules does seem to show up, possibly in a way we can generate. The successors of + and - are brief sequences of mostly F, while the sequence of successors of F suggests a mirror pattern, in which the end of the sequence either mirrors the beginning, or it mirrors the beginning and inverts the turns. Here are two functions to do just that:

(defn mirror [steps]
  (concat steps (rest (reverse steps))))

(defn mirror-and-invert [steps]
  (concat steps (map #(get '{+ -, - +} % %) (rest (reverse steps)))))

To keep generated sequences from terminating prematurely, we'll generate a successor for each + and - in the successors of F:

(defn successors-length [steps step]
  (count (filter #{step} steps)))

Now we can generate successors:

(defn generate-successors [rng]
  (let [successors-f (repeatedly (rng-rand-int rng 3 5) #(rng-rand-nth rng '[F + -]))
        op (rng-rand-nth rng [mirror mirror-and-invert])
        f (op successors-f)]
    {:start 'F
     :successors {'F f
                  '- (repeatedly (successors-length f '-)
                                 #(rng-rand-nth rng '[F F F -]))
                  '+ (repeatedly (successors-length f '+)
                                 #(rng-rand-nth rng '[F F F +]))}}))

A couple things to notice: first, experimentation suggests favoring F to follow + and -; secondly, there's no point in following + with - or vice versa.

To draw a generated system, we'll need to convert this "successors encoding" into an L-system definition:

(defn successors->rule [{:keys [start successors]}]
  (loop [step start
         expansion [start]
         successors successors]
    (if-let [step' (first (successors step))]
      (recur step'
             (conj expansion step')
             (update successors step rest))
      expansion)))

(generate-successors (java.util.Random. 0))

{:start F, :successors {F (+ - - - + + -), - (F F F -), + (F F F)}}

(successors->rule (generate-successors (java.util.Random. 0)))

[F + F - F - F - - F + F + F -]

Looks promising. Let's see what the first handful of seeds generate:

Several randomly generated L-systems.

Not all winners, but better than one-in-three.

To improve variety, we can pick different angles:

(defn machine->system-2 [i]
  (let [rng (java.util.Random. i)
        angle (rng-rand-nth rng [30 45 60 90 120 135])]
    {:axiom '[F]
     :rules {'F (successors->rule (generate-successors rng))}
     :moves {'+ [:turn angle]
             '- [:turn angle]
             'F [:forward 1]}}))

Several randomly generated L-systems with more than right-angle turns.

There's a myriad of avenues for further exploration, including two-rule systems, systems that step forward by different distances, systems with more than one turn angle, and combinations of all three. Unfortunately, random generation seems to produce almost exclusively self-intersecting designs, rather than elegant space-filling curves. If we want something like a Hilbert curve or a hexagonal gosper, we probably need to hand-craft it, though some of the random drawings here could serve as inspiration for new designs.

January 2022