diff options
| -rw-r--r-- | src/unheard/cycles.clj | 111 | ||||
| -rw-r--r-- | test/unheard/cycles_test.clj | 65 |
2 files changed, 176 insertions, 0 deletions
diff --git a/src/unheard/cycles.clj b/src/unheard/cycles.clj new file mode 100644 index 0000000..513b090 --- /dev/null +++ b/src/unheard/cycles.clj @@ -0,0 +1,111 @@ +(ns unheard.cycles) + +(defn l + "List combinator: subdivides time evenly among children, advancing in lockstep. + + Each child receives an equal portion of the parent's time duration. + All children advance synchronously through their patterns. + + Equivalent to TidalCycles/Strudel 'fastcat' operator. + + Example: + (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}) + +(defn f + "Fork combinator: cycles through children sequentially across iterations. + + Each iteration selects one child in round-robin fashion. + The selected child gets the full time duration for that iteration. + Forks extend the total pattern duration by (num-children × child-cycles). + + Equivalent to TidalCycles/Strudel 'slowcat' operator. + + Example: + (f :a :b :c) with cycle-length 1 + => [[0 1 :a] [1 2 :b] [2 3 :c]]" + [& args] + {:v (vec args) :type :f}) + +(defn scalar? [x] + (not (and (map? x) (:type x)))) + +(defn gcd [a b] + (if (zero? b) a (recur b (mod 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))))) + +(defn unfold-node [node start end iteration] + (let [duration (- end start)] + (cond + (scalar? node) + [[start end node]] + + (= :l (:type node)) + (let [children (:v node) + n (count children) + slice-size (/ duration n)] + (mapcat (fn [i child] + (let [child-start (+ start (* i slice-size)) + child-end (+ start (* (inc i) slice-size))] + (unfold-node child child-start child-end iteration))) + (range n) + children)) + + (= :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)))))) + +(defn unfold + "Unfolds a pattern tree into concrete time intervals. + + Takes a cycle-length and a pattern node (scalar, list, or fork), + and returns a vector of [start end value] intervals representing + when each scalar value is active. + + Args: + cycle-length - Duration of each iteration (can be any number) + node - Pattern tree built from scalars, (l ...), and (f ...) + + Returns: + Vector of [start end value] tuples, where start and end are rational + numbers representing time positions. + + The total duration of the result is (* cycle-length (compute-cycle node)). + + Examples: + (unfold 1 :a) + => [[0 1 :a]] + + (unfold 1 (l :a :b)) + => [[0 1/2 :a] [1/2 1 :b]] + + (unfold 1 (f :a :b)) + => [[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))))) + diff --git a/test/unheard/cycles_test.clj b/test/unheard/cycles_test.clj new file mode 100644 index 0000000..b912895 --- /dev/null +++ b/test/unheard/cycles_test.clj @@ -0,0 +1,65 @@ +(ns unheard.cycles-test + (:require [clojure.test :refer [deftest is testing]] + [unheard.cycles :refer [l f unfold]])) + +(deftest unfold-tests + (testing "single scalar" + (is (= [[0 1 :a]] + (unfold 1 :a)))) + + (testing "simple list - time subdivision" + (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]] + (unfold 1 (l :a :b :c))))) + + (testing "simple fork - cycles through children" + (is (= [[0 1 :a] + [1 2 :b] + [2 3 :c]] + (unfold 1 (f :a :b :c))))) + + (testing "list with fork - fork gets time slice" + (is (= [[0 1/2 :1] [1/2 1 :2] + [1 3/2 :1] [3/2 2 :3]] + (unfold 1 (l :1 (f :2 :3)))))) + + (testing "fork with list - each child subdivides its cycle" + (is (= [[0 1/2 :a] [1/2 1 :b] + [1 2 :c]] + (unfold 1 (f (l :a :b) :c))))) + + (testing "nested lists" + (is (= [[0 1/2 :a] [1/2 3/4 :b] [3/4 1 :c]] + (unfold 1 (l :a (l :b :c)))))) + + (testing "nested forks" + (is (= [[0 1 :a] + [1 2 :b] + [2 3 :c] + [3 4 :d] + [4 5 :a] + [5 6 :e] + [6 7 :c] + [7 8 :d]] + (unfold 1 (f :a (f :b :e) :c :d))))) + + (testing "complex nested structure from example" + (is (= [[0 1/2 :1] [1/2 3/4 :2] [3/4 1 :9] [1 3/2 :6] [3/2 2 :7] + [2 5/2 :1] [5/2 3 :3] [3 7/2 :6] [7/2 4 :8] + [4 9/2 :1] [9/2 5 :4] [5 11/2 :6] [11/2 6 :7] + [6 13/2 :1] [13/2 27/4 :2] [27/4 7 :9] [7 15/2 :6] [15/2 8 :8] + [8 17/2 :1] [17/2 9 :3] [9 19/2 :6] [19/2 10 :7] + [10 21/2 :1] [21/2 11 :5] [11 23/2 :6] [23/2 12 :8]] + (unfold 2 (l :1 (f (l :2 :9) :3 (f :4 :5)) :6 (f :7 :8)))))) + + (testing "different cycle lengths" + (is (= [[0 1/2 :a] [1/2 1 :b]] + (unfold 1 (l :a :b)))) + (is (= [[0 1 :a] [1 2 :b]] + (unfold 2 (l :a :b)))) + (is (= [[0 5/2 :a] [5/2 5 :b]] + (unfold 5 (l :a :b))))) + + (testing "fork with nested list subdivides correctly" + (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c] + [1 2 :x]] + (unfold 1 (f (l :a :b :c) :x)))))) |