Compositions 1

Interactive live code powered by KLIPSE !



(ns my.reagent-examples
  (:require
    [clojure.string :as string]
    [reagent.core :as reagent]
[reagent.ratom]))

(enable-console-print!)

(defn comp [& fs]
(with-meta (apply
(fn ([] identity)
  ([f] f)
  ([f g] 
     (fn 
       ([] (f (g)))
       ([x] (f (g x)))
       ([x y] (f (g x y)))
       ([x y z] (f (g x y z)))
       ([x y z & args] (f (apply g x y z args)))))
  ([f g & fs]
(reduce comp (list* f g fs))))
 fs)
    {:is-from comp
:args fs}))

(defn partial [& args]
(with-meta (apply (fn
([f] f)
  ([f arg1]
   (fn
     ([] (f arg1))
     ([x] (f arg1 x))
     ([x y] (f arg1 x y))
     ([x y z] (f arg1 x y z))
     ([x y z & args] (apply f arg1 x y z args))))
  ([f arg1 arg2]
   (fn
     ([] (f arg1 arg2))
     ([x] (f arg1 arg2 x))
     ([x y] (f arg1 arg2 x y))
     ([x y z] (f arg1 arg2 x y z))
     ([x y z & args] (apply f arg1 arg2 x y z args))))
  ([f arg1 arg2 arg3]
   (fn
     ([] (f arg1 arg2 arg3))
     ([x] (f arg1 arg2 arg3 x))
     ([x y] (f arg1 arg2 arg3 x y))
     ([x y z] (f arg1 arg2 arg3 x y z))
     ([x y z & args] (apply f arg1 arg2 arg3 x y z args))))
  ([f arg1 arg2 arg3 & more]
(fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
args)
    {:is-from partial
     :args args}))


(defn mapv [& args]
(with-meta (apply (fn
  ([f coll]
     (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll)
         persistent!))
  ([f c1 c2]
     (into [] (map f c1 c2)))
  ([f c1 c2 c3]
     (into [] (map f c1 c2 c3)))
  ([f c1 c2 c3 & colls]
     (into [] (apply map f c1 c2 c3 colls))))
args)
    {:is-from mapv}))

(defn merged-juxt[fs]
  (with-meta (comp (partial reduce into []) (apply juxt fs))
    {:is-from merged-juxt
     :args fs}))


Building a svg path from a polyline (sequence of [x y] coords):

          (defn svg-polyline[ps]
          (let[[[x0 y0] & ps] ps
          init-point (str "M " x0 ", " y0 " ")
          seg (fn[[x y]] (str "L " x ", " y " "))]
          (reduce #(str %1 (seg %2)) init-point ps)))

          (svg-polyline [[10 10][10 20][20 20]])
Displaying a sequence of polylines

(defn draw-polylines[[w h] pss]
          [:svg {:width w :height h}
          [:path {:stroke "black" :stroke-width 1 :fill "none" :d  (reduce str (map svg-polyline pss))}] ])


    [draw-polylines [300 300] [[[100 100][100 200][200 250]]]]
Adding two vectors (points)

    (defn add [[x0 y0][x1 y1]]
    [(+ x0 x1)(+ y0 y1)])
    (add [100 200] [10 20])
Translating a polyline :

    (map (partial add [100 100]) [[10 20][20 30]])
Drawing a translated polyline

    [draw-polylines [200 200] [ (mapv (partial add [100 50]) [[100 100][100 200][200 250]])]]
Drawing a translated sequence of polylines

    [draw-polylines [400 400] (mapv (partial mapv (partial add [50 50] )) [[[100 100][100 200][200 250]] [[50 50][200 50][200 100]]])]
Abstracting the transformation of a set of polylines with a function returning a function

    (defn make-polylines-transform [f]
    #(mapv (partial mapv f) %))

    [draw-polylines [400 400] ((make-polylines-transform (partial add [100 50])) [[[100 100][100 200][200 250]] [[50 50][200 50][200 100]]])]
Abstracting the transformation of a set of polylines with a function using a higher order function

    (defn make-polylines-transform [f]
    (partial mapv (partial mapv f) ))
    [draw-polylines [400 400] ((make-polylines-transform (partial add [100 50])) [[[100 100][100 200][200 250]] [[50 50][200 50][200 100]]])]
Abstracting the transformation of a set of polylines composing higher order functions : point free

    (def make-polylines-transform (comp (partial partial mapv) (partial partial mapv) ))
    [draw-polylines [400 400] ((make-polylines-transform (partial add [100 50])) [[[100 100][100 200][200 250]] [[50 50][200 50][200 100]]])]
Rotating a vector

(defn sin[x]
  (.sin js/Math x))
(defn cos[x]
          (.cos js/Math x))

(def PI
  (.-PI js/Math))
    (def sqrt #(.sqrt js/Math %))

    (defn rotate [a [x y]]
    (let [c (cos a)
          s (sin a)]
    [(- (* c x) (* s y)) (+ (* s x) (* c y))]))
    (rotate (/ PI 4) [10 20])
Displaying a rotated sequence of polylines

    [draw-polylines [400 400] ((make-polylines-transform (partial rotate (/ PI 4))) [[[100 100][100 200][200 250]][[50 50][200 50][200 100]]])]
Displaying a sequence of polylines transformed by a composition of (points) transformations

    [draw-polylines [400 400] ((make-polylines-transform (comp (partial add [100 100]) (partial rotate (/ PI 4)))) [[[100 100][100 200][200 250]][[50 50][200 50][200 100]]])]
Scaling a vector

    (defn scale [k p]
    (mapv (partial * k) p))
    (scale 2 [10 20])
Displaying a scaled sequence of polylines

    [draw-polylines [200 200] ((make-polylines-transform (partial scale 0.5)) [[[100 100][100 200][200 250]][[50 50][200 50][200 100]]])]
Drawing a scaled and translated version of the given sequence of polylines so as to fit the given dimension

(def -INF (.-NEGATIVE_INFINITY js/Number))
(def INF (.-POSITIVE_INFINITY js/Number))
(def minus (partial scale -1.))

    (defn bounding-box[pss]
    (->> pss (reduce into [])(reduce (fn[[[x-min y-min][x-max y-max]][x y]] [[(min x-min x) (min y-min y)][(max x-max x)(max y-max y)]]) [[INF INF][-INF -INF]])))
      (defn make-fitting-transform[[w h] pss]
      (let[[[x-min y-min][x-max y-max]](bounding-box pss)
      s (min (/ w (- x-max x-min)) (/ h (- y-max y-min)))
      center (scale 0.5  (add [x-min y-min] [x-max y-max]))]
      (comp (partial add [(/ w 2) (/ h 2)]) (partial scale s) (partial add (minus center)))))
      (defn draw-fitted-polylines[wh pss]
      (draw-polylines wh ((make-polylines-transform (make-fitting-transform wh pss)) pss)))
    [draw-fitted-polylines [200 200] ((make-polylines-transform (comp (partial add [100 100]) (partial rotate (/ PI 4)))) [[[10 10][10 20][20 25]][[5 5][20 5][20 10]]])]
Rotating around a given center We see how easy and useful it is to compose functions. As we will do it very often we define a function returning a function transforming points instead of a function taking parameters and a point, function that would be bound to the params with partial to be mapped on the elements a polyline

(defn make-rotate-around [r a]
  (comp (partial add r)(partial rotate a) (partial add (minus r))))
Spirograph return a function that takes an angle for the base arm and returns the polyline of the arms. BAD algorithmic complexity ! -> illustrate the need to switch to matrix transforms

(defn spirograph[rks]
    (fn[a]
    (into [[(- (reduce + (map first rks))) 0]] (first (reduce (fn[[res c][r k]](let[next-c (- c r)]
    [(map (make-rotate-around [next-c 0] (* k a)) (conj res [c 0])) next-c])) ['() 0] (reverse rks))))))
[:div
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[50 1][45 -4]]) (partial * PI (/ 1 256))) (range 512)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[50 1][45 -3.25]]) (partial * PI 4 (/ 1 256))) (range 512)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[1 1][(/ 1. 2) -7]]) (partial * PI  (/ 1 256))) (range 512)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[1  1][(/ 1. 2) 4]]) (partial * PI (/ 1. 256))) (range 512)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[1  1][(/ 1. 2) 4][ (/ 1. 6) 16]]) (partial * PI  (/ 1. 256))) (range 513)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[1  1][(/ 1. 2) 8][ (/ 1. 6) 16]]) (partial * PI  (/ 1. 256))) (range 513)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph [[1  1][(/ 1. 2) 2][(/ 1. 4) 6][ (/ 1. 4) 5]]) (partial * PI  (/ 1. 256))) (range 513)))]]
 ]

(defn spiro-1[n]
  (let[c (/ (condp = n
              10 15
              8 4
              9 10
              20 25
              15)
            200)
       a (/ (+ 1 c) 2)
       b-size (+ 1 (/ (sqrt 2) 2))
       c-size (/ (- 2 (sqrt 2)) 4)
       b-c-ratio (/ b-size c-size)
       b (/ (- 1 a) (+ 1. (/ 1 b-c-ratio)))]
    [[a 1][b (- n)][(/ b b-c-ratio) (* 4 n)]]))

(def spiro-2 (let[m (/ 1 (+ 3 (/ 1 3)))
                  s (/ m 6)][[(+ (* 2 m) s) 1][m -12][s (* 6 12)]]))

[:div
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph (spiro-1 10)) (partial * PI (/ 1 256))) (range 513)))]]
 [draw-fitted-polylines [200 200] [(mapv last (map (comp (spirograph spiro-2) (partial * PI  (/ 1 256))) (range 512)))]]]

(def curves (mapv (fn[[rks n]] (mapv (comp (spirograph rks) (partial * PI (/ n 256))) (range 513)))
                  [[[[50 1][45 -4]] 1]
                   [[[50 1][45 -3.25]] 4]
                   [[[1 1][(/ 1. 2) -7]] 1]
                   [[[1  1][(/ 1. 2) 4]] 1]
                   [[[1  1][(/ 1. 2) 4][ (/ 1. 6) 16]] 1]
                   [[[1  1][(/ 1. 2) 8][ (/ 1. 6) 16]] 1]
                   [[[1  1][(/ 1. 2) 2][(/ 1. 4) 6][ (/ 1. 4) 5]] 1]
                   [(spiro-1 10) 1]
                   [spiro-2 1]]))

(def wh [120 120])
(def fitting-transforms (mapv (comp make-polylines-transform (partial make-fitting-transform wh) vector (partial mapv last)) curves)) 
(defn arm+curve[pps n] [(nth pps n) (mapv last (take n pps))])
(def spirograph-state (reagent.core/atom {:step 200}))
(defn gui-spiro1[]
  (let[step (:step @spirograph-state)]
    [:div 
     [:div [:input {:type "range" :value (:step @spirograph-state) :min 0  :max (* 1 520)  :style {:width "90%"}
                    :on-change (fn[e] (swap! spirograph-state assoc :step (int (js/parseFloat (.-target.value e)))))}]]
     (into [:div]
           (map (fn[i](let[c (nth curves i)]
                        [draw-polylines (map (partial * 1.2) wh) ((nth fitting-transforms i) 
(arm+curve c (:step @spirograph-state)))])) (range (count curves))))]))

TODO project y on (range ) x to get compositions of sin waves Archimedean spirals TODO : better API to take [r-begin a-begin] and [delta-r delta-a ] and return a function of [dt] returning (rotate (+ a-begin (* dt delta-a)) [(+ r-begin (* dt delta-r)) 0]) Better ? a polyline transform that would take a (mapv (partial vector 0)(range n)) to create the "regular" spiral would enable to wrap any polyline. Like unfold-polyline but in reverse.

(defn spiral-arc [[r-begin a-begin][r-end a-end]]
  (let[n 64 ;;should be computed http://www.intmath.com/blog/mathematics/length-of-an-archimedean-spiral-6595 
       between (fn[[begin end] n](fn [i] (+ begin (* i (/ (- end begin) n)))))
       between-r (between [r-begin r-end] n)
       between-a (between [a-begin a-end] n)]
    (map (fn[i] (rotate (between-a i) [(between-r i) 0])) (range (inc n)))))

(defn spiral-flower[[r-begin r-end] n]
  (let[alternate-rs (iterate (fn[[r0 r1]][r1 r0]) [r-begin r-end])
       delta-a (* PI (- 1 (/ 1 n)))]
    (into [] (take (* 2 (int n))(map (fn[[r0 r1][a0 a1]] (spiral-arc [r0 a0] [r1 a1]))
                                      alternate-rs
                                      (partition 2 1 (iterate (partial + delta-a) 0)))))))
[draw-fitted-polylines [200 200]  (spiral-flower [10 50] 7)]
Regular polygons as polylines

    (def TWO_PI (* 2 PI))
    (defn regular-polygon [n]
    (take (inc n)(iterate (partial rotate (/ TWO_PI n)) [1. 0])))
    [draw-fitted-polylines [200 200] (map regular-polygon (range 3 7))]
Polygon in polygon

(defn polygon-in-polygon[k ps]
  (mapv (fn [[p0 p1]](add p0 (scale (- k) (add p0 (minus p1))))) (partition 2 1 (concat ps [(second ps)]))))
[draw-fitted-polylines [200 200] (take 60 (iterate (partial polygon-in-polygon 0.1) (regular-polygon 6)))]
Scaled regular polygons so that their sides are the same length regardless of the nb of sides

    (defn scaled-regular-polygon [n]
    (mapv (partial scale (/ 1 (* 2 (sin (/ PI n))))) (regular-polygon n)))

    [draw-fitted-polylines [200 200] (map scaled-regular-polygon (range 3 7))]
Translated polyline so that point n matches the same point of the reference polyline

(defn polyline-matching-at[ps-ref n ps]
  (mapv (partial add (add (nth ps-ref (mod n (count ps-ref)))(minus (nth ps (mod n (count ps)))))) ps))

(def pss (map scaled-regular-polygon (range 3 7)))
(def pssf (map (partial polyline-matching-at (last pss) 0) pss))

[draw-fitted-polylines [200 200] pssf]
Computing the angle between two vectors

    (def sqrt #(.sqrt js/Math %))
    (def acos #(.acos js/Math %))
    (def asin #(.asin js/Math %))
    (def atan2 #(.atan2 js/Math %1 %2))

    (defn cross-product[[x0 y0][x1 y1]]
    (+  (* x0 x1) (* y0 y1)))
    (defn dot-product [[x0 y0][x1 y1]]
    (+ (* x0 x1) (* y0 y1)))
    (defn magnitude[p]
    (sqrt (cross-product p p))) 
    (defn angle[[xr yr][x y]]
    (- (atan2 y x) (atan2 yr xr)))
    (angle [1 0] [0 1])
Computing the difference of two angles (taking care of the modulo) Transforming a polyline so that given (integral part) point matches and that the angle is proportional to the non integral part.

(defn mod+ [a b]
  (let [r (mod a b)]
    (if (neg? r) (+ b r) r)))
(defn diff-mod[a b m]
  (let [dab (mod+ (- a b) m)
        dba (mod+ (- b a) m)]
  (if (< dab dba)
    (- dab)
    dba))) 
(defn polyline-angling-at[rs f ps]
  (let[n (int (+ f 0.5))
       a-f (* (+ (- f n) 0.5) 1)
       get-pts (fn[xys](map #(nth xys (mod (+ n %) (dec (count xys)))) [-1 0 1]))
       [r-1 r r+1] (get-pts rs)
       [p-1 p p+1] (get-pts ps)
       a+1 (- (angle (add r+1 (minus r)) (add p+1 (minus p))))
       a-1 (- (angle (add r-1 (minus r)) (add p-1 (minus p))))
       a (+ a-1 (* a-f (diff-mod a-1 a+1 TWO_PI)))]
    (mapv (comp (make-rotate-around r a) (partial add (add r (minus p)))) ps)))

(def pss (map scaled-regular-polygon (range 3 12)))
(def pssf (mapv (partial polyline-angling-at (last pss) 1.5) (butlast pss)))

         [draw-fitted-polylines [200 200] (conj pssf (last pss))]
         
GUI controls for the parameters


(def state (reagent.core/atom {:n-sides-min 3 :n-sides-max 10 :step 0.}))

(defn slider [param value min-v max-v]
  [:input {:type "range" :value value :min min-v :max max-v :step (if (= :step param) 0.01 1)
           :style {:width "90%"}
           :on-change (fn [e]
                        (swap! state assoc param (js/parseFloat (.-target.value e)))
                        (let[{:keys [n-sides-min n-sides-max step]} @state]
                          (condp = param
                            :n-sides-min (swap! state assoc :n-sides-max (max n-sides-min n-sides-max))
                            :n-sides-max (swap! state assoc :n-sides-min (min n-sides-min n-sides-max)))))}])

(defn ctrl-component[]
  (let[{:keys [n-sides-min n-sides-max step]} @state ]
    [:div 
     [:div
      "min : " (int n-sides-min) " "
      [slider :n-sides-min n-sides-min 3 n-sides-max]]
     [:div
      "max : " (int n-sides-max) " "
      [slider :n-sides-max n-sides-max n-sides-min 16]]
     [:div
      "step : " step " "
      [slider :step step 0 (* 2 n-sides-max)]]
     ]))
Drawing according to the GUI controls

    (defn poly-component[]
    (let[{:keys [n-sides-min n-sides-max step]} @state
    pss (map scaled-regular-polygon (range n-sides-min (inc n-sides-max)))
    pssf (mapv (partial polyline-angling-at (last pss) step) (butlast pss)) ]
    [draw-fitted-polylines [400 400] (conj pssf (last pss))]
    ))
Unfolding a polyline of two segments

(defn interpolate-angles [f a0 a1]
  (+ a0 (* f (diff-mod a0 a1 TWO_PI))))
(defn unfold-segments[f [p0 p1 p2]]
  (let[mp1 (minus p1)
       a (angle (add p0 mp1) (add p2 mp1))
       da (interpolate-angles f (- PI a) 0)]
    [p0 p1 ((make-rotate-around p1 da) p2)]))


[draw-fitted-polylines [100 100] [(unfold-segments 0.5 [[10 10][10 20] [20 30]])]]
Unfolding a polyline Bad algorithmic complexity ! TODO : make it actually linear (switching to matrix representations of transformations )

(defn make-unfolding-transform[f [p0 p1 p2]]
                               (let[mp1 (minus p1)]	
                                 (make-rotate-around p1 (interpolate-angles f (- PI (angle (add p0 mp1) (add p2 mp1))) 0))))
(defn unfold-polyline[f ps]
  (let[f (min (/ f (dec (count ps))) 1.)
       transforms (reductions comp identity (map (partial make-unfolding-transform f) (partition 3 1 ps)))]
    (into [(first ps)] (map #(%1 %2) transforms (rest ps)))))  
[draw-fitted-polylines [200 200] (map (comp (partial unfold-polyline 5.) scaled-regular-polygon) (range 3 8))]

    (def f 1.5) 
(def pss (map (comp (partial unfold-polyline f) scaled-regular-polygon) (range 3 12)))
(def pssf (mapv (partial polyline-angling-at (last pss) f) (butlast pss)))

         [draw-fitted-polylines [200 200] (conj pssf (last pss))]
         

(defn folding-gui[]
    (let[{:keys [n-sides-min n-sides-max step]} @state ]
    [:div 
     [:div
      "min : " (int n-sides-min) " "
      [slider :n-sides-min n-sides-min 3 n-sides-max]]
     [:div
      "max : " (int n-sides-max) " "
      [slider :n-sides-max n-sides-max n-sides-min 16]]
     [:div
      "step : " step " "
      [slider :step step 0 (* 2 n-sides-max)]]
[:div
    (let[pss (map (comp (partial unfold-polyline step) scaled-regular-polygon) (range n-sides-min n-sides-max))
         pssf (mapv (partial polyline-angling-at (last pss) (max 0 (dec step))) (butlast pss))]

         [draw-fitted-polylines [400 400] (conj pssf (last pss))])]]))
         
Fractals

For now, params are [initial-polylines [step-transformation step-polylines]] Should I instead make a function with 0-arity for initial-polylines and 1-arity for transforming polylines and merging step-polylines ? It would complicate my animation plans I presume …☹


         (defn fractal-step [[step-f step-elts] current-elts]
  (into step-elts (step-f current-elts)))

(defn fractal [[init-elts step-params] details]
  (nth (iterate (partial fractal-step step-params) init-elts) details))

         (defn merged-juxt[fs]
         (comp (partial reduce into [])(apply juxt fs)))
         ;; cf. infra
         (defn merged-juxt[fs]
         (with-meta (comp (partial reduce into []) (apply juxt fs))
         {:is-from merged-juxt
         :args fs}))


(defn sierpinski-params [n]
  (let[step-elt (regular-polygon n)
       make-transform #(make-polylines-transform (comp (partial add %)
                                                       (partial scale (/ 1 (dec n)))))]
  (condp = n
    3 [[]
       [(merged-juxt (for [i [0 1 2]] (make-transform (rotate (+ PI (* i 2 (/ PI 3))) [1. 0.]))))
        [step-elt]]]
    4 [[]
       [(merged-juxt (let [d [-1 0 1]]
                       (for [dx d dy d :when (not= 0 dx dy)]
                         (make-transform (scale (sqrt 2.) [dx dy])))))
        [(map (partial rotate (/ PI 4)) step-elt)]]])))

[draw-fitted-polylines [400 400] (fractal (sierpinski-params 3) 6)]


[draw-fitted-polylines [400 400] (fractal (sierpinski-params 4) 5)]

(defn tree-params [angles]
  (let[branch [0 -1]
       ratio (/ (+ 1 (sqrt 5.)) 2.)]
    [[]
     [(merged-juxt (for [a angles]
                     (make-polylines-transform
                                             (comp (partial add branch)
                                                      (partial scale (/ 1 ratio))
                                                      (partial rotate a)))))
      [[[0. 0] branch]]]]))


[draw-fitted-polylines [400 400] (fractal (tree-params [(/ PI 6)(/ PI -3)]) 8)]

(def koch-params [[[[-0.5 0][0.5 0]]]
                  [(merged-juxt (for [[v a] [[[(/ -1 3) 0] 0]
                                             [[(/ 1 3) 0] 0]
                                             [(rotate (/ PI -3) [(/ 1 6) 0]) (/ PI 3)]
                                             [(rotate (/ PI 3) [(/ -1 6) 0]) (/ PI -3)]]]
                                        (make-polylines-transform (comp (partial add v)
                                                                   (partial rotate a)
                                                                   (partial scale (/ 1 3))))))
                   []]])
[draw-fitted-polylines [400 400] (fractal koch-params 4)]

    ;; hilbert is different because there is only one polyline. We do not transform and merge sequences of polylines but transform and merge polylines (sequences of points). Also, the initial polyline is only one point long.
(def hilbert-transform
    (comp (merged-juxt
            [(comp (partial mapv (comp (partial add [-0.5 0.5]) (partial rotate (/ PI 2)))) reverse)
             (partial mapv (partial add [-0.5 -0.5]))
        	 (partial mapv (partial add [0.5 -0.5]))
             (comp (partial mapv (comp (partial add [0.5 0.5]) (partial rotate (/ PI -2)))) reverse)])
          (partial mapv (partial scale 0.5))))

    [draw-fitted-polylines [400 400] [(nth (iterate hilbert-transform [[0 0]]) 5)]]

    (def hilbert-params [[[[0 0]]] [(partial mapv hilbert-transform) []]])
[draw-fitted-polylines [400 400] (fractal hilbert-params 6)]
TODO morphing between two polylines Re-implementing Koch as polyline transform

    (def koch-transform
    (let [s (partial scale (/ 1 3))]
    (comp (merged-juxt
            [(partial mapv (comp (partial add [(/ -1 3) 0]) s))
    (comp rest (partial mapv (comp (partial add (rotate (/ PI 3) [(/ -1 6) 0])) (partial rotate (/ PI -3)) s)))
    (comp rest (partial mapv (comp (partial add (rotate (/ PI -3) [(/ 1 6) 0])) (partial rotate (/ PI 3)) s)))
    (comp rest (partial mapv (comp (partial add [(/ 1 3) 0]) s)))]))))

    [draw-fitted-polylines [400 400] [(nth (iterate koch-transform [[-0.5 0][0.5 0]]) 2)]]

    (def koch-line-params [[[[-0.5 0] [0.5 0]]] [(partial mapv koch-transform) []]])
[draw-fitted-polylines [400 400] (fractal koch-line-params 6)]

    ;; not sure about order of args : I usually but ref as first because it usually is the most likely to be bound, but not so here
(defn matching-segs-transform[[p-first-dst p-last-dst] [p-first-src p-last-src]]
  (let[v-dst (add p-last-dst (minus p-first-dst))
       v-src (add p-last-src (minus p-first-src))
       a (angle v-src v-dst)
       c-dst (add p-first-dst (scale 0.5 v-dst))
       c-src (add p-first-src (scale 0.5 v-src))]       
    (comp (partial add c-dst)
          (partial rotate  a)
          (partial scale (/ (magnitude v-dst) (magnitude v-src)))
          (partial add (minus c-src))
      )))
[draw-fitted-polylines [400 400] [(mapv (matching-segs-transform (take 2 (drop 2 (regular-polygon 3))) [[-0.5 0][0.5 0]])
    (first (fractal koch-line-params 2)))]]
Now I can easily make "snowflakes", but it leads to consider that fractals parameters could use a "finalizing" function as the one-arg transducing functions. Could also be used for nice tiling of other fractals. But 4 elts in the params would be pushing the use of vectors instead of a dictionary. Maybe I should refactor in a vector of two vectors of two elts : [ [init-polylines step-polylines] [step-transfrom finalizing-transform]]

    ;; not sure if I should only take rest for segs after the first, assuming that the polyline to transform will actually start at p-first-src and ends at p-last-src 
(defn matching-polyline-transform[ps-ref seg-src]
  (merged-juxt  (map #(partial mapv (matching-segs-transform % seg-src)) (partition 2 1 ps-ref))))
    [draw-fitted-polylines [400 400] [((matching-polyline-transform (regular-polygon 3) [[-0.5 0][0.5 0]] )(first (fractal koch-line-params 4)))]]
Happened by accident while playing with code :

(defn rotations [n] (map (comp (partial partial rotate) (partial * (/ (* 2 PI) n))) (range n)))
(defn circling-transform [d s n]
  (merged-juxt (map (fn[r] (make-polylines-transform (comp r (partial rotate (/ PI n))(partial add d) (partial scale s))))
                    (rotations n))))

;; (circling-transform (/ (sqrt 3) 3) 6)
(def hex-in-transform (let[ratio (/ (sqrt 3) 3)](circling-transform [ratio 0] (* 0.5 ratio) 6)))
[draw-fitted-polylines [400 400] (fractal [[(regular-polygon 6)][hex-in-transform [(regular-polygon 6)]]] 4)]
I've heard you liked fractals, so I put some fractals in your fractals. Unfortunately, a large (as in nb of points) initial-elt and/or step-elt is unselessly large at small scales. We could use function as a step-elt taht would take the current detail level.

(defn circling-transform-2 [d s n]
  (merged-juxt (map (fn[r] (make-polylines-transform (comp r (partial rotate (/ PI n))(partial add d) (partial scale s)
                                                           (partial rotate (/ (- PI) n)))))
                    (rotations n))))
(def hex-out-transform (let[ratio (/ (sqrt 3) 6)](circling-transform-2[(* 4 ratio) 0] ratio 6)))
(defn koch-snowflake[d]((matching-polyline-transform (regular-polygon 3) [[-0.5 0][0.5 0]] )(first (fractal koch-line-params d))))
    [draw-fitted-polylines [400 400] (let[k (koch-snowflake 3)](fractal [[k] [hex-out-transform [k]]] 3))]
Tiling

    (defn make-2d-tiling-transforms[[f-dx f-dy][w h]]
    (for[ r (range h)
                       c (range w)]
    (make-polylines-transform (partial add [(f-dx c r)(f-dy c r)]))))
    (def make-2d-tiling (comp merged-juxt make-2d-tiling-transforms))
   

    (defn square-tiling-deltas[radius]
    (let [side (/ radius (sqrt 2))] [(fn[c r](* side c)) (fn[c r](* side r))]))
    (defn v-hexagonal-tiling-deltas[radius]
    (let[[dx dy] (rotate (/ PI -3) [0 radius])]
    [(fn[c r](+ (* 2 c dx) (if (odd? r) dx 0))) (fn[c r](* 3 dy r))]))

    [:div
 [draw-fitted-polylines [400 400] ((make-2d-tiling (square-tiling-deltas 1) [5 5]) [(mapv (partial rotate (/ PI 4))(regular-polygon 4))])] 
[draw-fitted-polylines [400 400] ((make-2d-tiling (v-hexagonal-tiling-deltas 1) [5 5]) [(mapv (partial rotate (/ PI 6))(regular-polygon 6))])]
[draw-fitted-polylines [400 400] ((make-2d-tiling (v-hexagonal-tiling-deltas 50) [5 5])
    (spiral-flower [10 50] 6))]
]

(defn poly-in-poly-tiling[f [w h] n-sides n-polys]
(let[ tiling (if (= n-sides 4) (square-tiling-deltas 2)(v-hexagonal-tiling-deltas 1))]
      ((make-2d-tiling tiling [w h]) ((make-polylines-transform (partial rotate (/ PI n-sides)))
      (take n-polys (iterate (partial polygon-in-polygon f) (regular-polygon n-sides))) ) )))

[:div
      [draw-fitted-polylines [400 400] (poly-in-poly-tiling 0.2 [5 5] 4 30)]
      [draw-fitted-polylines [400 400] (poly-in-poly-tiling 0.2 [5 5] 6 30)]]

(defn changing-poly-in-poly-tiling[f [w h] n-sides ]
  (let[ tiling (if (= n-sides 4) (square-tiling-deltas 2)(v-hexagonal-tiling-deltas 1))]
                 (reduce into [] (map (fn[f pps]((comp f (make-polylines-transform (partial rotate (/ PI n-sides)))) pps))
               (make-2d-tiling-transforms tiling [w h])      
                    (map (fn[n-polys](take (inc n-polys) (iterate (partial polygon-in-polygon f) (regular-polygon n-sides)))
                        ) (range (* w h)))))))

[:div
 [draw-fitted-polylines [400 400](changing-poly-in-poly-tiling 0.2 [5 5] 4 30)]
[draw-fitted-polylines [400 400] (changing-poly-in-poly-tiling 0.1 [7 7] 6 30)]]


(defn changing-poly-in-poly-tiling-f[f [w h] n-sides ]
  (let[ tiling (if (= n-sides 4) (square-tiling-deltas 2)(v-hexagonal-tiling-deltas 1))
        f-wh (f [w h])]
    (reduce into [] (map (fn[f pps]((comp f (make-polylines-transform (partial rotate (/ PI n-sides)))) pps))
                         (make-2d-tiling-transforms tiling [w h])      
                         (map (fn[n-polys](take (f-wh [(mod n-polys w) (quot n-polys w)]) (iterate (partial polygon-in-polygon 0.1) (regular-polygon n-sides)))
                                ) (range (* w h)))))))

(defn radius-f[[w h]]
  (fn[[c r]]
    (let[c-c (- c (/ (dec w) 2))
         c-r (- r (/ (dec h) 2))]
      (int (* (sqrt (+ (* c-c c-c) (* c-r c-r))) 10)))))

(defn next-spiral[[c r]]
  (if (and (> c 0) (or (and (< r 0) (< (- r) c)) (and (>= r 0) (<= r c))))
    [c (dec r)]
    (if (and (< r 0) (or (and (< c 0) (< r c)) (and (>= c 0) (<= c (- r)))))
      [(dec c) r]
      (if (and (<= c 0) (or (and (< r 0) (<= c r)) (and (>= r 0) (<= r (- c)))))
        [c (inc r)]
        [(inc c) r]))))

(defn spiraling-f[[w h]]
  (let [rc->i (reduce conj {} (map vector (take (* 4 w h) (iterate next-spiral [0 0])) (range) ))]
    (fn[[c r]]
      (- (* 0.65 w h) (rc->i [
                   (int (+ (- r (/ (dec h) 2))))
                      (int (- (- c (/ (dec w) 2))))         ]))
      )))
(def tmp (spiraling-f [4 4]))
[:div
 [draw-fitted-polylines [400 400](changing-poly-in-poly-tiling-f spiraling-f [6 6] 4 30)]
 [draw-fitted-polylines [400 400] (changing-poly-in-poly-tiling-f spiraling-f [6 7] 6 30)]]



    [draw-fitted-polylines [400 400] ((make-2d-tiling (square-tiling-deltas 6) [5 5]) (fractal (sierpinski-params 4) 3))] 

    (defn filled-sierpinski-params[k n-in n-sides]
    (let[[init-elt [f step-elt]] (sierpinski-params n-sides)]
    [init-elt [f (take n-in (iterate (partial polygon-in-polygon k) (first step-elt)))]]))
    [draw-fitted-polylines [400 400] ((make-2d-tiling (square-tiling-deltas 4) [5 5]) (fractal (filled-sierpinski-params 0.2 10 4) 3))] 

[draw-fitted-polylines [512 512] ((make-2d-tiling (v-hexagonal-tiling-deltas 1.5) [3 3])
                                  (let[k (koch-snowflake 3)]
                                    (fractal [[k] [hex-out-transform [k]]] 2)))]

    (def memo-fractal (memoize fractal))
    (def fractal-name->params { "hilbert-curve" hilbert-params
                                                      "tree" (tree-params [(/ PI 6) (/ PI -3)])
                                                      "sierp-3" (sierpinski-params 3)
                                                      "sierp-4" (sierpinski-params 4)
      "koch" koch-params
      "koch-line" koch-line-params
      })
(def fractal-state (reagent.core/atom {:params (first (vals fractal-name->params)) :step 0}))
(defn gui-fractals[]
  (let[{:keys [params step]} @fractal-state]
    [:div
     [:div (into [:select {:on-change (fn[e] (swap! fractal-state assoc :params (get fractal-name->params (.-target.value e))))}]
           (mapv (fn[k] [:option {:value k} k]) (keys fractal-name->params)))]
     [:div [:input {:type "range" :value (:step @fractal-state) :min 0 :max 6  :style {:width "90%"}
              :on-change (fn[e] (swap! fractal-state assoc :step (js/parseFloat (.-target.value e))))}]]
     [draw-fitted-polylines [400 400] (memo-fractal params (int step))]]))
TODO fold/unfold hilbert curve and koch-line

    (def fractal-line-name->params { "hilbert-curve" hilbert-params
      "koch-line" koch-line-params
      })
(def fractal-line-unfolding-state (reagent.core/atom {:params (first (vals fractal-line-name->params)) :step 0 :unfolding-step 0}))
(defn gui-fractals-line-unfolding[]
  (let[{:keys [params step unfolding-step]} @fractal-line-unfolding-state]
    [:div
     [:div (into [:select {:on-change (fn[e] (swap! fractal-line-unfolding-state assoc :params (get fractal-line-name->params (.-target.value e))))}]
           (mapv (fn[k] [:option {:value k} k]) (keys fractal-line-name->params)))]
     [:div [:input {:type "range" :value (:step @fractal-line-unfolding-state) :step 1 :min 0 :max 6  :style {:width "90%"}
              :on-change (fn[e] (swap! fractal-line-unfolding-state assoc :step (js/parseFloat (.-target.value e))))}]]
     [:div [:input {:type "range" :value (:unfolding-step @fractal-line-unfolding-state) :step 0.01 :min 0 :max 1  :style {:width "90%"}
              :on-change (fn[e] (swap! fractal-line-unfolding-state assoc :unfolding-step (js/parseFloat (.-target.value e))))}]]
     [draw-fitted-polylines [400 400] (map (fn[ps](unfold-polyline (* unfolding-step (count ps)) ps)) (memo-fractal params step))]]))


(defn sequence-steps [n step-factor]
  (let [p (* n step-factor)]
    (map #(-> (- p %) (min 1) (max 0)) (range n))))

(defn is-from [v]
  (get (meta v) :is-from :default))

(defn get-args [v]
  (:args (meta v)))

(defmulti stepify (fn [s v] (is-from v)))

(defmethod stepify :default [s v]
  v)

(defmethod stepify partial [s p]
  (let [args (get-args p)
        arg0 (first args)]
    (condp = arg0
      add (partial add (scale s (second args)))
      rotate (partial rotate (* (second args) s))
      scale (partial scale (js/Math.pow (second args) s))
      mapv (partial mapv (stepify s (second args)))
      :default (apply p (map (partial stepify s))))))

(defmethod stepify comp [s c]
  (let [args (get-args c)]
    (apply comp (map stepify
                        (reverse (sequence-steps (count args) s))
                        args))))

(defmethod stepify merged-juxt [s c]
  (let [args (get-args c)]
    (merged-juxt (map stepify
                      (sequence-steps (count args) s)
                      args))))


(defmethod stepify :default [s v]
  v)

(defn params-step [s [init-scene [step-fs step-scene]]]
  [init-scene [(stepify s step-fs) step-scene]])

(def EPSILON 0.01)
(defn fractal-with-steps [params details]
  (let [[init-scene step-params] params
        int-d (int details)
        int-fractal (nth (iterate (partial fractal-step step-params) init-scene) int-d)
        fractional-d (- details int-d)]
    (if (<= fractional-d EPSILON)
      int-fractal
      (fractal-step (second (params-step fractional-d params)) int-fractal))))




[draw-fitted-polylines [400 400] (fractal-with-steps (sierpinski-params 3) 1.75)]

    (def memo-fractal-with-steps (memoize fractal-with-steps)) ;; not so sure about a memo with a float arg ! :(
(def fractal-with-steps-state (reagent.core/atom {:params (first (vals fractal-name->params)) :step 0}))
(defn gui-fractals-stepified[]
  (let[{:keys [params step]} @fractal-with-steps-state]
    [:div
     [:div (into [:select {:on-change (fn[e] (swap! fractal-with-steps-state assoc :params (get fractal-name->params (.-target.value e))))}]
           (mapv (fn[k] [:option {:value k} k]) (keys fractal-name->params)))]
     [:div [:input {:type "range" :value (:step @fractal-with-steps-state) :step 0.01 :min 0 :max 6  :style {:width "90%"}
              :on-change (fn[e] (swap! fractal-with-steps-state assoc :step (js/parseFloat (.-target.value e))))}]]
     [draw-fitted-polylines [400 400] (memo-fractal-with-steps params step)]]))

TO BE CONTINUED…