diff options
Diffstat (limited to 'src/unheard/cycles.clj')
| -rw-r--r-- | src/unheard/cycles.clj | 224 |
1 files changed, 104 insertions, 120 deletions
diff --git a/src/unheard/cycles.clj b/src/unheard/cycles.clj index a067142..b73b64a 100644 --- a/src/unheard/cycles.clj +++ b/src/unheard/cycles.clj @@ -40,7 +40,7 @@ (l :a :b :c) with cycle-length 1 => [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]]" [& args] - {:v (vec args) :type :l}) + {:v (vec args), :type :l}) (defn f "Fork combinator: cycles through children sequentially across iterations. @@ -55,7 +55,7 @@ (f :a :b :c) with cycle-length 1 => [[0 1 :a] [1 2 :b] [2 3 :c]]" [& args] - {:v (vec args) :type :f}) + {:v (vec args), :type :f}) (defn p "Parallel combinator: all children occur simultaneously. @@ -69,7 +69,7 @@ (p :a :b :c) with cycle-length 1 => [[0 1 :a] [0 1 :b] [0 1 :c]]" [& args] - {:v (vec args) :type :p}) + {:v (vec args), :type :p}) (defn rate "Rate modifier: scales the speed of a pattern by a given ratio. @@ -85,7 +85,7 @@ (rate 2 (l :a :b)) - runs the list twice as fast (rate 1/2 (f :a :b :c)) - runs the fork at half speed" [ratio node] - {:v node :rate ratio :type :rate}) + {:v node, :rate ratio, :type :rate}) (defn elongate "Elongation modifier: gives an element temporal weight. @@ -100,7 +100,7 @@ (l (elongate 2 :a) :b :c) - :a takes twice as long as :b or :c (l :x (elongate 3 :y) :z) - :y takes 3x as long as :x or :z" [weight node] - {:v node :weight weight :type :elongate}) + {:v node, :weight weight, :type :elongate}) (defn rep "Replication modifier: repeats an element N times, subdividing its time equally. @@ -115,10 +115,9 @@ (l (rep 3 :a) :b) - :a repeats 3x in first half, :b in second half (l :x (rep 2 :y) :z) - :y repeats 2x in middle third" [times node] - {:v node :times times :type :rep}) + {:v node, :times times, :type :rep}) -(defn scalar? [x] - (not (and (map? x) (:type x)))) +(defn scalar? [x] (not (and (map? x) (:type x)))) (defn paste "Paste operator: replaces scalar values in a template pattern with provided values. @@ -146,10 +145,9 @@ (if (scalar? node) (let [replacement (first @values-seq)] (swap! values-seq rest) - (if (nil? replacement) - node - replacement)) - ;; Non-scalar: check if :v is a vector (l, f, p) or single value (rate, elongate, rep) + (if (nil? replacement) node replacement)) + ;; Non-scalar: check if :v is a vector (l, f, p) or single + ;; value (rate, elongate, rep) (let [v (:v node)] (if (vector? v) ;; Combinators with multiple children @@ -162,118 +160,106 @@ "Returns the weight of a node. Elongated nodes have their specified weight, all other nodes have a default weight of 1." [node] - (if (and (map? node) (= :elongate (:type node))) - (:weight node) - 1)) + (if (and (map? node) (= :elongate (:type node))) (:weight node) 1)) -(defn gcd [a b] - (if (zero? b) a (recur b (mod a b)))) +(defn gcd [a b] (if (zero? b) a (recur b (mod a b)))) -(defn lcm [a b] - (/ (* a b) (gcd a b))) +(defn lcm [a b] (/ (* a b) (gcd a b))) -(defn compute-cycle [node] - (cond - (scalar? node) 1 - - (= :f (:type node)) - (let [children (:v node) - n (count children)] - (* n (reduce lcm 1 (map compute-cycle children)))) - - (= :l (:type node)) - (let [children (:v node)] - (reduce lcm 1 (map compute-cycle children))) - - (= :p (:type node)) - (let [children (:v node)] - (reduce lcm 1 (map compute-cycle children))) - - (= :rate (:type node)) - ;; Rate doesn't change the cycle count - it just compresses/expands time - ;; The parent sees the same cycle count as the child - (compute-cycle (:v node)) - - (= :elongate (:type node)) - ;; Elongation doesn't change the cycle count - it just affects time division - ;; The parent sees the same cycle count as the child - (compute-cycle (:v node)) - - (= :rep (:type node)) - ;; Replication doesn't change the cycle count - it just subdivides time - ;; The parent sees the same cycle count as the child - (compute-cycle (:v node)) - - :else - (throw (ex-info "Unknown node type in compute-cycle" - {:node node :type (:type node)})))) - -(defn unfold-node [node start end iteration] +(defn compute-cycle + [node] + (cond (scalar? node) 1 + (= :f (:type node)) (let [children (:v node) + n (count children)] + (* n (reduce lcm 1 (map compute-cycle children)))) + (= :l (:type node)) (let [children (:v node)] + (reduce lcm 1 (map compute-cycle children))) + (= :p (:type node)) (let [children (:v node)] + (reduce lcm 1 (map compute-cycle children))) + (= :rate (:type node)) + ;; Rate doesn't change the cycle count - it just + ;; compresses/expands time. The parent sees the same cycle count + ;; as the child + (compute-cycle (:v node)) + (= :elongate (:type node)) + ;; Elongation doesn't change the cycle count - it just affects + ;; time division. The parent sees the same cycle count as the + ;; child + (compute-cycle (:v node)) + (= :rep (:type node)) + ;; Replication doesn't change the cycle count - it just + ;; subdivides time. The parent sees the same cycle count as the + ;; child + (compute-cycle (:v node)) + :else (throw (ex-info "Unknown node type in compute-cycle" + {:node node, :type (:type node)})))) + +(defn unfold-node + [node start end iteration] (let [duration (- end start)] - (cond - (scalar? node) - [[start end node]] - - (= :l (:type node)) - (let [children (:v node) - weights (map get-weight children) - total-weight (reduce + weights) - weight-offsets (reductions + 0 weights)] - (mapcat (fn [i child weight] - (let [child-start (+ start (* duration (/ (nth weight-offsets i) total-weight))) - child-end (+ start (* duration (/ (nth weight-offsets (inc i)) total-weight)))] - (unfold-node child child-start child-end iteration))) + (cond (scalar? node) [[start end node]] + (= :l (:type node)) + (let [children (:v node) + weights (map get-weight children) + total-weight (reduce + weights) + weight-offsets (reductions + 0 weights)] + (mapcat (fn [i child weight] + (let [child-start (+ start + (* duration + (/ (nth weight-offsets i) + total-weight))) + child-end (+ start + (* duration + (/ (nth weight-offsets (inc i)) + total-weight)))] + (unfold-node child child-start child-end iteration))) (range (count children)) children weights)) - - (= :f (:type node)) - (let [children (:v node) - n (count children) - child-idx (mod iteration n)] - (unfold-node (nth children child-idx) start end (quot iteration n))) - - (= :p (:type node)) - (let [children (:v node)] - (mapcat (fn [child] - (unfold-node child start end iteration)) + (= :f (:type node)) (let [children (:v node) + n (count children) + child-idx (mod iteration n)] + (unfold-node (nth children child-idx) + start + end + (quot iteration n))) + (= :p (:type node)) + (let [children (:v node)] + (mapcat (fn [child] (unfold-node child start end iteration)) children)) - - (= :rate (:type node)) - (let [ratio (:rate node) - child (:v node) - child-base-cycle (compute-cycle child) - ;; rate scales how many times the base pattern repeats - ;; rate 2 means fit 2x cycles in this span - ;; rate 1/2 means fit 0.5x cycles (half a cycle) - num-child-cycles (* ratio child-base-cycle) - child-cycle-duration (/ duration num-child-cycles)] - (mapcat (fn [i] - (unfold-node child - (+ start (* i child-cycle-duration)) - (+ start (* (inc i) child-cycle-duration)) - i)) + (= :rate (:type node)) + (let [ratio (:rate node) + child (:v node) + child-base-cycle (compute-cycle child) + ;; rate scales how many times the base pattern repeats + ;; rate 2 means fit 2x cycles in this span + ;; rate 1/2 means fit 0.5x cycles (half a cycle) + num-child-cycles (* ratio child-base-cycle) + child-cycle-duration (/ duration num-child-cycles)] + (mapcat (fn [i] + (unfold-node child + (+ start (* i child-cycle-duration)) + (+ start (* (inc i) child-cycle-duration)) + i)) (range num-child-cycles))) - - (= :elongate (:type node)) - ;; Elongate just wraps a child - unfold the child with the same time bounds - (unfold-node (:v node) start end iteration) - - (= :rep (:type node)) - ;; Rep subdivides the time span into N equal parts and repeats the child - (let [times (:times node) - child (:v node) - slice-duration (/ duration times)] - (mapcat (fn [i] - (unfold-node child - (+ start (* i slice-duration)) - (+ start (* (inc i) slice-duration)) - iteration)) + (= :elongate (:type node)) + ;; Elongate just wraps a child - unfold the child with the same + ;; time bounds + (unfold-node (:v node) start end iteration) + (= :rep (:type node)) + ;; Rep subdivides the time span into N equal parts and repeats + ;; the child + (let [times (:times node) + child (:v node) + slice-duration (/ duration times)] + (mapcat (fn [i] + (unfold-node child + (+ start (* i slice-duration)) + (+ start (* (inc i) slice-duration)) + iteration)) (range times))) - - :else - (throw (ex-info "Unknown node type in unfold-node" - {:node node :type (:type node)}))))) + :else (throw (ex-info "Unknown node type in unfold-node" + {:node node, :type (:type node)}))))) (defn unfold "Unfolds a pattern tree into concrete time intervals. @@ -303,10 +289,8 @@ => [[0 1 :a] [1 2 :b]]" [cycle-length node] (let [cycle-count (compute-cycle node)] - (vec (mapcat (fn [i] - (unfold-node node - (* i cycle-length) - (* (inc i) cycle-length) - i)) - (range cycle-count))))) + (vec (mapcat + (fn [i] + (unfold-node node (* i cycle-length) (* (inc i) cycle-length) i)) + (range cycle-count))))) |
