From 8a2edb7aab50d8b443ac5df4fc7ec208ebaff112 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Thu, 1 May 2025 11:45:00 -0600 Subject: [PATCH 01/23] [cs] fix analysis and quick-cs-subsets functions Inversions of the intervals were not being accounted. --- src/erv/constant_structures/brute_force.cljc | 41 +++++++++++++------- src/erv/constant_structures/core.cljc | 27 +++++++++---- 2 files changed, 46 insertions(+), 22 deletions(-) diff --git a/src/erv/constant_structures/brute_force.cljc b/src/erv/constant_structures/brute_force.cljc index 45e457b..a197a7b 100644 --- a/src/erv/constant_structures/brute_force.cljc +++ b/src/erv/constant_structures/brute_force.cljc @@ -2,7 +2,7 @@ "Find constant structures by brute force" (:require [clojure.math.combinatorics :refer [combinations]] - [erv.constant-structures.core :refer [analyze maybe-round]] + [erv.constant-structures.core :refer [analyze maybe-rationalize]] [erv.utils.conversions :as conv] [erv.utils.core :refer [interval]] [erv.utils.ratios :refer [ratios->scale]] @@ -92,7 +92,7 @@ (let [[deg1 deg2] (sort deg-pair) a (:bounded-ratio (nth scale deg1)) b (:bounded-ratio (nth scale deg2))] - (maybe-round (interval a b)))) + (maybe-rationalize (interval a b) 10))) (def ^:private memoized-deg-combinations (memoize (comp #(map sort %) @@ -102,22 +102,35 @@ (def ^:private conj-set (fnil conj #{})) +(defn- invert-interval [interval period] + (* period (/ 1 interval))) + (defn- quick-check-cs? [deg-combinations scale] - (reduce - (fn [data deg-pair] - (let [[deg1 deg2] deg-pair - steps (- deg2 deg1) - interval (get-interval scale deg-pair) - updated-data (update data interval conj-set steps) - interval-steps (updated-data interval)] - (if (> (count interval-steps) 1) - (reduced {}) - updated-data))) - {} - deg-combinations)) + (let [period (-> scale first :bounding-period) + size (count scale)] + (reduce + (fn [data deg-pair] + (let [[deg1 deg2] deg-pair + steps (- deg2 deg1) + interval (get-interval scale deg-pair) + inversion-steps (- size steps) + inversion (invert-interval interval period) + updated-data (-> data + (update interval conj-set steps) + (update inversion conj-set inversion-steps)) + interval-steps (updated-data interval)] + (when (> inversion period) + (timbre/error "Error in calculation, `inversion` cannot be larger than period")) + (if (> (count interval-steps) 1) + (reduced {}) + updated-data))) + {} + deg-combinations))) (defn quick-cs-subsets + "Calculate all CS subset of the given sizes. + FIXME only really works for JI scales." [cs-sizes scale] (eduction (mapcat #(combinations (range (count scale)) %)) diff --git a/src/erv/constant_structures/core.cljc b/src/erv/constant_structures/core.cljc index 540548b..1d72438 100644 --- a/src/erv/constant_structures/core.cljc +++ b/src/erv/constant_structures/core.cljc @@ -13,22 +13,33 @@ (round2 6 n)) :cljs (round2 6 n))) +(defn maybe-rationalize + [n decimals] + #?(:clj (if (rational? n) + n + (rationalize (round2 decimals n))) + ;; TODO implement + :cljs (round2 6 n))) + (defn get-intervals - [note-pair] + [scale-size note-pair] (->> note-pair ((fn [[a b]] - {(maybe-round (interval (:bounded-ratio a) - (:bounded-ratio b))) - {:steps #{(- (:index b) - (:index a))} - :intervals [[a b]]}})))) + (let [period (:bounding-period a) + intvl (maybe-round (interval (:bounded-ratio a) + (:bounded-ratio b))) + inversion (* period (/ 1 intvl))] + {intvl {:steps #{(- (:index b) (:index a))} + :intervals [[a b]]} + inversion {:steps #{(- scale-size (- (:index b) (:index a)))} + :intervals [[b a]]}}))))) (defn analyze [scale] (let [interval-data (->> (combo/combinations (map-indexed #(assoc %2 :index %1) scale) 2) - (map get-intervals) + (map (partial get-intervals (count scale))) (apply merge-with (partial merge-with concat)) (map (fn [[interval data]] {interval (update data :steps (partial into #{}))})) @@ -64,7 +75,7 @@ (:scale (cps/make 2 [11 13 5 7])))) (:constant-structure? (analyze - (:scale (cps/make 2 [1 3 5 7 9])))) + (:scale (cps/make 2 [1 3 5 7])))) (:constant-structure? (analyze (:scale (edo/from-pattern [2 2 1 2 2 2 1])))) #_(:non-cs-intervals (analyze From ffed952394e916afb70e31ec153317628f31e2a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Fri, 2 May 2025 10:46:17 -0600 Subject: [PATCH 02/23] Export new functions --- src/js/export_fn.cljs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/js/export_fn.cljs b/src/js/export_fn.cljs index 6799dba..58d36a9 100644 --- a/src/js/export_fn.cljs +++ b/src/js/export_fn.cljs @@ -3,6 +3,7 @@ [erv.cps.core :as cps] [erv.edo.core :as edo] [erv.mos.mos :as mos] + [erv.scale.core :as scale] [erv.utils.conversions :as conv] [erv.utils.core :as utils])) @@ -11,4 +12,6 @@ :mos {:make (comp clj->js mos/make)} :edo {:fromPattern (comp clj->js edo/from-pattern)} :utils {:rotate (comp clj->js utils/rotate) - :ratioToCents (comp clj->js conv/ratio->cents)}})) + :ratioToCents (comp clj->js conv/ratio->cents) + :freqToMidi (comp clj->js conv/cps->midi)} + :scale {:degToFreq (comp clj->js scale/deg->freq)}})) From 115da79a70c4e283d89614c72354ddeb7bf87367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Fri, 2 May 2025 12:18:06 -0600 Subject: [PATCH 03/23] [npm] Update JS erv exports --- package.json | 5 ++++- src/js/export_fn.cljs | 11 +++++++++-- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/package.json b/package.json index 6cdeb09..3ffc612 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "@diegovdc/erv", - "version": "0.0.8", + "version": "0.0.14", "description": "Calculations and other algorithmic treatments of some of [Erv Wilson's](http://anaphoria.com/wilson.html) music scale theories.", "scripts": { "release:lib": "shadow-cljs release lib; sed -i '' 's/global/globalThis/g' dist/lib.js", @@ -8,6 +8,9 @@ "prepublishOnly": "npm run release:lib" }, "main": "dist/lib.js", + "files": [ + "dist/" + ], "keywords": [ "microtonality", "music theory" diff --git a/src/js/export_fn.cljs b/src/js/export_fn.cljs index 58d36a9..125577c 100644 --- a/src/js/export_fn.cljs +++ b/src/js/export_fn.cljs @@ -5,6 +5,7 @@ [erv.mos.mos :as mos] [erv.scale.core :as scale] [erv.utils.conversions :as conv] + [erv.utils.ratios :as ratios] [erv.utils.core :as utils])) (defn generate-exports [] @@ -13,5 +14,11 @@ :edo {:fromPattern (comp clj->js edo/from-pattern)} :utils {:rotate (comp clj->js utils/rotate) :ratioToCents (comp clj->js conv/ratio->cents) - :freqToMidi (comp clj->js conv/cps->midi)} - :scale {:degToFreq (comp clj->js scale/deg->freq)}})) + :centsToRatio (comp clj->js conv/cents->ratio) + :freqToMidi (comp clj->js conv/cps->midi) + :ratiosToScale (comp clj->js + (fn [period ratios] + (ratios/ratios->scale period (js->clj ratios))))} + :scale {:degToFreq (comp clj->js (fn [scale root degree] + (let [scale* (js->clj scale {:keywordize-keys true})] + (scale/deg->freq scale* root degree))))}})) From aeb4d8d34fddd7fc72281d8dc9d3b278599eff11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Mon, 12 May 2025 20:05:54 -0600 Subject: [PATCH 04/23] Add comment --- src/erv/constant_structures/brute_force.cljc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/erv/constant_structures/brute_force.cljc b/src/erv/constant_structures/brute_force.cljc index a197a7b..7ea3eb8 100644 --- a/src/erv/constant_structures/brute_force.cljc +++ b/src/erv/constant_structures/brute_force.cljc @@ -141,7 +141,9 @@ (when (seq (quick-check-cs? deg-pairs subscale)) (map #(nth scale %) degs-combination))))) cs-sizes)) - +(comment + (require '[clojure.math.combinatorics :as combo]) + (combo/count-combinations (range 31) 22)) (defn take-quick-cs-subsets "Takes n-items after dropping n-items. Takes an `eduction` as returned by `quick-cs-subsets`. NOTE this code is a general solution, but has specific names for documentation purposes. From b88f8c85050331dcaed03e92c81dbe5f268d5b32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 13 May 2025 12:38:29 -0600 Subject: [PATCH 05/23] [scale.utils] add diamond function --- src/erv/utils/scale.clj | 18 +++++++++++++++--- test/erv/utils/scale_test.clj | 36 ++++++++++++++++++++++++++++++++++- 2 files changed, 50 insertions(+), 4 deletions(-) diff --git a/src/erv/utils/scale.clj b/src/erv/utils/scale.clj index 74beafa..cc19a4c 100644 --- a/src/erv/utils/scale.clj +++ b/src/erv/utils/scale.clj @@ -103,15 +103,15 @@ rotation))) (defn cross-set - [period & ratios] - (let [scale (->> ratios + [period & ratio-vecs] + (let [scale (->> ratio-vecs (apply combo/cartesian-product) (map #(apply * %)) flatten (ratios->scale period) dedupe-scale)] {:meta {:scale :cross-set - :sets ratios + :sets ratio-vecs :size (count scale) :period period} :scale scale})) @@ -150,3 +150,15 @@ (reduce (fn [acc n] (conj acc (+ n (or (last acc) 0)))) [0]) (drop-last (if remove-octave? 1 0))))) + +(defn diamond + [period & factors] + (let [scale (->> (combo/cartesian-product factors factors) + (mapv (fn [[a b]] (/ a b))) + (ratios->scale period) + dedupe-scale)] + {:meta {:scale :diamond + :factors factors + :size (count scale) + :period period} + :scale scale})) diff --git a/test/erv/utils/scale_test.clj b/test/erv/utils/scale_test.clj index d77074b..52ad1b9 100644 --- a/test/erv/utils/scale_test.clj +++ b/test/erv/utils/scale_test.clj @@ -3,7 +3,7 @@ [clojure.test :refer [deftest is testing]] [erv.edo.core :as edo] [erv.utils.ratios :refer [ratios->scale]] - [erv.utils.scale :refer [cross-set dedupe-scale degree-stack + [erv.utils.scale :refer [cross-set dedupe-scale degree-stack diamond find-subset-degrees get-degrees rotate-scale scale->stacked-subscale scale-intervals scale-steps->degrees tritriadic]])) @@ -207,3 +207,37 @@ (deftest scale-steps->degrees-test (is (= [0 2 4 5 7 9 11 12] (scale-steps->degrees [2 2 1 2 2 2 1] false)))) + +(deftest diamond-test + (is (= {:meta {:scale :diamond + :factors [1 3 5 7 9] + :period 2 + :size 19} + :scale + [{:bounded-ratio 1 :bounding-period 2 :ratio 1} + {:bounded-ratio 10/9 :bounding-period 2 :ratio 10/9} + {:bounded-ratio 9/8 :bounding-period 2 :ratio 9/8} + {:bounded-ratio 8/7 :bounding-period 2 :ratio 8/7} + {:bounded-ratio 7/6 :bounding-period 2 :ratio 7/6} + {:bounded-ratio 6/5 :bounding-period 2 :ratio 6/5} + {:bounded-ratio 5/4 :bounding-period 2 :ratio 5/4} + {:bounded-ratio 9/7 :bounding-period 2 :ratio 9/7} + {:bounded-ratio 4/3 :bounding-period 2 :ratio 4/3} + {:bounded-ratio 7/5 :bounding-period 2 :ratio 7/5} + {:bounded-ratio 10/7 :bounding-period 2 :ratio 10/7} + {:bounded-ratio 3/2 :bounding-period 2 :ratio 3/2} + {:bounded-ratio 14/9 :bounding-period 2 :ratio 14/9} + {:bounded-ratio 8/5 :bounding-period 2 :ratio 8/5} + {:bounded-ratio 5/3 :bounding-period 2 :ratio 5/3} + {:bounded-ratio 12/7 :bounding-period 2 :ratio 12/7} + {:bounded-ratio 7/4 :bounding-period 2 :ratio 7/4} + {:bounded-ratio 16/9 :bounding-period 2 :ratio 16/9} + {:bounded-ratio 9/5 :bounding-period 2 :ratio 9/5}]} + (diamond 2 1 3 5 7 9))) + + (testing "A `diamond` is a special case of `cross-set`" + (is (= + (map :bounded-ratio (:scale (diamond 2 1 3 5 7 9))) + (map :bounded-ratio (:scale (cross-set 2 + [1 3 5 7 9] + (map #(/ 1 %) [1 3 5 7 9])))))))) From 2c20ff99e755b005681aebc84dea78c1ff106b65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Sun, 10 Aug 2025 19:53:06 -0600 Subject: [PATCH 06/23] Formatting --- src/erv/constant_structures/graphics.cljc | 1 - src/erv/cps/cycles.cljc | 13 +++--------- src/erv/cps/cycles/v2.cljc | 17 +++++++-------- src/erv/cps/similarity.clj | 12 ++++------- src/erv/cps/utils.cljc | 25 ++++++++++------------- src/erv/edo/core.cljc | 9 ++++---- src/erv/meru/scratch/beatings.cljc | 20 ++++++++---------- src/erv/scratch.clj | 1 - test/erv/scale/core_test.clj | 2 -- 9 files changed, 40 insertions(+), 60 deletions(-) diff --git a/src/erv/constant_structures/graphics.cljc b/src/erv/constant_structures/graphics.cljc index 6711336..b9f483a 100644 --- a/src/erv/constant_structures/graphics.cljc +++ b/src/erv/constant_structures/graphics.cljc @@ -83,7 +83,6 @@ (q/arc 0 0 (+ i* (- radius 100)) (+ i* (- radius 100)) start end)))))) ;; Draw a circle at x y with the correct diameter - (defn make-state [scale added-notes] (let [scale+added-notes* (scale+added-notes scale added-notes) diff --git a/src/erv/cps/cycles.cljc b/src/erv/cps/cycles.cljc index 9a66274..956ec57 100644 --- a/src/erv/cps/cycles.cljc +++ b/src/erv/cps/cycles.cljc @@ -2,8 +2,6 @@ (:require [clojure.set :as set] [erv.utils.core :as utils])) - - (defn get-next-nodes [graph cycle] (->> (graph (-> cycle :seq first)) (reduce @@ -33,13 +31,11 @@ :status :open}))) ()))) - (defn update-finder-state [previous-state new-interation-result] (let [{:keys [open closed]} (group-by :status new-interation-result)] {:open open :closed (into (:closed previous-state) closed)})) - (defn init-state [graph] {:open (mapv (fn [node] {:seq (list node) @@ -73,9 +69,8 @@ (if (-> acc :set (contains? cycle*)) acc {:set (apply conj (:set acc) (utils/get-all-rotations cycle*)) - :cycles (conj (:cycles acc) cycle*)} - )) - ) + :cycles (conj (:cycles acc) cycle*)}))) + {:set #{} :cycles []} cycles))))) (comment @@ -152,6 +147,4 @@ {:seq (#{7 5} #{1 3} #{7 1}), :set #{#{7 1} #{7 5} #{1 3}}, :status :open} {:seq (#{7 3} #{1 3} #{7 1}), :set #{#{7 1} #{7 3} #{1 3}}, :status :open} {:seq (#{1 5} #{1 3} #{7 1}), :set #{#{7 1} #{1 5} #{1 3}}, :status :open} - {:seq (#{1 3} #{7 1}), :set #{#{7 1} #{1 3}}, :status :closed})) - - ) + {:seq (#{1 3} #{7 1}), :set #{#{7 1} #{1 3}}, :status :closed}))) diff --git a/src/erv/cps/cycles/v2.cljc b/src/erv/cps/cycles/v2.cljc index db5c13a..3bba02d 100644 --- a/src/erv/cps/cycles/v2.cljc +++ b/src/erv/cps/cycles/v2.cljc @@ -170,12 +170,13 @@ (str/join " - "))) (str/join "\n") (spit "eikosany-harmonic-triad-cycles-of-A.B.C.txt"))) +(comment -(->> hexany - :meta - :cps/factors - (map-indexed - (fn - [i fac] - {fac (str (char (+ 65 i)))})) - (into {})) + (->> hexany + :meta + :cps/factors + (map-indexed + (fn + [i fac] + {fac (str (char (+ 65 i)))})) + (into {}))) diff --git a/src/erv/cps/similarity.clj b/src/erv/cps/similarity.clj index 86a469f..4489e8c 100644 --- a/src/erv/cps/similarity.clj +++ b/src/erv/cps/similarity.clj @@ -8,8 +8,6 @@ [erv.utils.core :as utils] [clojure.string :as str])) - - (defn twelvulate [scale] (map #(-> % (/ 100) float (Math/round) (* 100)) scale)) @@ -42,7 +40,6 @@ 813.6862861351651 933.1290943962624)) - (defn +cents [cps] (assoc cps :cents (->> cps :scale @@ -83,11 +80,10 @@ %1 %2))))) (+euclidean-distance {:cents '(0 204 316 519 702 1018)}) -(sort (map #(-> % (- 182) (mod 1200)) '(0 182 386 498 701 884) )) +(sort (map #(-> % (- 182) (mod 1200)) '(0 182 386 498 701 884))) (defn +gens [factors cps] (assoc cps :factors factors)) - (comment (require '[clojure.math.combinatorics :as combo] ;; '[clojure.data.csv :as csv] @@ -122,9 +118,9 @@ (with-open [writer (io/writer "3oo7-similarity-to-12edo-scales-up-to-23.csv")] (csv/write-csv writer (->> #_cps-sorted-by-euclidean-distance - #_cps-sorted-by-euclidean-distance-up-to-53 - cps-sorted-by-euclidean-distance-up-to-23 - (mapv (juxt :factors :mode :cents :closest-12-edo :euclidean-distance )) + #_cps-sorted-by-euclidean-distance-up-to-53 + cps-sorted-by-euclidean-distance-up-to-23 + (mapv (juxt :factors :mode :cents :closest-12-edo :euclidean-distance)) (mapv (fn [data] (mapv #(cond (= java.lang.Long (type %)) % diff --git a/src/erv/cps/utils.cljc b/src/erv/cps/utils.cljc index 58552f1..b05977c 100644 --- a/src/erv/cps/utils.cljc +++ b/src/erv/cps/utils.cljc @@ -52,8 +52,7 @@ {}))) (comment - (make-degree->note (erv.cps.core/make 2 [1 3 5 7])) - ) + (make-degree->note (erv.cps.core/make 2 [1 3 5 7]))) (defn make-set->degrees-map [{:keys [scale] :as _cps}] @@ -68,7 +67,6 @@ (reduce (fn [m [deg set]] (update m deg (fnil conj #{}) set)) {}))) - (defn- set-d1-intersection? [set1 set2] (= 1 (count (set/difference set1 set2)))) @@ -86,7 +84,7 @@ (map #(set (conj % degree-set))) (filter #(->> (combo/combinations % 2) (map (partial apply set-d1-intersection?)) - (every? true?)) ) + (every? true?))) set))) (comment @@ -94,7 +92,6 @@ 4 0))) - (defn harmonic-set-degrees "Returns a list of harmonic sets (as degrees) for a specific degree of a cps A harmonic set is a set where all notes are connected with any other by all of its factors except one." @@ -104,16 +101,16 @@ (sort (map (comp #(into [] %) sort (partial map set->degrees)) - sets))))= + sets)))) = (comment (= - [#{#{#{7 5} #{3 5} #{7 3}} - #{#{7 5} #{3 5} #{1 5}} - #{#{7 1} #{7 5} #{7 3}} - #{#{7 1} #{7 5} #{1 5}}} + [#{#{#{7 5} #{3 5} #{7 3}} + #{#{7 5} #{3 5} #{1 5}} + #{#{7 1} #{7 5} #{7 3}} + #{#{7 1} #{7 5} #{1 5}}} '((0 1 4) (0 1 5) (0 2 4) (0 2 5))] - (let [cps (erv.cps.core/make 2 [1 3 5 7]) - set-size 3] - [(harmonic-sets cps set-size 0) - (harmonic-set-degrees cps set-size 0)]))) + (let [cps (erv.cps.core/make 2 [1 3 5 7]) + set-size 3] + [(harmonic-sets cps set-size 0) + (harmonic-set-degrees cps set-size 0)]))) diff --git a/src/erv/edo/core.cljc b/src/erv/edo/core.cljc index 6e4c373..b5856df 100644 --- a/src/erv/edo/core.cljc +++ b/src/erv/edo/core.cljc @@ -24,11 +24,11 @@ (def submosi (make-all-submos (mos 6) 5)) (do) (def submos) (-> submosi #_(->> (filter :true-submos?)) - #_ #_ (nth 0) :submos - #_ #_ (nth 1) :mos) + #_#_(nth 0) :submos + #_#_(nth 1) :mos) (demo! (:scale (from-pattern submos)) :note-dur 200 :direction :down) (demo! (:scale (from-pattern [3,5,2,5,3,5,4])) :note-dur 200 :direction :down) - (demo! (:scale (from-pattern[6, 3, 4, 3, 7, 4, 3, 1] 2)) :note-dur 200 :direction :up )) + (demo! (:scale (from-pattern [6, 3, 4, 3, 7, 4, 3, 1] 2)) :note-dur 200 :direction :up)) (defn from-pattern "For use with `mos` patterns or other custom intervalic patterns, i.e. [3 2 3 2 2]" @@ -47,5 +47,4 @@ :bounding-period period}) degrees)}))) - -(from-pattern [ 2, 2, 5, 2, 5, 2, 5, 2, 2, 5, 2, 5, 2, 5, 2, 5]) +(from-pattern [2, 2, 5, 2, 5, 2, 5, 2, 2, 5, 2, 5, 2, 5, 2, 5]) diff --git a/src/erv/meru/scratch/beatings.cljc b/src/erv/meru/scratch/beatings.cljc index b303771..be01e4b 100644 --- a/src/erv/meru/scratch/beatings.cljc +++ b/src/erv/meru/scratch/beatings.cljc @@ -12,13 +12,13 @@ [root ratios] (->> ratios (mapcat - (fn [degree ratio] - (map (fn [i] {:degree degree - :ratio ratio - :partial i - :partial-ratio (* i ratio)}) - (range 1 9))) - (range)) + (fn [degree ratio] + (map (fn [i] {:degree degree + :ratio ratio + :partial i + :partial-ratio (* i ratio)}) + (range 1 9))) + (range)) #_sort (#(combo/combinations % 2)) (remove (fn [[x1 x2]] (= (:ratio x1) (:ratio x2)))) @@ -86,7 +86,7 @@ 7/4 57/32 465/256])) - + (->> metameantone-beatings #_(map :diff-c4) #_(remove zero?) @@ -100,9 +100,7 @@ #_(dedupe) #_(map #(/ % (* 1/16 1/64)))) - (->> metaslendro-beatings #_(map (juxt :diff :diff-c4)) #_(dedupe) - (filter #(->> % :pair (map :ratio) set ((fn [%] (% 1))))) - ) + (filter #(->> % :pair (map :ratio) set ((fn [%] (% 1)))))) diff --git a/src/erv/scratch.clj b/src/erv/scratch.clj index 65f8c4c..776f0b8 100644 --- a/src/erv/scratch.clj +++ b/src/erv/scratch.clj @@ -18,7 +18,6 @@ (if (> n target) n (recur (+ period n))))) ;; inversions of a dekany - (defn simplify-inversion [inversion] (let [common-factors (map (comp frequencies prime-factors) inversion) common-denominator (->> common-factors diff --git a/test/erv/scale/core_test.clj b/test/erv/scale/core_test.clj index 66c41f0..de87142 100755 --- a/test/erv/scale/core_test.clj +++ b/test/erv/scale/core_test.clj @@ -16,7 +16,6 @@ (cps/bound-ratio 2) (cps/maps->data :bounded-ratio))) - (deftest cps-scale-fulfills-the-scale-spec (is (true? (s/valid? :erv.scale.core/scale (hexany :scale))))) @@ -69,7 +68,6 @@ (= [1 3 6 10] (mapv i->d4 [1 2 3 4])))))) - (deftest demo-scale*-test (testing "single period, default base-freq @ 440hz" (is (= '(1925/4 1155/2 2475/4 1485/2 825N 3465/4 1925/2 3465/4 825N 1485/2 2475/4 1155/2 1925/4) From 0a6261a7f343a949e5b611493b979732e53ceea0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Sun, 10 Aug 2025 19:53:18 -0600 Subject: [PATCH 07/23] [deps] update core.async --- deps.edn | 1 + 1 file changed, 1 insertion(+) diff --git a/deps.edn b/deps.edn index 3a3bc78..20d22d7 100755 --- a/deps.edn +++ b/deps.edn @@ -1,6 +1,7 @@ {:paths ["src" "test" "dev"] :deps {org.clojure/clojure {:mvn/version "1.11.1"} org.clojure/clojurescript {:mvn/version "1.11.60"} + org.clojure/core.async {:mvn/version "1.3.618"} com.google.javascript/closure-compiler-unshaded {:mvn/version "v20221102"} org.clojure/math.combinatorics {:mvn/version "0.3.0"} com.taoensso/timbre {:mvn/version "4.10.0"} From 89c6a01e1cd8d8f141801985afd123b960c49a21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Sun, 10 Aug 2025 19:53:36 -0600 Subject: [PATCH 08/23] [deps] add codox --- deps.edn | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/deps.edn b/deps.edn index 20d22d7..2f55b1f 100755 --- a/deps.edn +++ b/deps.edn @@ -14,4 +14,8 @@ :extra-deps {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" :git/sha "dfb30dd"}} :main-opts ["-m" "cognitect.test-runner"] - :exec-fn cognitect.test-runner.api/test}}} + :exec-fn cognitect.test-runner.api/test} + :codox {:extra-deps {codox/codox {:mvn/version "0.10.8"}} + :exec-fn codox.main/generate-docs + :codox {:output-path "codox"} + :exec-args {:source-paths ["src"]}}}} From 5dae55ac7c8e7c8f1a63369d19bf3351d12943a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Sun, 10 Aug 2025 19:53:57 -0600 Subject: [PATCH 09/23] [meru] WIP meru-diagonals --- src/erv/math/pascals_triangle.clj | 12 -------- src/erv/math/pascals_triangle.cljc | 17 +++++++---- src/erv/meru/diagonals.clj | 38 +++++++++++++++++++++++++ test/erv/math/pascals_triangle_test.clj | 18 ++++++++++++ 4 files changed, 67 insertions(+), 18 deletions(-) delete mode 100644 src/erv/math/pascals_triangle.clj create mode 100644 src/erv/meru/diagonals.clj create mode 100644 test/erv/math/pascals_triangle_test.clj diff --git a/src/erv/math/pascals_triangle.clj b/src/erv/math/pascals_triangle.clj deleted file mode 100644 index 99de89a..0000000 --- a/src/erv/math/pascals_triangle.clj +++ /dev/null @@ -1,12 +0,0 @@ -(ns erv.math.pascals-triangle) - -(defn make [size] - (reduce (fn [acc _] - (conj acc - (concat [1] - (mapv #(apply + %) (partition 2 1 (last acc))) - [1]))) - [[]] - (range size))) - -(defn row [n] (last (make n))) diff --git a/src/erv/math/pascals_triangle.cljc b/src/erv/math/pascals_triangle.cljc index 99de89a..7363eda 100644 --- a/src/erv/math/pascals_triangle.cljc +++ b/src/erv/math/pascals_triangle.cljc @@ -1,12 +1,17 @@ (ns erv.math.pascals-triangle) -(defn make [size] +(defn make + [size] (reduce (fn [acc _] - (conj acc - (concat [1] - (mapv #(apply + %) (partition 2 1 (last acc))) - [1]))) - [[]] + (->> (concat [1] + (mapv #(apply + %) (partition 2 1 (last acc))) + [1]) + (into []) + (conj acc))) + [[1]] (range size))) +(comment + (make 10)) + (defn row [n] (last (make n))) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj new file mode 100644 index 0000000..ce5d01c --- /dev/null +++ b/src/erv/meru/diagonals.clj @@ -0,0 +1,38 @@ +(ns erv.meru.diagonals + "Based on: https://www.anaphoria.com/meru.pdf" + (:require + [erv.math.pascals-triangle :as pascals-triangle])) + +(do + ;; TODO page 3 can't be completely generated at the moment. + ;; If x in the diagonal is > 1 then there will be some cells that will never be touched what Erv seems to do is to also start diagonals from there, in the order of the row. The zeros that he adds correspond to missing/placeholder values when the row size is < x. + (defn make + ([diagonal] (make (pascals-triangle/make 30) diagonal)) + ([triangle diagonal] + (let [vec-x (first diagonal) + vec-y (second diagonal) + diagonals (loop [initial-row 0 + coord [0 0] + diagonal [] + diagonals []] + (let [[y* x*] coord + val (-> triangle + (nth y* nil) + (nth x* nil))] + (cond + val (recur + initial-row + [(+ y* vec-y) (+ x* vec-x)] + (conj diagonal val) + diagonals) + (and (not val) + (nth triangle (inc initial-row) nil)) (recur + (inc initial-row) + [(inc initial-row) 0] + [] + (conj diagonals diagonal)) + :else (conj diagonals diagonal))))] + (mapv (partial apply +) diagonals))))) + +(comment + (make [2 -1])) diff --git a/test/erv/math/pascals_triangle_test.clj b/test/erv/math/pascals_triangle_test.clj new file mode 100644 index 0000000..c14053b --- /dev/null +++ b/test/erv/math/pascals_triangle_test.clj @@ -0,0 +1,18 @@ +(ns erv.math.pascals-triangle-test + (:require + [clojure.test :refer [deftest is]] + [erv.math.pascals-triangle :as subject])) + +(deftest make-test + (is (= [[1] + [1 1] + [1 2 1] + [1 3 3 1] + [1 4 6 4 1] + [1 5 10 10 5 1] + [1 6 15 20 15 6 1] + [1 7 21 35 35 21 7 1] + [1 8 28 56 70 56 28 8 1] + [1 9 36 84 126 126 84 36 9 1] + [1 10 45 120 210 252 210 120 45 10 1]] + (subject/make 10)))) From 82878c74fef6beb24cea2a1653c20aadc31616d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Thu, 14 Aug 2025 23:14:51 -0600 Subject: [PATCH 10/23] [meru] WIP diagonals (impl v2. which works as expected) --- src/erv/math/pascals_triangle.cljc | 28 +++++- src/erv/meru/diagonals.clj | 149 ++++++++++++++++++++++++----- 2 files changed, 151 insertions(+), 26 deletions(-) diff --git a/src/erv/math/pascals_triangle.cljc b/src/erv/math/pascals_triangle.cljc index 7363eda..d1f034a 100644 --- a/src/erv/math/pascals_triangle.cljc +++ b/src/erv/math/pascals_triangle.cljc @@ -4,14 +4,38 @@ [size] (reduce (fn [acc _] (->> (concat [1] - (mapv #(apply + %) (partition 2 1 (last acc))) + (mapv #(apply + %) + (into [] (partition 2 1 (last acc)))) [1]) + (map #?(:clj bigint :cljs js/BigInt)) (into []) (conj acc))) [[1]] (range size))) (comment - (make 10)) + (make 100)) (defn row [n] (last (make n))) + +(defn factorial [x] + (apply * (map #?(:clj bigint :cljs js/BigInt) + (range 1 (inc x))))) + +(defn f + "Calculates a point the pascal's triangle based on an `x,y` coordinate. + Taken from Thomas M. Green's Recurrent Sequences and Pascal's Triangle (referred in meruone.pdf)." + [x y] + (/ (factorial (+ x y)) + (* (factorial x) (factorial y)))) + +;; TODO create a Pascal's Triangle implementation that can be seeded, and that returns something that has an interface like `f` above. + +(defn pascal-coordinates + [size] + (->> (range size) + (mapv + (fn [size*] + (->> (range 0 (inc size*)) + (map + (fn [i] [(- size* i) i]))))))) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index ce5d01c..3e376ac 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -3,36 +3,137 @@ (:require [erv.math.pascals-triangle :as pascals-triangle])) +(defn- diagonals-x-roots + "Calculates the row indexes where a diagonal should start so that every member of any row will be part of a diagnonal." + [diagonal-vector] + (let [[vec-x _vec-y] diagonal-vector] + (range 0 vec-x 1))) + +(diagonals-x-roots [3 1]) + (do ;; TODO page 3 can't be completely generated at the moment. ;; If x in the diagonal is > 1 then there will be some cells that will never be touched what Erv seems to do is to also start diagonals from there, in the order of the row. The zeros that he adds correspond to missing/placeholder values when the row size is < x. + (defn make - ([diagonal] (make (pascals-triangle/make 30) diagonal)) - ([triangle diagonal] - (let [vec-x (first diagonal) - vec-y (second diagonal) - diagonals (loop [initial-row 0 - coord [0 0] + "NOTE: The `diagonal-vector` is a trigonometric vector with x,y coordinates. " + ([slope] (make (pascals-triangle/make 30) slope)) + ([triangle slope] + (let [[vec-x vec-y] slope + [x-root & x-roots*] (diagonals-x-roots slope) + diagonals (loop [y-root 0 + [x* y*] [0 x-root] diagonal [] - diagonals []] - (let [[y* x*] coord - val (-> triangle - (nth y* nil) - (nth x* nil))] + diagonals [] + remaining-roots x-roots*] + (let [val (-> triangle (nth y* nil) (nth x* nil))] (cond - val (recur - initial-row - [(+ y* vec-y) (+ x* vec-x)] - (conj diagonal val) - diagonals) + ;; continue with the diagonal + val + (recur y-root + [(+ x* vec-x) (- y* vec-y)] + (conj diagonal val) + diagonals + remaining-roots) + + ;; move to next-x-root (and (not val) - (nth triangle (inc initial-row) nil)) (recur - (inc initial-row) - [(inc initial-row) 0] - [] - (conj diagonals diagonal)) + (seq remaining-roots)) + (let [[next-x-root & remaining-x-roots*] remaining-roots] + (recur y-root + [next-x-root y-root] + [] + (conj diagonals diagonal) + remaining-x-roots*)) + + ;; go to next row + (and (not val) (nth triangle (inc y-root) nil)) + (recur (inc y-root) + [0 (inc y-root)] + [] + (conj diagonals diagonal) + x-roots*) :else (conj diagonals diagonal))))] - (mapv (partial apply +) diagonals))))) + (mapv (partial apply +) diagonals)))) + + (comment) + ;; pg 13, the order of numbers here does not correspond to the Erv's, his ordering is related to the recurrent sequence formula. + (make [2 3])) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; V2 +;; This one really works! +;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- slope->n-increment ;; TODO rename + [{:keys [x _y] :as _slope}] + (/ 1 x)) + +(defn- sum-diagonal + "`inital-val` {:value 0 :slope slope :coords []}" + [initial-val diagonal] + (reduce (fn [acc {:keys [coord]}] + (let [{:keys [x y]} coord + pascal-num (pascals-triangle/f x y)] + (-> acc + (update :coords conj coord) + (update :value + pascal-num)))) + initial-val + diagonal)) + +(defn- diagonal-sums + [diagonals slopes] + (mapv (fn [slope] + (let [initial-val {:value 0 :slope slope :coords []} + diagonal (get diagonals slope)] + (if diagonal + (sum-diagonal initial-val diagonal) + initial-val))) + slopes)) + +(defn- safe-division + ([a b] (safe-division 0 a b)) + ([default-val a b] + (if (zero? a) default-val (double (/ b a))))) + +(defn- convergence-analysis + [diagonals-series] + (->> diagonals-series + (partition 2 1) + ((fn [parts] + (reduce (fn [{:keys [last-10 convergence-index series] :as acc} [a b]] + (let [ratio (safe-division nil (:value a) (:value b))] + (if (and (= 10 (count last-10)) + (apply = last-10)) + (reduced (-> acc + (update :convergence-index - 10) + (assoc :reached-convergence? true))) + (-> acc + (assoc + :series (conj series (assoc b :ratio-vs-previous ratio)) + :last-10 (take 10 (conj last-10 ratio)) + :convergence-index (inc convergence-index)))))) + {:convergence-index -1 + :last-10 () + :series [(first parts)]} + parts))) + (#(dissoc % :last-10)))) + +(do + ;; TODO: maybe make it dynamic so it creates as many rows as necessary instead of having a hardcoded value of 100 + (defn diagonal-sums-data + "Figure out `n` for every point for the linear formula: y = (slope-y/slope-x)*x + n, by iterating over the pascal-triangle as a vector of coordinates." + ([slope] (diagonal-sums-data 100 slope)) + ([triangle-rows-size slope] + (let [n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) + triangle-coords (apply concat (pascals-triangle/pascal-coordinates triangle-rows-size)) + coord->slope (mapv (fn [[x y]] {:coord {:x x :y y} :slope (n x y)}) triangle-coords) + diagonals (group-by :slope coord->slope) + last-n (->> diagonals vec (sort-by first) last first) + n-increment (slope->n-increment slope) + slopes (range 0 (+ last-n n-increment) n-increment) + ;; TODO: allow passing in a custom pascal-triangle + diagonal-sums* (diagonal-sums diagonals slopes)] + (convergence-analysis diagonal-sums*)))) -(comment - (make [2 -1])) + (diagonal-sums-data 100 {:x 4 :y 3})) From 6ccd23c283f4cb5232cc6f6941e7480939e4d776 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 19 Aug 2025 16:42:54 -0600 Subject: [PATCH 11/23] [meru] diagonals small refactoring --- src/erv/math/pascals_triangle.cljc | 37 +++++++++++++++++---------- src/erv/meru/diagonals.clj | 41 ++++++++++++++++++++---------- 2 files changed, 51 insertions(+), 27 deletions(-) diff --git a/src/erv/math/pascals_triangle.cljc b/src/erv/math/pascals_triangle.cljc index d1f034a..e40d958 100644 --- a/src/erv/math/pascals_triangle.cljc +++ b/src/erv/math/pascals_triangle.cljc @@ -1,17 +1,18 @@ (ns erv.math.pascals-triangle) (defn make - [size] - (reduce (fn [acc _] - (->> (concat [1] - (mapv #(apply + %) - (into [] (partition 2 1 (last acc)))) - [1]) - (map #?(:clj bigint :cljs js/BigInt)) - (into []) - (conj acc))) - [[1]] - (range size))) + ([size] (make 1 1 size)) + ([seed-l seed-r size] + (reduce (fn [acc _] + (->> (concat [seed-l] + (mapv #(apply + %) + (into [] (partition 2 1 (last acc)))) + [seed-r]) + (map #?(:clj bigint :cljs js/BigInt)) + (into []) + (conj acc))) + [[seed-r]] ;; seed-r is privileged so that it works well for calculating the meru diagonals (as shown in merutwo.pdf) + (range size)))) (comment (make 100)) @@ -22,10 +23,10 @@ (apply * (map #?(:clj bigint :cljs js/BigInt) (range 1 (inc x))))) -(defn f +(defn default-coord-map "Calculates a point the pascal's triangle based on an `x,y` coordinate. Taken from Thomas M. Green's Recurrent Sequences and Pascal's Triangle (referred in meruone.pdf)." - [x y] + [[x y]] (/ (factorial (+ x y)) (* (factorial x) (factorial y)))) @@ -39,3 +40,13 @@ (->> (range 0 (inc size*)) (map (fn [i] [(- size* i) i]))))))) + +(do + (defn make-coord-map + "Returns a `hash-map` that maps between a pascal coordinate (a [pos-int? pos-int?] vector) and the corresponding pascal-number. Works the same as `default-coord-map` (except for the row `size` constraint) but works for custom seeded pascal triangles. " + [seed-l seed-r size] + (->> (map vector + (apply concat (pascal-coordinates size)) + (apply concat (make seed-l seed-r size))) + (into {}))) + (make-coord-map 1 2 3)) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 3e376ac..aa5b623 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -62,7 +62,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;; ;; V2 -;; This one really works! +;; This one really works!... but some diagonals are truncated (missing points) :( ;;;;;;;;;;;;;;;;;;;;;;;; (defn- slope->n-increment ;; TODO rename @@ -74,7 +74,7 @@ [initial-val diagonal] (reduce (fn [acc {:keys [coord]}] (let [{:keys [x y]} coord - pascal-num (pascals-triangle/f x y)] + pascal-num (pascals-triangle/default-coord-map [x y])] (-> acc (update :coords conj coord) (update :value + pascal-num)))) @@ -115,25 +115,38 @@ :convergence-index (inc convergence-index)))))) {:convergence-index -1 :last-10 () - :series [(first parts)]} + :series [(first (first parts))]} parts))) (#(dissoc % :last-10)))) +(defn make-slope-n->coords + [size slope] + (let [triangle-coords (apply concat (pascals-triangle/pascal-coordinates size)) + n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) ;; y = (slope-y/slope-x)*x + n + ;; Figure out `n` for every point for the linear formula: y = (slope-y/slope-x)*x + n, by iterating over the pascal-triangle as a vector of coordinates. + ] + (->> triangle-coords + (mapv (fn [[x y]] {:coord {:x x :y y} :slope (n x y)})) + (group-by :slope)))) +(make-slope-n->coords 10 {:x 1 :y 1}) (do - ;; TODO: maybe make it dynamic so it creates as many rows as necessary instead of having a hardcoded value of 100 (defn diagonal-sums-data - "Figure out `n` for every point for the linear formula: y = (slope-y/slope-x)*x + n, by iterating over the pascal-triangle as a vector of coordinates." + ;; TODO: maybe make it dynamic so it creates as many rows as necessary instead of having a hardcoded value of 100 ([slope] (diagonal-sums-data 100 slope)) - ([triangle-rows-size slope] - (let [n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) - triangle-coords (apply concat (pascals-triangle/pascal-coordinates triangle-rows-size)) - coord->slope (mapv (fn [[x y]] {:coord {:x x :y y} :slope (n x y)}) triangle-coords) - diagonals (group-by :slope coord->slope) - last-n (->> diagonals vec (sort-by first) last first) + ([size slope] + (let [slope-n->coords (make-slope-n->coords size slope) + last-n (->> slope-n->coords vec (sort-by first) last first) n-increment (slope->n-increment slope) + _ (println "n-increment" n-increment) slopes (range 0 (+ last-n n-increment) n-increment) ;; TODO: allow passing in a custom pascal-triangle - diagonal-sums* (diagonal-sums diagonals slopes)] - (convergence-analysis diagonal-sums*)))) + diagonal-sums* (diagonal-sums slope-n->coords slopes)] + diagonal-sums* + #_(take size) (convergence-analysis diagonal-sums*)))) - (diagonal-sums-data 100 {:x 4 :y 3})) + (->> (diagonal-sums-data 10 {:x 4 :y 3}) + :series + (map (juxt :value :slope :coords)))) +;; if x < y then coords move by -x + y +;; if x < y then coords move by +x - y +;; slope = y From 4994dfe5856c6e10646ac72f6012fda0e779e8c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 19 Aug 2025 23:07:11 -0600 Subject: [PATCH 12/23] [meru] WIP v3 on-demand full diagonals --- src/erv/meru/diagonals.clj | 45 ++++++++++++++++++++++++++++++++++---- 1 file changed, 41 insertions(+), 4 deletions(-) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index aa5b623..bef4721 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -1,6 +1,7 @@ (ns erv.meru.diagonals "Based on: https://www.anaphoria.com/meru.pdf" (:require + [clojure.math :refer [ceil]] [erv.math.pascals-triangle :as pascals-triangle])) (defn- diagonals-x-roots @@ -144,9 +145,45 @@ diagonal-sums* #_(take size) (convergence-analysis diagonal-sums*)))) - (->> (diagonal-sums-data 10 {:x 4 :y 3}) + (->> (diagonal-sums-data 10 {:x 1 :y 2}) :series (map (juxt :value :slope :coords)))) -;; if x < y then coords move by -x + y -;; if x < y then coords move by +x - y -;; slope = y + +;; Problem: +;; Some diagonals are incomplete +;; +;; Ideal solution: +;; Diagonals should be created on demand +;; +;; ;; Sub-problem: +;; ;; It seems impossible to know the order of diagonals +;;;;; But is it really impossible? Perhaps the distance of the slopes can be know... it seems like it... If so, then this would be great. +;; +;; Alternate solution: +;; The incomplete diagonals should either be +;;;; A. Completed - using slope to fully trace their path +;;;; B. Filtered out - removed (by checking missing points in their path) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; v3 generate complete diagonals on demand +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn intish? [n] (= n (int n))) + +;; WIP generate diagonals +(let [i 4 ;; diagonal index + slope {:x 1 :y 2} + n-inc-size 1 + get-n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) ;; y = (slope-y/slope-x)*x + n + + ;; x = (slope-x/slope-y) * (y - n) + get-x (fn [y n] (* -1 (/ (:x slope) (:y slope)) (- y n))) + get-y (fn [x n] (+ n (* x -1 (/ (:y slope) (:x slope))))) + n (* i n-inc-size) + x-at-y0 (get-x 0 n) + x-range (range (-> x-at-y0 int inc))] + (keep (fn [x] (let [y (get-y x n)] + (when (intish? y) {:x x :y y}))) + x-range)) + +;; TODO pascal triangle that generates rows on demand? The idea is to gradually generate diagonals up to either a given number or a convergence pred From d631d1e549bd9c04fa343a3241c3d7d942c9fb9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 19 Aug 2025 23:14:00 -0600 Subject: [PATCH 13/23] [meru] document solution v3 --- src/erv/meru/diagonals.clj | 1 + 1 file changed, 1 insertion(+) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index bef4721..4e26ea8 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -171,6 +171,7 @@ (defn intish? [n] (= n (int n))) ;; WIP generate diagonals +"Given the linear formula `y = (slope-y/slope-x)*x + n`, the algo first calculates the crossing at `x` (when `y` is 0). That gives the range of `x` integer points to check. Given that range use the line formula to find all `y` points that are also integers. When both c and y are integers the coordinate belongs to the pascal diagonal. `i` is the diagonal index and `n-inc-size` is the space between each diagonal." (let [i 4 ;; diagonal index slope {:x 1 :y 2} n-inc-size 1 From 0380811ed218294ab207195e12534b85a4623e4f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Wed, 20 Aug 2025 12:15:57 -0600 Subject: [PATCH 14/23] [meru] v3 working --- src/erv/meru/diagonals.clj | 64 +++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 18 deletions(-) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 4e26ea8..554812c 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -112,9 +112,11 @@ (-> acc (assoc :series (conj series (assoc b :ratio-vs-previous ratio)) + :convergence-ratio ratio :last-10 (take 10 (conj last-10 ratio)) :convergence-index (inc convergence-index)))))) - {:convergence-index -1 + {:convergence-ratio nil + :convergence-index -1 :last-10 () :series [(first (first parts))]} parts))) @@ -170,21 +172,47 @@ (defn intish? [n] (= n (int n))) -;; WIP generate diagonals -"Given the linear formula `y = (slope-y/slope-x)*x + n`, the algo first calculates the crossing at `x` (when `y` is 0). That gives the range of `x` integer points to check. Given that range use the line formula to find all `y` points that are also integers. When both c and y are integers the coordinate belongs to the pascal diagonal. `i` is the diagonal index and `n-inc-size` is the space between each diagonal." -(let [i 4 ;; diagonal index - slope {:x 1 :y 2} - n-inc-size 1 - get-n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) ;; y = (slope-y/slope-x)*x + n - - ;; x = (slope-x/slope-y) * (y - n) - get-x (fn [y n] (* -1 (/ (:x slope) (:y slope)) (- y n))) - get-y (fn [x n] (+ n (* x -1 (/ (:y slope) (:x slope))))) - n (* i n-inc-size) - x-at-y0 (get-x 0 n) - x-range (range (-> x-at-y0 int inc))] - (keep (fn [x] (let [y (get-y x n)] - (when (intish? y) {:x x :y y}))) - x-range)) - +(defn get-x + "x = (slope-x/slope-y) * (y - n) + NOTE: Multiplied by -1 because the line is assumed to be descending." + [y n slope] + (* -1 (/ (:x slope) (:y slope)) (- y n))) + +(defn get-y + "y = (slope-y/slope-x)*x + n + NOTE: Multiplied by -1 because the line is assumed to be descending." + [x n slope] + (+ n (* x -1 (/ (:y slope) (:x slope))))) + +(defn make-diagonal + "Given the linear formula `y = (slope-y/slope-x)*x + n`, the algorithm + first calculates the crossing at `x` (when `y` is 0). This gives the + range of `x` integer points to check. Given that range use the line + formula to find all `y` points that are also integers. + When both `x` and `y` are integers the coordinate belongs to the pascal diagonal. + `n-inc-size` is the space between each diagonal, and the `diagonal-index` serves to calcualte the resulting diagonal given the `n-inc-size`." + [slope n-inc-size diagonal-index] + (let [n (* diagonal-index n-inc-size) + x-at-y0 (get-x 0 n slope) + x-range (range (-> x-at-y0 int inc))] + (keep (fn [x] (let [y (get-y x n slope)] + (when (intish? y) {:x x :y y}))) + x-range))) + +(make-diagonal {:x 1 :y 2} 1 4) ;; TODO pascal triangle that generates rows on demand? The idea is to gradually generate diagonals up to either a given number or a convergence pred + +(do + (defn diagonals + [size slope pascal-coord->number] + (->> (range size) + (map #(make-diagonal slope (slope->n-increment slope) %)) + (map (fn [coords] + {:value (->> coords + (map (fn [{:keys [x y]}] + (pascal-coord->number [x y]))) + (apply +)) + :coords (vec coords)})) + convergence-analysis)) + + (diagonals 200 {:x 3 :y 5} pascals-triangle/default-coord-map)) From cf799e219549d03ccbff3446ecc7a951737d345d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Wed, 20 Aug 2025 12:19:29 -0600 Subject: [PATCH 15/23] [meru] cleanup diagonals file --- src/erv/meru/diagonals.clj | 141 ++----------------------------------- 1 file changed, 5 insertions(+), 136 deletions(-) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 554812c..69d23a4 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -1,97 +1,15 @@ (ns erv.meru.diagonals "Based on: https://www.anaphoria.com/meru.pdf" - (:require - [clojure.math :refer [ceil]] - [erv.math.pascals-triangle :as pascals-triangle])) - -(defn- diagonals-x-roots - "Calculates the row indexes where a diagonal should start so that every member of any row will be part of a diagnonal." - [diagonal-vector] - (let [[vec-x _vec-y] diagonal-vector] - (range 0 vec-x 1))) - -(diagonals-x-roots [3 1]) - -(do - ;; TODO page 3 can't be completely generated at the moment. - ;; If x in the diagonal is > 1 then there will be some cells that will never be touched what Erv seems to do is to also start diagonals from there, in the order of the row. The zeros that he adds correspond to missing/placeholder values when the row size is < x. - - (defn make - "NOTE: The `diagonal-vector` is a trigonometric vector with x,y coordinates. " - ([slope] (make (pascals-triangle/make 30) slope)) - ([triangle slope] - (let [[vec-x vec-y] slope - [x-root & x-roots*] (diagonals-x-roots slope) - diagonals (loop [y-root 0 - [x* y*] [0 x-root] - diagonal [] - diagonals [] - remaining-roots x-roots*] - (let [val (-> triangle (nth y* nil) (nth x* nil))] - (cond - ;; continue with the diagonal - val - (recur y-root - [(+ x* vec-x) (- y* vec-y)] - (conj diagonal val) - diagonals - remaining-roots) - - ;; move to next-x-root - (and (not val) - (seq remaining-roots)) - (let [[next-x-root & remaining-x-roots*] remaining-roots] - (recur y-root - [next-x-root y-root] - [] - (conj diagonals diagonal) - remaining-x-roots*)) - - ;; go to next row - (and (not val) (nth triangle (inc y-root) nil)) - (recur (inc y-root) - [0 (inc y-root)] - [] - (conj diagonals diagonal) - x-roots*) - :else (conj diagonals diagonal))))] - (mapv (partial apply +) diagonals)))) - - (comment) - ;; pg 13, the order of numbers here does not correspond to the Erv's, his ordering is related to the recurrent sequence formula. - (make [2 3])) + (:require [erv.math.pascals-triangle :as pascals-triangle])) ;;;;;;;;;;;;;;;;;;;;;;;; -;; V2 -;; This one really works!... but some diagonals are truncated (missing points) :( -;;;;;;;;;;;;;;;;;;;;;;;; +;; V3 +;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- slope->n-increment ;; TODO rename [{:keys [x _y] :as _slope}] (/ 1 x)) -(defn- sum-diagonal - "`inital-val` {:value 0 :slope slope :coords []}" - [initial-val diagonal] - (reduce (fn [acc {:keys [coord]}] - (let [{:keys [x y]} coord - pascal-num (pascals-triangle/default-coord-map [x y])] - (-> acc - (update :coords conj coord) - (update :value + pascal-num)))) - initial-val - diagonal)) - -(defn- diagonal-sums - [diagonals slopes] - (mapv (fn [slope] - (let [initial-val {:value 0 :slope slope :coords []} - diagonal (get diagonals slope)] - (if diagonal - (sum-diagonal initial-val diagonal) - initial-val))) - slopes)) - (defn- safe-division ([a b] (safe-division 0 a b)) ([default-val a b] @@ -122,54 +40,6 @@ parts))) (#(dissoc % :last-10)))) -(defn make-slope-n->coords - [size slope] - (let [triangle-coords (apply concat (pascals-triangle/pascal-coordinates size)) - n (fn [x y] (+ y (* x (/ (:y slope) (:x slope))))) ;; y = (slope-y/slope-x)*x + n - ;; Figure out `n` for every point for the linear formula: y = (slope-y/slope-x)*x + n, by iterating over the pascal-triangle as a vector of coordinates. - ] - (->> triangle-coords - (mapv (fn [[x y]] {:coord {:x x :y y} :slope (n x y)})) - (group-by :slope)))) -(make-slope-n->coords 10 {:x 1 :y 1}) -(do - (defn diagonal-sums-data - ;; TODO: maybe make it dynamic so it creates as many rows as necessary instead of having a hardcoded value of 100 - ([slope] (diagonal-sums-data 100 slope)) - ([size slope] - (let [slope-n->coords (make-slope-n->coords size slope) - last-n (->> slope-n->coords vec (sort-by first) last first) - n-increment (slope->n-increment slope) - _ (println "n-increment" n-increment) - slopes (range 0 (+ last-n n-increment) n-increment) - ;; TODO: allow passing in a custom pascal-triangle - diagonal-sums* (diagonal-sums slope-n->coords slopes)] - diagonal-sums* - #_(take size) (convergence-analysis diagonal-sums*)))) - - (->> (diagonal-sums-data 10 {:x 1 :y 2}) - :series - (map (juxt :value :slope :coords)))) - -;; Problem: -;; Some diagonals are incomplete -;; -;; Ideal solution: -;; Diagonals should be created on demand -;; -;; ;; Sub-problem: -;; ;; It seems impossible to know the order of diagonals -;;;;; But is it really impossible? Perhaps the distance of the slopes can be know... it seems like it... If so, then this would be great. -;; -;; Alternate solution: -;; The incomplete diagonals should either be -;;;; A. Completed - using slope to fully trace their path -;;;; B. Filtered out - removed (by checking missing points in their path) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; v3 generate complete diagonals on demand -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (defn intish? [n] (= n (int n))) (defn get-x @@ -199,8 +69,7 @@ (when (intish? y) {:x x :y y}))) x-range))) -(make-diagonal {:x 1 :y 2} 1 4) -;; TODO pascal triangle that generates rows on demand? The idea is to gradually generate diagonals up to either a given number or a convergence pred +#_(make-diagonal {:x 1 :y 2} 1 4) (do (defn diagonals @@ -215,4 +84,4 @@ :coords (vec coords)})) convergence-analysis)) - (diagonals 200 {:x 3 :y 5} pascals-triangle/default-coord-map)) + (diagonals 300 {:x 3 :y 5} pascals-triangle/default-coord-map)) From 10d3a6d6fd5fb1077a3a6afc7cc888b309f1fd69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 26 Aug 2025 16:59:31 -0600 Subject: [PATCH 16/23] [meru] add convergence precision functionality --- src/erv/meru/diagonals.clj | 94 ++++++++++++++++++++++++++------------ 1 file changed, 65 insertions(+), 29 deletions(-) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 69d23a4..6a22b02 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -1,6 +1,9 @@ (ns erv.meru.diagonals "Based on: https://www.anaphoria.com/meru.pdf" - (:require [erv.math.pascals-triangle :as pascals-triangle])) + (:require + [erv.math.pascals-triangle :as pascals-triangle] + [erv.utils.core :refer [round2]] + [taoensso.timbre :as timbre])) ;;;;;;;;;;;;;;;;;;;;;;;; ;; V3 @@ -15,30 +18,47 @@ ([default-val a b] (if (zero? a) default-val (double (/ b a))))) +(defn- default-convergence?-fn + [last-10-ratios] + (and (= 10 (count last-10-ratios)) + (apply = last-10-ratios))) + +(defn- decimal-places-convergence?-fn + "Evaluate convergence according to a given number of decimal places in the provided ratios." + [decimal-places last-10-ratios] + (->> last-10-ratios + (map #(if (nil? %) nil (round2 decimal-places %))) + default-convergence?-fn)) + +(decimal-places-convergence?-fn 2 [1.111234 + 1.111235]) + (defn- convergence-analysis - [diagonals-series] - (->> diagonals-series - (partition 2 1) - ((fn [parts] - (reduce (fn [{:keys [last-10 convergence-index series] :as acc} [a b]] - (let [ratio (safe-division nil (:value a) (:value b))] - (if (and (= 10 (count last-10)) - (apply = last-10)) - (reduced (-> acc - (update :convergence-index - 10) - (assoc :reached-convergence? true))) - (-> acc - (assoc - :series (conj series (assoc b :ratio-vs-previous ratio)) - :convergence-ratio ratio - :last-10 (take 10 (conj last-10 ratio)) - :convergence-index (inc convergence-index)))))) - {:convergence-ratio nil - :convergence-index -1 - :last-10 () - :series [(first (first parts))]} - parts))) - (#(dissoc % :last-10)))) + ([diagonals-series] (convergence-analysis default-convergence?-fn diagonals-series)) + ([convergence?-fn diagonals-series] + (->> diagonals-series + (partition 2 1) + ((fn [parts] + (reduce (fn [{:keys [last-10 convergence-index series-data] :as acc} [a b]] + (let [ratio (safe-division nil (:value a) (:value b))] + (if (convergence?-fn last-10) + (reduced (-> acc + (update :convergence-index - 10) + (assoc :reached-convergence? true))) + (-> acc + (assoc + :series-data (conj series-data (assoc b :ratio-vs-previous ratio)) + :convergence-ratio ratio + :last-10 (take 10 (conj last-10 ratio)) + :convergence-index (inc convergence-index)))))) + {:convergence-ratio nil + :convergence-index -1 + :last-10 () + :series-data [(first (first parts))] + :reached-convergence? false} + parts))) + (#(dissoc % :last-10)) + (#(assoc % :series (map :value (:series-data %))))))) (defn intish? [n] (= n (int n))) @@ -71,9 +91,21 @@ #_(make-diagonal {:x 1 :y 2} 1 4) -(do - (defn diagonals - [size slope pascal-coord->number] +(defn diagonals + [{:keys [size slope pascal-coord->number convergence?-fn convergence-precision]}] + (when (and convergence-precision convergence?-fn) + (timbre/warn "Both `convergence?-fn` and `convergence-precision` have been provided. The latter is going to be ignored.")) + (let [convergence?-fn (cond + convergence?-fn convergence?-fn + convergence-precision (partial decimal-places-convergence?-fn convergence-precision) + :else default-convergence?-fn) + update-convergence-data (fn [data] + (assoc data + :convergence-precision convergence-precision + :convergence-ratio-with-precision (if convergence-precision + (round2 convergence-precision + (:convergence-ratio data)) + (:convergence-ratio data))))] (->> (range size) (map #(make-diagonal slope (slope->n-increment slope) %)) (map (fn [coords] @@ -82,6 +114,10 @@ (pascal-coord->number [x y]))) (apply +)) :coords (vec coords)})) - convergence-analysis)) + (convergence-analysis convergence?-fn) + update-convergence-data))) - (diagonals 300 {:x 3 :y 5} pascals-triangle/default-coord-map)) +(diagonals {:size 100 + :slope {:x 3 :y 5} + :convergence-precision 3 + :pascal-coord->number pascals-triangle/default-coord-map}) From dffc9e0996e7684b3660b3978e88c2ba55658529 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Tue, 26 Aug 2025 16:59:38 -0600 Subject: [PATCH 17/23] [meru] add first diagonals test --- src/erv/math/pascals_triangle.cljc | 21 +++++++-------- src/erv/meru/diagonals.clj | 26 +++++++++++++++++- src/erv/mos/v3/core.clj | 3 +-- test/erv/meru/diagonals_test.clj | 43 ++++++++++++++++++++++++++++++ 4 files changed, 78 insertions(+), 15 deletions(-) create mode 100644 test/erv/meru/diagonals_test.clj diff --git a/src/erv/math/pascals_triangle.cljc b/src/erv/math/pascals_triangle.cljc index e40d958..1492a58 100644 --- a/src/erv/math/pascals_triangle.cljc +++ b/src/erv/math/pascals_triangle.cljc @@ -30,9 +30,7 @@ (/ (factorial (+ x y)) (* (factorial x) (factorial y)))) -;; TODO create a Pascal's Triangle implementation that can be seeded, and that returns something that has an interface like `f` above. - -(defn pascal-coordinates +(defn- pascal-coordinates [size] (->> (range size) (mapv @@ -41,12 +39,11 @@ (map (fn [i] [(- size* i) i]))))))) -(do - (defn make-coord-map - "Returns a `hash-map` that maps between a pascal coordinate (a [pos-int? pos-int?] vector) and the corresponding pascal-number. Works the same as `default-coord-map` (except for the row `size` constraint) but works for custom seeded pascal triangles. " - [seed-l seed-r size] - (->> (map vector - (apply concat (pascal-coordinates size)) - (apply concat (make seed-l seed-r size))) - (into {}))) - (make-coord-map 1 2 3)) +(defn make-coord-map + "Returns a `hash-map` that maps between a pascal coordinate (a [pos-int? pos-int?] vector) and the corresponding pascal-number. Works the same as `default-coord-map` (except for the row `size` constraint) but works for custom seeded pascal triangles. " + [seed-l seed-r size] + (with-meta (->> (map vector + (apply concat (pascal-coordinates size)) + (apply concat (make seed-l seed-r size))) + (into {})) + {:triangle-seed {:left seed-l :right seed-r}})) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 6a22b02..3577bf4 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -2,6 +2,7 @@ "Based on: https://www.anaphoria.com/meru.pdf" (:require [erv.math.pascals-triangle :as pascals-triangle] + [erv.mos.v3.core :refer [gen->mos-ratios]] [erv.utils.core :refer [round2]] [taoensso.timbre :as timbre])) @@ -58,7 +59,7 @@ :reached-convergence? false} parts))) (#(dissoc % :last-10)) - (#(assoc % :series (map :value (:series-data %))))))) + (#(assoc % :series (mapv :value (:series-data %))))))) (defn intish? [n] (= n (int n))) @@ -91,6 +92,26 @@ #_(make-diagonal {:x 1 :y 2} 1 4) +(do + ;; TODO move somewhere else (utils or something, but input may be better in some other way). + (defn convergence-mos-data + [convergence-ratio] + (->> (gen->mos-ratios (rationalize convergence-ratio) 2 100) + (map :meta))) + + (defn convergence-mos-data-summary + [convergence-ratio] + (->> convergence-ratio + convergence-mos-data + (map (fn [meta] + (select-keys meta [:size + :mos/pattern.name + :mos/sL-ratio.float + :mos/s.cents + :mos/L.cents]))))) + + (convergence-mos-data-summary 1.618)) + (defn diagonals [{:keys [size slope pascal-coord->number convergence?-fn convergence-precision]}] (when (and convergence-precision convergence?-fn) @@ -101,6 +122,9 @@ :else default-convergence?-fn) update-convergence-data (fn [data] (assoc data + :triangle-seed (if (= pascal-coord->number pascals-triangle/default-coord-map) + {:left 1 :right 1} + (:triangle-seed (meta pascal-coord->number))) :convergence-precision convergence-precision :convergence-ratio-with-precision (if convergence-precision (round2 convergence-precision diff --git a/src/erv/mos/v3/core.clj b/src/erv/mos/v3/core.clj index 3036f63..09b9594 100644 --- a/src/erv/mos/v3/core.clj +++ b/src/erv/mos/v3/core.clj @@ -89,8 +89,7 @@ :meta) #_(comp (partial map :bounded-ratio) :scale) (gen->mos-ratios 11/8 - (rationalize (round2 4 (erv.utils.conversions/cents->ratio 400))) - 50)) + (rationalize (round2 4 (erv.utils.conversions/cents->ratio 400))) 50)) #_(map count (gen->mos 3/2 2 12))) (comment diff --git a/test/erv/meru/diagonals_test.clj b/test/erv/meru/diagonals_test.clj new file mode 100644 index 0000000..8869f54 --- /dev/null +++ b/test/erv/meru/diagonals_test.clj @@ -0,0 +1,43 @@ +(ns erv.meru.diagonals-test + (:require + [clojure.test :refer [deftest is testing]] + [erv.math.pascals-triangle :as pascals-triangle] + [erv.meru.diagonals :as subject])) + +(deftest diagonals-test + (testing "Has a `:series` key" + (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] + (->> (subject/diagonals + {:size 12 + :slope {:x 1 :y 2} + :pascal-coord->number pascals-triangle/default-coord-map}) + :series)))) + (testing "Can work with a custom `pascal-coord->number function (or map)" + (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] + (->> (subject/diagonals + {:size 12 + :slope {:x 1 :y 2} + :pascal-coord->number (pascals-triangle/make-coord-map 1 1 30)}) + :series)))) + (testing "Has a `:convergence-ratio` and a `:convergence-ratio-with-precision` key" + (is (= [1.617977528089888 1.618] + (->> (subject/diagonals + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number pascals-triangle/default-coord-map}) + ((juxt :convergence-ratio :convergence-ratio-with-precision)))))) + (testing "May have a `:triangle-seed` key, specially if `:pascal-coord->number` is `pascals-triangle/default-coord-map` or was created with `pascals-triangle/make-coord-map`." + (is (= {:left 1, :right 1} + (->> (subject/diagonals + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number pascals-triangle/default-coord-map}) + :triangle-seed) + (->> (subject/diagonals + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number (pascals-triangle/make-coord-map 1 1 30)}) + :triangle-seed))))) From 3a878cedbf0cd22b6b91a5a1cec53dd3eae533f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Wed, 10 Sep 2025 14:24:24 -0600 Subject: [PATCH 18/23] [meru] add malli and restructure meru.core --- deps.edn | 1 + src/erv/meru/core.clj | 85 ++----------------------- src/erv/meru/recurrent_series.cljc | 67 +++++++++++++++++++ src/erv/types.cljc | 60 +++++++++++++++++ test/erv/meru/core_test.clj | 2 +- test/erv/meru/recurrent_series_test.clj | 21 ++++++ 6 files changed, 155 insertions(+), 81 deletions(-) create mode 100644 src/erv/meru/recurrent_series.cljc create mode 100644 src/erv/types.cljc create mode 100644 test/erv/meru/recurrent_series_test.clj diff --git a/deps.edn b/deps.edn index 2f55b1f..f143949 100755 --- a/deps.edn +++ b/deps.edn @@ -6,6 +6,7 @@ org.clojure/math.combinatorics {:mvn/version "0.3.0"} com.taoensso/timbre {:mvn/version "4.10.0"} quil/quil {:mvn/version "4.0.0-SNAPSHOT"} + metosin/malli {:mvn/version "0.19.1"} com.gfredericks/exact {:mvn/version "0.1.11"} org.clojure/tools.namespace {:mvn/version "1.3.0"} table/table {:mvn/version "0.5.0"} diff --git a/src/erv/meru/core.clj b/src/erv/meru/core.clj index 61ed3cb..a3a7e69 100644 --- a/src/erv/meru/core.clj +++ b/src/erv/meru/core.clj @@ -1,88 +1,13 @@ (ns erv.meru.core (:require [clojure.math.combinatorics :as combo] [erv.cps.core :refer [within-bounding-period]] - [erv.constant-structures.graphics :as sketch])) + [erv.constant-structures.graphics :as sketch] + [erv.meru.recurrent-series] + [erv.meru.diagonals])) -(defn seq-ratios* [recurrent-seq] - (->> recurrent-seq - (partition 2 1) - (map (fn [[a b]] (/ b a))))) +(def recurrent-series #'erv.meru.recurrent-series/recurrent-series) -(defn seq-ratios [recurrent-seq] - (->> recurrent-seq - (partition 2 1) - (map (fn [[a b]] (double (/ b a)))))) - -(declare converges-at) -(defn converges-at [recurrent-seq & {:keys [ignore-first] - :or {ignore-first 0}}] - (->> recurrent-seq - (drop ignore-first) - seq-ratios - (partition 5 1) - (take-while (fn [ns] (apply not= ns))) - count - (+ ignore-first))) - -(def scale-formulas - {:fibonacci {:i1 1 :i2 2 :f +} - :meta-pelog {:i1 1 :i2 3 :f +} - :meta-slendro {:i1 2 :i2 3 :f +}}) - -(defn recurrent-series - "Creates a recurrent integer sequence and some data associated to it. - Config: - `:seed` A sequence of intergers to start the recurrent sequence. - `:formula` A keyword that should be contained in `scale-formulas`. It automatically provides the arguments below, so can be used in place of these. - In case no `:formula` is used: - `:i1` The lowest index in the formula. - If this is confusing, read below. - `:i2` The next index in the formula. - `:f` The function to apply to these indexes (probably always, it will be +) - - - For example on page 40 of https://anaphoria.com/merufour.pdf there is the Meta-Slendro formula: - Hn-3 + Hn-2 = Hn - TODO this may be mixed up... but the test function with the `:meta-slendro` `:formula` does works.... so review is needed - `:i1` corresponds to 3, taken from Hn-3 - `:i2` corresponds to 2, taken from Hn-2." - [{:keys [seed formula] :as config}] - (let [config* (get scale-formulas formula config) - {:keys [i1 i2 f] :or {f +}} config* - seed* (mapv bigint seed) - _ (when (> i2 (count seed)) - (throw (ex-info "The `seed` size must be equal or greater than `i1`" config*))) - _ (when (>= i1 i2) - (throw (ex-info "`i2` must be greater than `i1`" config*))) - series (loop [seq* seed* - a (first (take-last i1 seed)) - b (first (take-last i2 seed))] - (let [seq** (conj seq* (f a b)) - a* (first (take-last i1 seq**)) - b* (first (take-last i2 seq**))] - (if (apply = (seq-ratios (take-last 6 seq**))) - seq** - (recur seq** a* b*))))] - {:convergence-double (last (seq-ratios series)) - :convergence (last (seq-ratios* series)) - :converges-at (converges-at series) - :series series})) - -(comment - (recurrent-series #_{:seed [1 1 1] - :i1 2 - :i2 3 - :f (fn [a b] (+ a b))} - {:seed [1 1 1] - :formula :meta-slendro})) - -(defn within-period [period seq*] - (let [max* (apply max seq*) - min* (/ max* period)] - (map (fn [n] - (if (> min* n) - (* n (int (Math/ceil (/ min* n)))) - n)) - seq*))) +(def diagonals #'erv.meru.diagonals/diagonals) (comment (do diff --git a/src/erv/meru/recurrent_series.cljc b/src/erv/meru/recurrent_series.cljc new file mode 100644 index 0000000..2da3f7f --- /dev/null +++ b/src/erv/meru/recurrent_series.cljc @@ -0,0 +1,67 @@ +(ns erv.meru.recurrent-series) + +(defn seq-ratios* [recurrent-seq] + (->> recurrent-seq + (partition 2 1) + (map (fn [[a b]] (/ b a))))) + +(defn seq-ratios [recurrent-seq] + (->> recurrent-seq + (partition 2 1) + (map (fn [[a b]] (double (/ b a)))))) + +(declare converges-at) + +(defn converges-at + "Returns the index at which the recurrent-seq converges." + [recurrent-seq & {:keys [ignore-first] + :or {ignore-first 0}}] + (->> recurrent-seq + (drop ignore-first) + seq-ratios + (partition 5 1) + (take-while (fn [ns] (apply not= ns))) + count + (+ ignore-first))) + +(def scale-formulas + {:fibonacci {:i1 1 :i2 2 :f +} + :meta-pelog {:i1 1 :i2 3 :f +} + :meta-slendro {:i1 2 :i2 3 :f +}}) + +(defn recurrent-series + "Creates a recurrent integer sequence and some data associated to it. + Config: + `:seed` A sequence of intergers to start the recurrent sequence. + `:formula` A keyword that should be contained in `scale-formulas`. It automatically provides the arguments below, so can be used in place of these. + In case no `:formula` is used: + `:i1` The lowest index in the formula. - If this is confusing, read below. + `:i2` The next index in the formula. + `:f` The function to apply to these indexes (probably always, it will be +) + + + For example on page 40 of https://anaphoria.com/merufour.pdf there is the Meta-Slendro formula: + Hn-3 + Hn-2 = Hn + `:i1` corresponds to 2, taken from Hn-2 + `:i2` corresponds to 3, taken from Hn-3." + [{:keys [seed formula _i1 _i2 _f] :as config}] + (let [config* (get scale-formulas formula config) + {:keys [i1 i2 f] :or {f +}} config* + seed* (mapv #?(:clj bigint :cljs js/BigInt) seed) + _ (when (> i2 (count seed)) + (throw (ex-info "The `seed` size must be equal or greater than `i1`" config*))) + _ (when (>= i1 i2) + (throw (ex-info "`i2` must be greater than `i1`" config*))) + series (loop [seq* seed* + a (first (take-last i1 seed)) + b (first (take-last i2 seed))] + (let [seq** (conj seq* (f a b)) + a* (first (take-last i1 seq**)) + b* (first (take-last i2 seq**))] + (if (apply = (seq-ratios (take-last 6 seq**))) + seq** + (recur seq** a* b*))))] + {:convergence-double (last (seq-ratios series)) + :convergence (last (seq-ratios* series)) + :convergence-index (converges-at series) + :series series})) diff --git a/src/erv/types.cljc b/src/erv/types.cljc new file mode 100644 index 0000000..165789d --- /dev/null +++ b/src/erv/types.cljc @@ -0,0 +1,60 @@ +(ns erv.types + (:require [malli.core :as m] + [malli.util :as mu])) + +(def Intish + #_{:clj-kondo/ignore [:unresolved-symbol]} + [:or :int [:fn #(instance? clojure.lang.BigInt %)]]) + +(do + (def MeruBaseData + [:map + [:convergence-double double?] + [:convergence-index int?] + [:reached-convergence? :boolean] + [:series [:vector Intish]]]) + + (def MeruDiagonalsData + (mu/merge MeruBaseData + [:map + [:series-data [:vector + [:map + [:value Intish] + [:coords [:vector + [:map + [:x :int] + [:y Intish]]]] + [:ratio-vs-previous {:optional true} [:maybe :double]]]]] + [:triangle-seed [:map [:left :int] [:right :int]]] + [:convergence-precision :int] + [:convergence-ratio-with-precision :double]])) + + (m/explain MeruDiagonalsData + {:convergence-double 2.0, + :convergence-index 18, + :series-data + [{:value 1, :coords [{:x 0, :y 0N}]} + {:value 0, :coords [], :ratio-vs-previous 0.0} + {:value 0, :coords [], :ratio-vs-previous nil} + {:value 1N, :coords [{:x 0, :y 1N}], :ratio-vs-previous nil} + {:value 0, :coords [], :ratio-vs-previous 0.0} + {:value 1N, :coords [{:x 1, :y 0N}], :ratio-vs-previous nil} + {:value 1N, :coords [{:x 0, :y 2N}], :ratio-vs-previous 1.0} + {:value 0, :coords [], :ratio-vs-previous 0.0} + {:value 2N, :coords [{:x 1, :y 1N}], :ratio-vs-previous nil} + {:value 1N, :coords [{:x 0, :y 3N}], :ratio-vs-previous 0.5} + {:value 1N, :coords [{:x 2, :y 0N}], :ratio-vs-previous 1.0} + {:value 3N, :coords [{:x 1, :y 2N}], :ratio-vs-previous 3.0} + {:value 1N, :coords [{:x 0, :y 4N}], :ratio-vs-previous 0.3333333333333333} + {:value 3N, :coords [{:x 2, :y 1N}], :ratio-vs-previous 3.0} + {:value 4N, :coords [{:x 1, :y 3N}], :ratio-vs-previous 1.333333333333333} + {:value 2N, :coords [{:x 0, :y 5N} {:x 3, :y 0N}], :ratio-vs-previous 0.5} + {:value 6N, :coords [{:x 2, :y 2N}], :ratio-vs-previous 3.0} + {:value 5N, :coords [{:x 1, :y 4N}], :ratio-vs-previous 0.8333333333333333} + {:value 5N, :coords [{:x 0, :y 6N} {:x 3, :y 1N}], :ratio-vs-previous 1.0} + {:value 10N, :coords [{:x 2, :y 3N}], :ratio-vs-previous 2.0}], + :reached-convergence? false, + :series [1 0 0 1N 0 1N 1N 0 2N 1N 1N 3N 1N 3N 4N 2N 6N 5N 5N 10N], + :triangle-seed {:left 1, :right 1}, + :convergence-precision 3, + :convergence-ratio-with-precision 2.0})) diff --git a/test/erv/meru/core_test.clj b/test/erv/meru/core_test.clj index 6768a92..45e95d7 100644 --- a/test/erv/meru/core_test.clj +++ b/test/erv/meru/core_test.clj @@ -7,7 +7,7 @@ (let [meta-slendro-series {:convergence-double 1.324717957244746, :convergence 53406819691/40315615410, - :converges-at 84, + :convergence-index 84, :series [1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691]}] (testing "Can use a `:seed` and a `:formula`" (is (= meta-slendro-series diff --git a/test/erv/meru/recurrent_series_test.clj b/test/erv/meru/recurrent_series_test.clj new file mode 100644 index 0000000..e6dcb1f --- /dev/null +++ b/test/erv/meru/recurrent_series_test.clj @@ -0,0 +1,21 @@ +(ns erv.meru.recurrent-series-test + (:require + [clojure.test :refer [deftest is testing]] + [erv.meru.recurrent-series :as subject])) + +(deftest recurrent-series-test + (let [meta-slendro-series + {:convergence-double 1.324717957244746, + :convergence 53406819691/40315615410, + :convergence-index 84, + :series [1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691]}] + (testing "Can use a `:seed` and a `:formula`" + (is (= meta-slendro-series + (subject/recurrent-series {:seed [1 1 1] + :formula :meta-slendro})))) + (testing "Can use a `:seed` and a custom configuration of indexes and an operation for apply the values of the indexes." + (is (= meta-slendro-series + (subject/recurrent-series {:seed [1 1 1] + :i1 2 + :i2 3 + :f (fn [a b] (+ a b))})))))) From 3fd17726628bdf3f21ed820c0cf57a64d24b8ee7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Fri, 12 Sep 2025 21:10:06 -0600 Subject: [PATCH 19/23] [meru] wip clean up meru.core and add utils --- src/erv/meru/core.clj | 161 +++++++++++++++--------- src/erv/meru/diagonals.clj | 40 ++---- src/erv/meru/recurrent_series.cljc | 21 +++- src/erv/meru/utils.cljc | 10 ++ src/erv/types.cljc | 84 +++++-------- src/erv/utils/core.cljc | 24 ++++ src/erv/utils/scale.clj | 42 ++++++- test/erv/meru/core_test.clj | 39 +++--- test/erv/meru/diagonals_test.clj | 25 ++-- test/erv/meru/recurrent_series_test.clj | 43 ++++--- test/erv/utils/core_test.cljc | 7 +- 11 files changed, 308 insertions(+), 188 deletions(-) create mode 100644 src/erv/meru/utils.cljc diff --git a/src/erv/meru/core.clj b/src/erv/meru/core.clj index a3a7e69..8d4f0b0 100644 --- a/src/erv/meru/core.clj +++ b/src/erv/meru/core.clj @@ -1,65 +1,112 @@ (ns erv.meru.core - (:require [clojure.math.combinatorics :as combo] - [erv.cps.core :refer [within-bounding-period]] - [erv.constant-structures.graphics :as sketch] - [erv.meru.recurrent-series] - [erv.meru.diagonals])) + (:require + [clojure.math.combinatorics :as combo] + [erv.cps.core :refer [within-bounding-period]] + [erv.meru.diagonals] + [erv.meru.recurrent-series] + [erv.mos.v3.core :refer [gen->mos-ratios]] + [erv.utils.core :refer [lcm-of-list round2]])) (def recurrent-series #'erv.meru.recurrent-series/recurrent-series) (def diagonals #'erv.meru.diagonals/diagonals) +(diagonals {:size 20 + :slope {:x 1 :y 2}}) + +(defn convergence-mos-data + ([convergence-double] (convergence-mos-data {} convergence-double)) + ([{:keys [period max-size] + :or {period 2 max-size 100}} + convergence-double] + (->> (gen->mos-ratios (rationalize (round2 3 convergence-double)) period max-size) + (map :meta)))) + +(defn convergence-mos-data-summary + ([meru-diagonals-or-series-data] (convergence-mos-data-summary {} meru-diagonals-or-series-data)) + ([{:keys [_period _max-size] :as calc-config} + {:keys [convergence-double] :as _meru-diagonals-or-series-data}] + (->> convergence-double + (convergence-mos-data calc-config) + (map (fn [meta] + (select-keys meta [:size + :mos/pattern.name + :mos/sL-ratio.float + :mos/s.cents + :mos/L.cents])))))) + +(convergence-mos-data-summary (diagonals {:size 20 + + :slope {:x 1 :y 2}})) + +(do + + (defn proportional-chord? + [& ratios] + (let [ratio-analysis (decompose-ratio ratios) + lcm (lcm-of-list (mapv :denom ratio-analysis))] + (->> ratio-analysis + (mapv (fn [{:keys [denom numer]}] + (* numer (/ lcm denom)))) + sort + (partition 2 1) + (mapv (fn [[a b]] (- b a))) + (apply =)))) + + (proportional-chord? 1 3/2 5/4)) + (comment (do - (def test1 - (let [seed [1 1 1] - period 2] - (->> (recurrent-series (mapv bigint seed) - :i1 3 - :i2 2 - :f (fn [a b] (+ a b))) - (partition 9 1) - (map (fn [seq*] - (let [seq** (sort (set (map (partial within-bounding-period period) - seq*))) - indexed-seq (->> seq** - (map-indexed (fn [i x] {x i})) - (apply merge)) - min* (/ (apply max seq**) 2)] - (->> seq** - (#(combo/combinations % 3)) - (reduce (fn [acc ns] - (let [diffs (->> ns - sort - (partition 2 1) - (map (fn [[a b]] (- b a))))] - (if (= 1 (count (set diffs))) - (update acc :proportional-triads - conj {:ratios ns - :degrees (->> (map indexed-seq ns)) - :diff (first diffs)}) - acc))) - {:meta {:scale :meru - :period period - :seed seed - :size (count seq**)} - :scale (map (fn [r] - {:ratio r - :bounded-ratio (/ r min*) - :bounding-period 2}) - seq**)}) - (#(assoc-in % [:meta :total-triads] (count (:proportional-triads %)))) - (#(assoc-in % [:meta :proportional-triads] (:proportional-triads %))) - (#(dissoc % :proportional-triads)))))) - (remove (comp empty? :proportional-triads :meta))))) + #_(def test1 + (let [seed [1 1 1] + period 2] + (->> (recurrent-series {:seed (mapv bigint seed) + :i1 2 + :i2 3 + :f (fn [a b] (+ a b))}) + (partition 9 1) + (map (fn [seq*] + (let [seq** (sort (set (map (partial within-bounding-period period) + seq*))) + indexed-seq (->> seq** + (map-indexed (fn [i x] {x i})) + (apply merge)) + min* (/ (apply max seq**) 2)] + (->> seq** + (#(combo/combinations % 3)) + (reduce (fn [acc ns] + (let [diffs (->> ns + sort + (partition 2 1) + (map (fn [[a b]] (- b a))))] + (if (= 1 (count (set diffs))) + (update acc :proportional-triads + conj {:ratios ns + :degrees (->> (map indexed-seq ns)) + :diff (first diffs)}) + acc))) + {:meta {:scale :meru + :period period + :seed seed + :size (count seq**)} + :scale (map (fn [r] + {:ratio r + :bounded-ratio (/ r min*) + :bounding-period 2}) + seq**)}) + #_(#(assoc-in % [:meta :total-triads] (count (:proportional-triads %)))) + #_(#(assoc-in % [:meta :proportional-triads] (:proportional-triads %))) + #_(#(dissoc % :proportional-triads)))))) + #_(remove (comp empty? :proportional-triads :meta))))) (def test1 (let [seed [1 1] period 2] - (->> (recurrent-series (mapv bigint seed) - :i1 1 - :i2 2 - ;; :f (fn [a b] (+ a b)) + (->> (recurrent-series {:seed (mapv bigint [1 1]) + :i1 1 + :i2 2} + ;; :f (fn [a b] (+ a b)) ) + :series (partition 21 1) (map (fn [seq*] (let [seq** (sort (set (map (partial within-bounding-period period) @@ -90,15 +137,15 @@ :bounded-ratio (/ r min*) :bounding-period 2}) seq**)}) - (#(assoc-in % [:meta :total-triads] (count (:proportional-triads %)))) - (#(assoc-in % [:meta :proportional-triads] (:proportional-triads %))) - (#(dissoc % :proportional-triads)))))) - (remove (comp empty? :proportional-triads :meta))))) + #_(#(assoc-in % [:meta :total-triads] (count (:proportional-triads %)))) + #_(#(assoc-in % [:meta :proportional-triads] (:proportional-triads %))) + #_(#(dissoc % :proportional-triads)))))) + #_(remove (comp empty? :proportional-triads :meta))))) (->> test1 - (sort-by (comp :size :meta) >) - first - :scale + #_#_#_(sort-by (comp :size :meta) >) + first + :scale #_(map (comp (juxt :size :total-triads) :meta))))) diff --git a/src/erv/meru/diagonals.clj b/src/erv/meru/diagonals.clj index 3577bf4..8281c14 100644 --- a/src/erv/meru/diagonals.clj +++ b/src/erv/meru/diagonals.clj @@ -2,6 +2,7 @@ "Based on: https://www.anaphoria.com/meru.pdf" (:require [erv.math.pascals-triangle :as pascals-triangle] + [erv.meru.utils :refer [get-convergence-double-with-precision]] [erv.mos.v3.core :refer [gen->mos-ratios]] [erv.utils.core :refer [round2]] [taoensso.timbre :as timbre])) @@ -49,10 +50,10 @@ (-> acc (assoc :series-data (conj series-data (assoc b :ratio-vs-previous ratio)) - :convergence-ratio ratio + :convergence-double ratio :last-10 (take 10 (conj last-10 ratio)) :convergence-index (inc convergence-index)))))) - {:convergence-ratio nil + {:convergence-double nil :convergence-index -1 :last-10 () :series-data [(first (first parts))] @@ -92,28 +93,9 @@ #_(make-diagonal {:x 1 :y 2} 1 4) -(do - ;; TODO move somewhere else (utils or something, but input may be better in some other way). - (defn convergence-mos-data - [convergence-ratio] - (->> (gen->mos-ratios (rationalize convergence-ratio) 2 100) - (map :meta))) - - (defn convergence-mos-data-summary - [convergence-ratio] - (->> convergence-ratio - convergence-mos-data - (map (fn [meta] - (select-keys meta [:size - :mos/pattern.name - :mos/sL-ratio.float - :mos/s.cents - :mos/L.cents]))))) - - (convergence-mos-data-summary 1.618)) - (defn diagonals - [{:keys [size slope pascal-coord->number convergence?-fn convergence-precision]}] + [{:keys [size slope pascal-coord->number convergence?-fn convergence-precision] + :or {pascal-coord->number pascals-triangle/default-coord-map}}] (when (and convergence-precision convergence?-fn) (timbre/warn "Both `convergence?-fn` and `convergence-precision` have been provided. The latter is going to be ignored.")) (let [convergence?-fn (cond @@ -126,10 +108,9 @@ {:left 1 :right 1} (:triangle-seed (meta pascal-coord->number))) :convergence-precision convergence-precision - :convergence-ratio-with-precision (if convergence-precision - (round2 convergence-precision - (:convergence-ratio data)) - (:convergence-ratio data))))] + :convergence-double-with-precision (get-convergence-double-with-precision + convergence-precision + (:convergence-double data))))] (->> (range size) (map #(make-diagonal slope (slope->n-increment slope) %)) (map (fn [coords] @@ -140,8 +121,3 @@ :coords (vec coords)})) (convergence-analysis convergence?-fn) update-convergence-data))) - -(diagonals {:size 100 - :slope {:x 3 :y 5} - :convergence-precision 3 - :pascal-coord->number pascals-triangle/default-coord-map}) diff --git a/src/erv/meru/recurrent_series.cljc b/src/erv/meru/recurrent_series.cljc index 2da3f7f..f761211 100644 --- a/src/erv/meru/recurrent_series.cljc +++ b/src/erv/meru/recurrent_series.cljc @@ -1,4 +1,6 @@ -(ns erv.meru.recurrent-series) +(ns erv.meru.recurrent-series + (:require + [erv.meru.utils :refer [get-convergence-double-with-precision]])) (defn seq-ratios* [recurrent-seq] (->> recurrent-seq @@ -44,8 +46,9 @@ Hn-3 + Hn-2 = Hn `:i1` corresponds to 2, taken from Hn-2 `:i2` corresponds to 3, taken from Hn-3." - [{:keys [seed formula _i1 _i2 _f] :as config}] - (let [config* (get scale-formulas formula config) + [{:keys [seed formula _i1 _i2 _f convergence-precision] :as config}] + (let [preset-config (get scale-formulas formula) + config* (or preset-config config) {:keys [i1 i2 f] :or {f +}} config* seed* (mapv #?(:clj bigint :cljs js/BigInt) seed) _ (when (> i2 (count seed)) @@ -60,8 +63,16 @@ b* (first (take-last i2 seq**))] (if (apply = (seq-ratios (take-last 6 seq**))) seq** - (recur seq** a* b*))))] - {:convergence-double (last (seq-ratios series)) + (recur seq** a* b*)))) + convergence-double (last (seq-ratios series))] + {:seed seed + :preset-formula formula + :convergence-precision convergence-precision + :convergence-double convergence-double + :convergence-double-with-precision (get-convergence-double-with-precision + convergence-precision + convergence-double) :convergence (last (seq-ratios* series)) :convergence-index (converges-at series) + :reached-convergence? true :series series})) diff --git a/src/erv/meru/utils.cljc b/src/erv/meru/utils.cljc new file mode 100644 index 0000000..6804405 --- /dev/null +++ b/src/erv/meru/utils.cljc @@ -0,0 +1,10 @@ +(ns erv.meru.utils + (:require + [erv.utils.core :refer [round2]])) + +(defn get-convergence-double-with-precision + [convergence-precision convergence-double] + (if convergence-precision + (round2 convergence-precision + convergence-double) + convergence-double)) diff --git a/src/erv/types.cljc b/src/erv/types.cljc index 165789d..df4f527 100644 --- a/src/erv/types.cljc +++ b/src/erv/types.cljc @@ -6,55 +6,39 @@ #_{:clj-kondo/ignore [:unresolved-symbol]} [:or :int [:fn #(instance? clojure.lang.BigInt %)]]) -(do - (def MeruBaseData - [:map - [:convergence-double double?] - [:convergence-index int?] - [:reached-convergence? :boolean] - [:series [:vector Intish]]]) - - (def MeruDiagonalsData - (mu/merge MeruBaseData - [:map - [:series-data [:vector - [:map - [:value Intish] - [:coords [:vector - [:map - [:x :int] - [:y Intish]]]] - [:ratio-vs-previous {:optional true} [:maybe :double]]]]] - [:triangle-seed [:map [:left :int] [:right :int]]] - [:convergence-precision :int] - [:convergence-ratio-with-precision :double]])) +(def MeruBaseData + [:map + [:convergence-double double?] + [:convergence-index int?] + [:reached-convergence? :boolean] + [:series [:vector Intish]] + [:convergence-precision [:or :int :nil]] + [:convergence-double-with-precision :double]]) +(def MeruRecurrentSeriesData + (mu/merge #'MeruBaseData + [:map + [:seed [:vector :int]]])) +(def MeruDiagonalsData + (mu/merge #'MeruBaseData + [:map + [:series-data [:vector + [:map + [:value #'Intish] + [:coords [:vector + [:map + [:x :int] + [:y #'Intish]]]] + [:ratio-vs-previous {:optional true} [:maybe :double]]]]] + [:triangle-seed [:map [:left :int] [:right :int]]] + [:convergence-precision [:or :int :nil]] + [:convergence-double-with-precision :double]])) +(comment (m/explain MeruDiagonalsData - {:convergence-double 2.0, - :convergence-index 18, - :series-data - [{:value 1, :coords [{:x 0, :y 0N}]} - {:value 0, :coords [], :ratio-vs-previous 0.0} - {:value 0, :coords [], :ratio-vs-previous nil} - {:value 1N, :coords [{:x 0, :y 1N}], :ratio-vs-previous nil} - {:value 0, :coords [], :ratio-vs-previous 0.0} - {:value 1N, :coords [{:x 1, :y 0N}], :ratio-vs-previous nil} - {:value 1N, :coords [{:x 0, :y 2N}], :ratio-vs-previous 1.0} - {:value 0, :coords [], :ratio-vs-previous 0.0} - {:value 2N, :coords [{:x 1, :y 1N}], :ratio-vs-previous nil} - {:value 1N, :coords [{:x 0, :y 3N}], :ratio-vs-previous 0.5} - {:value 1N, :coords [{:x 2, :y 0N}], :ratio-vs-previous 1.0} - {:value 3N, :coords [{:x 1, :y 2N}], :ratio-vs-previous 3.0} - {:value 1N, :coords [{:x 0, :y 4N}], :ratio-vs-previous 0.3333333333333333} - {:value 3N, :coords [{:x 2, :y 1N}], :ratio-vs-previous 3.0} - {:value 4N, :coords [{:x 1, :y 3N}], :ratio-vs-previous 1.333333333333333} - {:value 2N, :coords [{:x 0, :y 5N} {:x 3, :y 0N}], :ratio-vs-previous 0.5} - {:value 6N, :coords [{:x 2, :y 2N}], :ratio-vs-previous 3.0} - {:value 5N, :coords [{:x 1, :y 4N}], :ratio-vs-previous 0.8333333333333333} - {:value 5N, :coords [{:x 0, :y 6N} {:x 3, :y 1N}], :ratio-vs-previous 1.0} - {:value 10N, :coords [{:x 2, :y 3N}], :ratio-vs-previous 2.0}], - :reached-convergence? false, - :series [1 0 0 1N 0 1N 1N 0 2N 1N 1N 3N 1N 3N 4N 2N 6N 5N 5N 10N], - :triangle-seed {:left 1, :right 1}, - :convergence-precision 3, - :convergence-ratio-with-precision 2.0})) + (erv.meru.diagonals/diagonals + {:size 120 + :slope {:x 1 :y 2} + :pascal-coord->number erv.math.pascals-triangle/default-coord-map})) + (:errors (m/explain MeruRecurrentSeriesData + (erv.meru.recurrent-series/recurrent-series {:seed [1 1 1] + :formula :meta-slendro})))) diff --git a/src/erv/utils/core.cljc b/src/erv/utils/core.cljc index 59a95a8..a03ec36 100755 --- a/src/erv/utils/core.cljc +++ b/src/erv/utils/core.cljc @@ -120,3 +120,27 @@ "Find the greatest common divisor of a list of numbers" [nums] (reduce gcd nums)) + +(defn decompose-ratio + ([ratios] #?(:clj (mapv (fn [r] (try + {:numer (numerator r) :denom (denominator r)} + (catch Exception _ + {:numer r :denom 1}))) + ratios) + :cljs (mapv (fn [r] + ;; TODO `numer` is a float + {:numer r :denom 1}) + ratios)))) + +(defn make-map-by-key + "Given a vector of hash-maps with a specific `k`, return a map of `k`->hash-map. + The user is responsible for providing a unique `k`, otherwise data may be missing." + [k maps] + (reduce + (fn [acc m] + (assoc acc (k m) m)) + {} + maps)) + +;; TODO make test +(make-map-by-key :id [{:id 1} {:id 2}]) diff --git a/src/erv/utils/scale.clj b/src/erv/utils/scale.clj index cc19a4c..899c4ba 100644 --- a/src/erv/utils/scale.clj +++ b/src/erv/utils/scale.clj @@ -1,7 +1,8 @@ (ns erv.utils.scale (:require [clojure.math.combinatorics :as combo] - [erv.utils.core :refer [interval period-reduce rotate wrap-at]] + [erv.utils.core :refer [decompose-ratio interval lcm-of-list period-reduce + rotate wrap-at]] [erv.utils.ratios :refer [interval-seq->ratio-stack normalize-ratios ratios->scale ratios-intervals]])) @@ -143,7 +144,7 @@ (keep #(wrap-at % scale) degrees)) (defn scale-steps->degrees - "Convert a sequence of scale-steps defining a scale (e.g. [2 2 1 2 2 2 1] into a sequence of degrees" + "Convert a sequence of scale-steps defining a scale (e.g. [2 2 1 2 2 2 1]) into a sequence of degrees" ([scale-steps] (scale-steps->degrees scale-steps true)) ([scale-steps remove-octave?] (->> scale-steps @@ -162,3 +163,40 @@ :size (count scale) :period period} :scale scale})) + +;; TODO add tests +;; +;; +;; +;; +;; +(defn proportional-chord? + [ratios] + (let [ratio-analysis (decompose-ratio ratios) + lcm (lcm-of-list (mapv :denom ratio-analysis))] + (->> ratio-analysis + (mapv (fn [{:keys [denom numer]}] + (* numer (/ lcm denom)))) + sort + (partition 2 1) + (mapv (fn [[a b]] (- b a))) + (apply =)))) + +(proportional-chord? [1 3/2 5/4]) + +(defn +degree [scale] + (map-indexed (fn [i n] (assoc n :degree i)) scale)) + +(do + (defn proportional-chords + [chord-size scale] + (let [scale (+degree scale) + proportional-chords-by-notes (->> (combo/combinations scale chord-size) + (keep (fn [ns] + (when (->> ns (mapv :ratio) proportional-chord?) + ns))))] + {:by-notes proportional-chords-by-notes + :by-degrees (mapv (fn [pc] (mapv :degree pc)) + proportional-chords-by-notes)})) + + (proportional-chords 4 (ratios->scale [1 3 5 7 9]))) diff --git a/test/erv/meru/core_test.clj b/test/erv/meru/core_test.clj index 45e95d7..3661b84 100644 --- a/test/erv/meru/core_test.clj +++ b/test/erv/meru/core_test.clj @@ -1,21 +1,26 @@ (ns erv.meru.core-test (:require [clojure.test :refer [deftest is testing]] - [erv.meru.core :refer [recurrent-series]])) + [erv.meru.core :as subject])) -(deftest recurrent-series-test - (let [meta-slendro-series - {:convergence-double 1.324717957244746, - :convergence 53406819691/40315615410, - :convergence-index 84, - :series [1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691]}] - (testing "Can use a `:seed` and a `:formula`" - (is (= meta-slendro-series - (recurrent-series {:seed [1 1 1] - :formula :meta-slendro})))) - (testing "Can use a `:seed` and a custom configuration of indexes and an operation for apply the values of the indexes." - (is (= meta-slendro-series - (recurrent-series {:seed [1 1 1] - :i1 2 - :i2 3 - :f (fn [a b] (+ a b))})))))) +(deftest convergence-mos-data-summary-test + (is (= [{:size 2, + :mos/pattern.name "1s1L", + :mos/sL-ratio.float (float 2.2702353), + :mos/s.cents 366.9460706785318, + :mos/L.cents 833.0539293214687} + {:size 3, + :mos/pattern.name "2s1L", + :mos/sL-ratio.float (float 1.2702353), + :mos/s.cents 366.9460706785318, + :mos/L.cents 466.10785864293723} + {:size 4, + :mos/pattern.name "1s3L", + :mos/sL-ratio.float (float 3.7004786), + :mos/s.cents 99.16178796440605, + :mos/L.cents 366.9460706785318}] + (subject/convergence-mos-data-summary + {:max-size 4 + :period 2} + (subject/diagonals {:size 20 + :slope {:x 1 :y 2}}))))) diff --git a/test/erv/meru/diagonals_test.clj b/test/erv/meru/diagonals_test.clj index 8869f54..22df2ac 100644 --- a/test/erv/meru/diagonals_test.clj +++ b/test/erv/meru/diagonals_test.clj @@ -2,40 +2,49 @@ (:require [clojure.test :refer [deftest is testing]] [erv.math.pascals-triangle :as pascals-triangle] - [erv.meru.diagonals :as subject])) + [erv.meru.diagonals :as subject] + [erv.types :refer [MeruDiagonalsData]] + [malli.core :as m])) (deftest diagonals-test + (testing "The Malli type is up to date" + (let [data (subject/make + {:size 12 + :slope {:x 1 :y 2} + :pascal-coord->number pascals-triangle/default-coord-map})] + (is (m/validate MeruDiagonalsData data) + (m/explain MeruDiagonalsData data)))) (testing "Has a `:series` key" (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] - (->> (subject/diagonals + (->> (subject/make {:size 12 :slope {:x 1 :y 2} :pascal-coord->number pascals-triangle/default-coord-map}) :series)))) (testing "Can work with a custom `pascal-coord->number function (or map)" (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] - (->> (subject/diagonals + (->> (subject/make {:size 12 :slope {:x 1 :y 2} :pascal-coord->number (pascals-triangle/make-coord-map 1 1 30)}) :series)))) - (testing "Has a `:convergence-ratio` and a `:convergence-ratio-with-precision` key" + (testing "Has a `:convergence-double` and a `:convergence-double-with-precision` key" (is (= [1.617977528089888 1.618] - (->> (subject/diagonals + (->> (subject/make {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 :pascal-coord->number pascals-triangle/default-coord-map}) - ((juxt :convergence-ratio :convergence-ratio-with-precision)))))) + ((juxt :convergence-double :convergence-double-with-precision)))))) (testing "May have a `:triangle-seed` key, specially if `:pascal-coord->number` is `pascals-triangle/default-coord-map` or was created with `pascals-triangle/make-coord-map`." (is (= {:left 1, :right 1} - (->> (subject/diagonals + (->> (subject/make {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 :pascal-coord->number pascals-triangle/default-coord-map}) :triangle-seed) - (->> (subject/diagonals + (->> (subject/make {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 diff --git a/test/erv/meru/recurrent_series_test.clj b/test/erv/meru/recurrent_series_test.clj index e6dcb1f..a222a3e 100644 --- a/test/erv/meru/recurrent_series_test.clj +++ b/test/erv/meru/recurrent_series_test.clj @@ -1,21 +1,32 @@ (ns erv.meru.recurrent-series-test (:require [clojure.test :refer [deftest is testing]] - [erv.meru.recurrent-series :as subject])) + [erv.math.pascals-triangle :as pascals-triangle] + [erv.meru.recurrent-series :as subject] + [erv.types :refer [MeruRecurrentSeriesData]] + [malli.core :as m])) (deftest recurrent-series-test - (let [meta-slendro-series - {:convergence-double 1.324717957244746, - :convergence 53406819691/40315615410, - :convergence-index 84, - :series [1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691]}] - (testing "Can use a `:seed` and a `:formula`" - (is (= meta-slendro-series - (subject/recurrent-series {:seed [1 1 1] - :formula :meta-slendro})))) - (testing "Can use a `:seed` and a custom configuration of indexes and an operation for apply the values of the indexes." - (is (= meta-slendro-series - (subject/recurrent-series {:seed [1 1 1] - :i1 2 - :i2 3 - :f (fn [a b] (+ a b))})))))) + (testing "The Malli type is up to date" + (let [data (subject/recurrent-series + {:seed [1 1 1] + :formula :meta-slendro})] + (is (m/validate MeruRecurrentSeriesData data) + (m/explain MeruRecurrentSeriesData data)))) + (testing "Basic usage" + (let [meta-slendro-series {:convergence-double 1.324717957244746, + :convergence 53406819691/40315615410, + :convergence-index 84, + :series [1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691]}] + (testing "Can use a `:seed` and a `:formula`" + (is (= meta-slendro-series + (-> (subject/recurrent-series {:seed [1 1 1] + :formula :meta-slendro}) + (select-keys [:convergence-double :convergence :convergence-index :series]))))) + (testing "Can use a `:seed` and a custom configuration of indexes and an operation for apply the values of the indexes." + (is (= meta-slendro-series + (-> (subject/recurrent-series {:seed [1 1 1] + :i1 2 + :i2 3 + :f (fn [a b] (+ a b))}) + (select-keys [:convergence-double :convergence :convergence-index :series])))))))) diff --git a/test/erv/utils/core_test.cljc b/test/erv/utils/core_test.cljc index 7f591b8..2d125ea 100644 --- a/test/erv/utils/core_test.cljc +++ b/test/erv/utils/core_test.cljc @@ -1,7 +1,8 @@ (ns erv.utils.core-test (:require [clojure.test :refer [deftest is]] - [erv.utils.core :refer [pattern->degrees pick-degrees pick-pattern]])) + [erv.utils.core :refer [make-map-by-key pattern->degrees pick-degrees + pick-pattern]])) (deftest pattern->indexes-test (is (= [0 2 4 5 7 9 11] @@ -20,3 +21,7 @@ (pick-degrees (range 5) (range 10))))) + +(deftest make-map-by-key-test + (is (= {1 {:id 1}, 2 {:id 2}} + (make-map-by-key :id [{:id 1} {:id 2}])))) From 22841bd3b16c6a24c6b797d708650cdb3319800f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Fri, 12 Sep 2025 21:14:14 -0600 Subject: [PATCH 20/23] [beating-analyzer] wip --- src/erv/meru/scratch/beatings2.cljc | 174 ++++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 src/erv/meru/scratch/beatings2.cljc diff --git a/src/erv/meru/scratch/beatings2.cljc b/src/erv/meru/scratch/beatings2.cljc new file mode 100644 index 0000000..04d87d4 --- /dev/null +++ b/src/erv/meru/scratch/beatings2.cljc @@ -0,0 +1,174 @@ +(ns erv.meru.scratch.beatings2 + (:require + [clojure.math.combinatorics :as combo] + [erv.utils.conversions :refer [cps->name*]] + [erv.utils.core :refer [make-map-by-key pow]])) + +(comment) +#_(def c (* 3 11 8)) + +(def c 256 #_(* 3 11 8)) + +(do + (defn get-beat-data + ([ratios] (get-beat-data (range 1 9) ratios)) + ([partials ratios] + (->> ratios + (mapcat + (fn [degree ratio] + (map (fn [i] {:degree degree + :ratio ratio + :partial i + :partial*ratio (* i ratio)}) + partials)) + (range)) + (#(combo/combinations % 2)) + (remove (fn [[x1 x2]] (= (:ratio x1) (:ratio x2)))) + (map (fn [pair] {:pair pair + :diff (abs (- (:partial*ratio (first pair)) + (:partial*ratio (second pair))))})) + (sort-by :diff) + #_(map (fn [pair] + (assoc pair + :diff-c4 (double (* root (:diff pair))) + :diff-c3 (double (/ (* root (:diff pair)) + 2)) + :diff-c2 (double (/ (* root (:diff pair)) + 4)) + :diff-c1 (double (/ (* root (:diff pair)) + 8)))))))) + + (def metameantone-beatings) + (get-beat-data [1 + 67/64 + 279/256 + 9/8 + 75/64 + 39/32 + 5/4 + 167/128 + 87/64 + 45/32 + 187/128 + 3/2 + 25/16 + 417/256 + 27/16 + 7/4 + 233/128 + 15/8 + 125/64]) + (get-beat-data [1 + 5/4 + 3/2 + 7/4])) + +(do + (defn- get-root-note-lowest-freq + [period freq] + (let [lowest-freq 20] + (loop + [freq freq] + (cond + (< freq lowest-freq) (recur (* freq period)) + (>= freq (* lowest-freq period)) (recur (/ freq period)) + (and (>= freq lowest-freq) (> (* lowest-freq period) freq)) freq)))) + (get-root-note-lowest-freq 2 20) + (get-root-note-lowest-freq 2 40) + (get-root-note-lowest-freq 2 16)) + +(do + (defn- get-freq-periods-range + [period initial-freq max-freq] + (->> (range) + (map #(* initial-freq (pow period %))) + (take-while #(<= % max-freq)))) + (get-freq-periods-range 2 1 4000)) + +(do + ;; TODO refactor to smaller functions and rename + (defn +beat-hz-by-period + "Using a root note, map the beat-data over the a range from 20 to 4000hz" + [period root ratios] + (let [max-freq 8000 + beat-data (get-beat-data ratios) + lowest-root (get-root-note-lowest-freq period root) + root-periods-freqs (get-freq-periods-range period lowest-root max-freq) + pair->beat-data (->> beat-data + (mapv + (fn [pair] + (->> root-periods-freqs + (mapv + (fn [period root-freq] + (let [k (keyword (str "diff-period-" period))] + (double (* root-freq (:diff pair))))) + (range)) + #_(into {}) + (assoc pair + :root-hz lowest-root + :beat-hz-by-period)))) + (group-by (comp set #(map :ratio %) :pair)) + (mapv (fn [[k v]] + [k (sort-by (juxt + (comp :partial first :pair) + (comp :partial second :pair)) + v)])) + (into {}) + #_(make-map-by-key (comp set #(map :ratio %) :pair))) + ratio-pairs (->> (keys pair->beat-data) + (sort-by (juxt first second)))] + (mapcat + (fn [period root] + (mapcat + (fn [pair] + (->> (pair->beat-data pair) + (keep (fn [beat-data] + (let [data ((juxt (comp :partial first :pair) + (comp :partial second :pair) + :beat-hz-by-period) + beat-data) + [pr1 pr2 beats-by-period] data + beats (nth beats-by-period period) + [r1 r2] (sort pair)] + (when (and (< beats 20) + (not (zero? beats))) + {:period period + :root-hz root + :root (cps->name* root) + :ratio-1 r1 + :ratio-2 r2 + :ratio-1-partial pr1 + :ratio-2-partial pr2 + :beat-freq beats})))))) + ratio-pairs)) + (range) + root-periods-freqs))) + (->> (+beat-hz-by-period 2 1 #_[1 5/4 3/2 7/4] + [1 + 67/64 + 279/256 + 9/8 + 75/64 + 39/32 + 5/4 + 167/128 + 87/64 + 45/32 + 187/128 + 3/2 + 25/16 + 417/256 + 27/16 + 7/4 + 233/128 + 15/8 + 125/64]))) + +(for [a [1 2 3 4] + b [1 2 3 4]] + [a b]) +(defn- ratio-pair->beat-data + [beat-data] + (make-map-by-key :pair beat-data)) + +#_(ratio-pair->beat-data (+beat-hz-by-period 2 256 (get-beat-data [1 5/4 3/2 7/4]))) From fd931ce3ae341d69b1f8a07c064b9bdade574f6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Mon, 15 Sep 2025 13:17:38 -0600 Subject: [PATCH 21/23] [meru] add propotional-chords function --- src/erv/meru/core.clj | 25 +--------------- src/erv/types.cljc | 1 + src/erv/utils/core.cljc | 24 +++++++-------- src/erv/utils/scale.clj | 51 ++++++++++++++++++-------------- test/erv/meru/diagonals_test.clj | 12 ++++---- test/erv/utils/scale_test.clj | 18 +++++++++-- 6 files changed, 61 insertions(+), 70 deletions(-) diff --git a/src/erv/meru/core.clj b/src/erv/meru/core.clj index 8d4f0b0..5e0d8ad 100644 --- a/src/erv/meru/core.clj +++ b/src/erv/meru/core.clj @@ -5,15 +5,12 @@ [erv.meru.diagonals] [erv.meru.recurrent-series] [erv.mos.v3.core :refer [gen->mos-ratios]] - [erv.utils.core :refer [lcm-of-list round2]])) + [erv.utils.core :refer [round2]])) (def recurrent-series #'erv.meru.recurrent-series/recurrent-series) (def diagonals #'erv.meru.diagonals/diagonals) -(diagonals {:size 20 - :slope {:x 1 :y 2}}) - (defn convergence-mos-data ([convergence-double] (convergence-mos-data {} convergence-double)) ([{:keys [period max-size] @@ -35,26 +32,6 @@ :mos/s.cents :mos/L.cents])))))) -(convergence-mos-data-summary (diagonals {:size 20 - - :slope {:x 1 :y 2}})) - -(do - - (defn proportional-chord? - [& ratios] - (let [ratio-analysis (decompose-ratio ratios) - lcm (lcm-of-list (mapv :denom ratio-analysis))] - (->> ratio-analysis - (mapv (fn [{:keys [denom numer]}] - (* numer (/ lcm denom)))) - sort - (partition 2 1) - (mapv (fn [[a b]] (- b a))) - (apply =)))) - - (proportional-chord? 1 3/2 5/4)) - (comment (do #_(def test1 diff --git a/src/erv/types.cljc b/src/erv/types.cljc index df4f527..41e1301 100644 --- a/src/erv/types.cljc +++ b/src/erv/types.cljc @@ -19,6 +19,7 @@ (mu/merge #'MeruBaseData [:map [:seed [:vector :int]]])) + (def MeruDiagonalsData (mu/merge #'MeruBaseData [:map diff --git a/src/erv/utils/core.cljc b/src/erv/utils/core.cljc index a03ec36..5ccace6 100755 --- a/src/erv/utils/core.cljc +++ b/src/erv/utils/core.cljc @@ -122,25 +122,21 @@ (reduce gcd nums)) (defn decompose-ratio - ([ratios] #?(:clj (mapv (fn [r] (try - {:numer (numerator r) :denom (denominator r)} - (catch Exception _ - {:numer r :denom 1}))) - ratios) - :cljs (mapv (fn [r] - ;; TODO `numer` is a float - {:numer r :denom 1}) - ratios)))) + ([ratio] #?(:clj (try + {:numer (numerator ratio) :denom (denominator ratio)} + (catch Exception _ + {:numer ratio :denom 1})) + :cljs {:numer ratio :denom 1}))) + +(defn decompose-ratios + ([ratios] (mapv decompose-ratio ratios))) (defn make-map-by-key "Given a vector of hash-maps with a specific `k`, return a map of `k`->hash-map. The user is responsible for providing a unique `k`, otherwise data may be missing." - [k maps] + [key-fn maps] (reduce (fn [acc m] - (assoc acc (k m) m)) + (assoc acc (key-fn m) m)) {} maps)) - -;; TODO make test -(make-map-by-key :id [{:id 1} {:id 2}]) diff --git a/src/erv/utils/scale.clj b/src/erv/utils/scale.clj index 899c4ba..43464fb 100644 --- a/src/erv/utils/scale.clj +++ b/src/erv/utils/scale.clj @@ -1,11 +1,14 @@ (ns erv.utils.scale (:require [clojure.math.combinatorics :as combo] - [erv.utils.core :refer [decompose-ratio interval lcm-of-list period-reduce + [erv.utils.core :refer [decompose-ratios interval lcm-of-list period-reduce rotate wrap-at]] [erv.utils.ratios :refer [interval-seq->ratio-stack normalize-ratios ratios->scale ratios-intervals]])) +(defn +degree [scale] + (map-indexed (fn [i n] (assoc n :degree i)) scale)) + (defn degree-stack "Generate a stack ratios from a single (degree) generator" [{:keys [scale gen offset]}] @@ -170,9 +173,10 @@ ;; ;; ;; -(defn proportional-chord? +(defn proportional-difference + "Returns the difference between the ratios if the chord is proportional, otherwiser returns `nil`" [ratios] - (let [ratio-analysis (decompose-ratio ratios) + (let [ratio-analysis (decompose-ratios ratios) lcm (lcm-of-list (mapv :denom ratio-analysis))] (->> ratio-analysis (mapv (fn [{:keys [denom numer]}] @@ -180,23 +184,24 @@ sort (partition 2 1) (mapv (fn [[a b]] (- b a))) - (apply =)))) - -(proportional-chord? [1 3/2 5/4]) - -(defn +degree [scale] - (map-indexed (fn [i n] (assoc n :degree i)) scale)) - -(do - (defn proportional-chords - [chord-size scale] - (let [scale (+degree scale) - proportional-chords-by-notes (->> (combo/combinations scale chord-size) - (keep (fn [ns] - (when (->> ns (mapv :ratio) proportional-chord?) - ns))))] - {:by-notes proportional-chords-by-notes - :by-degrees (mapv (fn [pc] (mapv :degree pc)) - proportional-chords-by-notes)})) - - (proportional-chords 4 (ratios->scale [1 3 5 7 9]))) + (#(when (apply = %) (first %)))))) + +(defn proportional-chords + "Returns a map with keys `:by-notes` and `:by-degrees` with the notes or degrees that form proportional chords of a given size. + The map groups these notes or degrees by the difference in beats common to them." + [chord-size scale] + (let [scale (+degree scale) + proportional-chords-by-notes (->> (combo/combinations scale chord-size) + (keep (fn [ns] + (when-let [diff (->> ns (mapv :ratio) proportional-difference)] + [diff ns]))))] + {:by-notes (reduce + (fn [acc [diff ns]] + (update acc diff (fnil conj []) (mapv :ratio ns))) + {} + proportional-chords-by-notes) + :by-degrees (reduce + (fn [acc [diff ns]] + (update acc diff (fnil conj []) (mapv :degree ns))) + {} + proportional-chords-by-notes)})) diff --git a/test/erv/meru/diagonals_test.clj b/test/erv/meru/diagonals_test.clj index 22df2ac..91480da 100644 --- a/test/erv/meru/diagonals_test.clj +++ b/test/erv/meru/diagonals_test.clj @@ -8,7 +8,7 @@ (deftest diagonals-test (testing "The Malli type is up to date" - (let [data (subject/make + (let [data (subject/diagonal {:size 12 :slope {:x 1 :y 2} :pascal-coord->number pascals-triangle/default-coord-map})] @@ -16,21 +16,21 @@ (m/explain MeruDiagonalsData data)))) (testing "Has a `:series` key" (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] - (->> (subject/make + (->> (subject/diagonal {:size 12 :slope {:x 1 :y 2} :pascal-coord->number pascals-triangle/default-coord-map}) :series)))) (testing "Can work with a custom `pascal-coord->number function (or map)" (is (= [1 1N 2N 3N 5N 8N 13N 21N 34N 55N 89N 144N] - (->> (subject/make + (->> (subject/diagonal {:size 12 :slope {:x 1 :y 2} :pascal-coord->number (pascals-triangle/make-coord-map 1 1 30)}) :series)))) (testing "Has a `:convergence-double` and a `:convergence-double-with-precision` key" (is (= [1.617977528089888 1.618] - (->> (subject/make + (->> (subject/diagonal {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 @@ -38,13 +38,13 @@ ((juxt :convergence-double :convergence-double-with-precision)))))) (testing "May have a `:triangle-seed` key, specially if `:pascal-coord->number` is `pascals-triangle/default-coord-map` or was created with `pascals-triangle/make-coord-map`." (is (= {:left 1, :right 1} - (->> (subject/make + (->> (subject/diagonal {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 :pascal-coord->number pascals-triangle/default-coord-map}) :triangle-seed) - (->> (subject/make + (->> (subject/diagonal {:size 12 :slope {:x 1 :y 2} :convergence-precision 3 diff --git a/test/erv/utils/scale_test.clj b/test/erv/utils/scale_test.clj index 52ad1b9..3d5883b 100644 --- a/test/erv/utils/scale_test.clj +++ b/test/erv/utils/scale_test.clj @@ -4,9 +4,10 @@ [erv.edo.core :as edo] [erv.utils.ratios :refer [ratios->scale]] [erv.utils.scale :refer [cross-set dedupe-scale degree-stack diamond - find-subset-degrees get-degrees rotate-scale - scale->stacked-subscale scale-intervals - scale-steps->degrees tritriadic]])) + find-subset-degrees get-degrees + proportional-chords proportional-difference + rotate-scale scale->stacked-subscale + scale-intervals scale-steps->degrees tritriadic]])) (deftest degree-stack-test (is (= [0 4 8] @@ -241,3 +242,14 @@ (map :bounded-ratio (:scale (cross-set 2 [1 3 5 7 9] (map #(/ 1 %) [1 3 5 7 9])))))))) + +(deftest proportional-difference-test + (is (= 1 + (proportional-difference [1 5/4 3/2]))) + (is (= nil + (proportional-difference [1 9/8 3/2])))) + +(deftest proportional-chords-test + (is (= {:by-notes {1N [[1 9/8 5/4] [1 5/4 3/2] [5/4 3/2 7/4]]}, + :by-degrees {1N [[0 1 2] [0 2 3] [2 3 4]]}} + (proportional-chords 3 (ratios->scale [1 3 5 7 9]))))) From 7494630f6e81be52d8129ed7016c01e0a92ed82a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Mon, 15 Sep 2025 13:18:29 -0600 Subject: [PATCH 22/23] [scl] add kbm file generation --- src/erv/scale/scl.cljc | 66 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/src/erv/scale/scl.cljc b/src/erv/scale/scl.cljc index 4326b28..df7c974 100644 --- a/src/erv/scale/scl.cljc +++ b/src/erv/scale/scl.cljc @@ -133,3 +133,69 @@ (do (make-parents filepath) (spit filepath (:content (make-scl-file scale-data)))) :cljs (throw (js/Error. "Cannot spit file in JS, use make-scl-file instead")))) + +;;;;;;;;;;; +;; KBM Files +;;;;;;;;;;; + +(def kbm-template + "Template for a keyboard mapping" + "! KBM file for: %s; %s +! Size of map. The pattern repeats every so many keys: +%s +! First MIDI note number to retune: +0 +! Last MIDI note number to retune: +127 +! Middle note where the first entry of the mapping is mapped to: +%s +! Reference note for which frequency is given: +%s +! Frequency to tune the above note to +%s +! Scale degree to consider as formal octave (determines difference in pitch +! between adjacent mapping patterns): +%s +! Mapping. +! The numbers represent scale degrees mapped to keys. The first entry is for +! the given middle note, the next for subsequent higher keys. +! For an unmapped key, put in an \"x\". At the end, unmapped keys may be left out. +%s +! %s +") + +(defn make-kbm + [{:as _kbm-template-config + :keys [scale-data degrees middle-note middle-note-freq] + :or {middle-note-freq (conv/midi->cps 60) + middle-note 60}}] + (let [scale-description (get-description-data scale-data) + scale (:scale scale-data) + scale-size (count scale)] + (format kbm-template + (:name scale-description "unknown.scl") + (:description scale-description "") + (count degrees) + middle-note ;; middle note + middle-note ;; reference note + middle-note-freq ;; frequency + scale-size + (str/join "\n" degrees) + made-with))) + +(comment + (def scale-data (erv.cps.core/make 2 [1 3 5 7])) + + (println (make-kbm {:scale-data scale-data + :degrees [1 "x" "x" 3 "x"]})) + + (spit-kbm {:scale-data scale-data + :degrees [1 3]})) + +(defn ^:export spit-kbm + #_{:clj-kondo/ignore [:unused-binding]} + [{:keys [filepath] :as kbm-template-config}] + #?(:clj + (do (make-parents filepath) + (spit filepath (make-kbm kbm-template-config))) + :cljs (throw (js/Error. "Cannot spit file in JS, use make-kbm instead")))) From 31655128b5421c82431f519f99fdc2a95ad4636f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Diego=20Villase=C3=B1or?= Date: Mon, 15 Sep 2025 13:51:57 -0600 Subject: [PATCH 23/23] [scl] kbm remove comments option --- src/erv/scale/scl.cljc | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/src/erv/scale/scl.cljc b/src/erv/scale/scl.cljc index df7c974..5e56a36 100644 --- a/src/erv/scale/scl.cljc +++ b/src/erv/scale/scl.cljc @@ -166,22 +166,28 @@ (defn make-kbm [{:as _kbm-template-config - :keys [scale-data degrees middle-note middle-note-freq] + :keys [scale-data degrees middle-note middle-note-freq comments?] :or {middle-note-freq (conv/midi->cps 60) - middle-note 60}}] + middle-note 60 + comments? true}}] (let [scale-description (get-description-data scale-data) scale (:scale scale-data) scale-size (count scale)] - (format kbm-template - (:name scale-description "unknown.scl") - (:description scale-description "") - (count degrees) - middle-note ;; middle note - middle-note ;; reference note - middle-note-freq ;; frequency - scale-size - (str/join "\n" degrees) - made-with))) + (cond-> (format kbm-template + (:name scale-description "unknown.scl") + (:description scale-description "") + (count degrees) + middle-note ;; middle note + middle-note ;; reference note + middle-note-freq ;; frequency + scale-size + (str/join "\n" degrees) + made-with) + (not comments?) ((fn [kbm] + (let [lines (str/split-lines kbm)] + (->> lines + (remove #(str/starts-with? % "!")) + (str/join "\n")))))))) (comment (def scale-data (erv.cps.core/make 2 [1 3 5 7]))