diff --git a/deps.edn b/deps.edn index 3a3bc78..f143949 100755 --- a/deps.edn +++ b/deps.edn @@ -1,10 +1,12 @@ {: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"} 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"} @@ -13,4 +15,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"]}}}} 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/erv/constant_structures/brute_force.cljc b/src/erv/constant_structures/brute_force.cljc index 45e457b..7ea3eb8 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)) %)) @@ -128,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. 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 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/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..1492a58 100644 --- a/src/erv/math/pascals_triangle.cljc +++ b/src/erv/math/pascals_triangle.cljc @@ -1,12 +1,49 @@ (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 make + ([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)) (defn row [n] (last (make n))) + +(defn factorial [x] + (apply * (map #?(:clj bigint :cljs js/BigInt) + (range 1 (inc x))))) + +(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]] + (/ (factorial (+ x y)) + (* (factorial x) (factorial y)))) + +(defn- pascal-coordinates + [size] + (->> (range size) + (mapv + (fn [size*] + (->> (range 0 (inc size*)) + (map + (fn [i] [(- size* i) i]))))))) + +(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/core.clj b/src/erv/meru/core.clj index 61ed3cb..5e0d8ad 100644 --- a/src/erv/meru/core.clj +++ b/src/erv/meru/core.clj @@ -1,140 +1,89 @@ (ns erv.meru.core - (:require [clojure.math.combinatorics :as combo] - [erv.cps.core :refer [within-bounding-period]] - [erv.constant-structures.graphics :as sketch])) + (: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 [round2]])) -(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)))))) +(def diagonals #'erv.meru.diagonals/diagonals) -(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))) +(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)))) -(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*))) +(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])))))) (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) @@ -165,15 +114,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 new file mode 100644 index 0000000..8281c14 --- /dev/null +++ b/src/erv/meru/diagonals.clj @@ -0,0 +1,123 @@ +(ns erv.meru.diagonals + "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])) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; V3 +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- slope->n-increment ;; TODO rename + [{:keys [x _y] :as _slope}] + (/ 1 x)) + +(defn- safe-division + ([a b] (safe-division 0 a b)) + ([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] (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-double ratio + :last-10 (take 10 (conj last-10 ratio)) + :convergence-index (inc convergence-index)))))) + {:convergence-double nil + :convergence-index -1 + :last-10 () + :series-data [(first (first parts))] + :reached-convergence? false} + parts))) + (#(dissoc % :last-10)) + (#(assoc % :series (mapv :value (:series-data %))))))) + +(defn intish? [n] (= n (int n))) + +(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) + +(defn diagonals + [{: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 + convergence?-fn convergence?-fn + convergence-precision (partial decimal-places-convergence?-fn convergence-precision) + :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-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] + {:value (->> coords + (map (fn [{:keys [x y]}] + (pascal-coord->number [x y]))) + (apply +)) + :coords (vec coords)})) + (convergence-analysis convergence?-fn) + update-convergence-data))) diff --git a/src/erv/meru/recurrent_series.cljc b/src/erv/meru/recurrent_series.cljc new file mode 100644 index 0000000..f761211 --- /dev/null +++ b/src/erv/meru/recurrent_series.cljc @@ -0,0 +1,78 @@ +(ns erv.meru.recurrent-series + (:require + [erv.meru.utils :refer [get-convergence-double-with-precision]])) + +(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 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)) + (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))] + {: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/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/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]))) 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/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/src/erv/scale/scl.cljc b/src/erv/scale/scl.cljc index 4326b28..5e56a36 100644 --- a/src/erv/scale/scl.cljc +++ b/src/erv/scale/scl.cljc @@ -133,3 +133,75 @@ (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 comments?] + :or {middle-note-freq (conv/midi->cps 60) + middle-note 60 + comments? true}}] + (let [scale-description (get-description-data scale-data) + scale (:scale scale-data) + scale-size (count scale)] + (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])) + + (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")))) 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/src/erv/types.cljc b/src/erv/types.cljc new file mode 100644 index 0000000..41e1301 --- /dev/null +++ b/src/erv/types.cljc @@ -0,0 +1,45 @@ +(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 %)]]) + +(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 + (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..5ccace6 100755 --- a/src/erv/utils/core.cljc +++ b/src/erv/utils/core.cljc @@ -120,3 +120,23 @@ "Find the greatest common divisor of a list of numbers" [nums] (reduce gcd nums)) + +(defn decompose-ratio + ([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." + [key-fn maps] + (reduce + (fn [acc m] + (assoc acc (key-fn m) m)) + {} + maps)) diff --git a/src/erv/utils/scale.clj b/src/erv/utils/scale.clj index 74beafa..43464fb 100644 --- a/src/erv/utils/scale.clj +++ b/src/erv/utils/scale.clj @@ -1,10 +1,14 @@ (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-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]}] @@ -103,15 +107,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})) @@ -143,10 +147,61 @@ (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 (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})) + +;; TODO add tests +;; +;; +;; +;; +;; +(defn proportional-difference + "Returns the difference between the ratios if the chord is proportional, otherwiser returns `nil`" + [ratios] + (let [ratio-analysis (decompose-ratios 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))) + (#(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/src/js/export_fn.cljs b/src/js/export_fn.cljs index 6799dba..125577c 100644 --- a/src/js/export_fn.cljs +++ b/src/js/export_fn.cljs @@ -3,7 +3,9 @@ [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.ratios :as ratios] [erv.utils.core :as utils])) (defn generate-exports [] @@ -11,4 +13,12 @@ :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) + :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))))}})) 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)))) diff --git a/test/erv/meru/core_test.clj b/test/erv/meru/core_test.clj index 6768a92..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, - :converges-at 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 new file mode 100644 index 0000000..91480da --- /dev/null +++ b/test/erv/meru/diagonals_test.clj @@ -0,0 +1,52 @@ +(ns erv.meru.diagonals-test + (:require + [clojure.test :refer [deftest is testing]] + [erv.math.pascals-triangle :as pascals-triangle] + [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/diagonal + {: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/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/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/diagonal + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number pascals-triangle/default-coord-map}) + ((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/diagonal + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number pascals-triangle/default-coord-map}) + :triangle-seed) + (->> (subject/diagonal + {:size 12 + :slope {:x 1 :y 2} + :convergence-precision 3 + :pascal-coord->number (pascals-triangle/make-coord-map 1 1 30)}) + :triangle-seed))))) diff --git a/test/erv/meru/recurrent_series_test.clj b/test/erv/meru/recurrent_series_test.clj new file mode 100644 index 0000000..a222a3e --- /dev/null +++ b/test/erv/meru/recurrent_series_test.clj @@ -0,0 +1,32 @@ +(ns erv.meru.recurrent-series-test + (:require + [clojure.test :refer [deftest is testing]] + [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 + (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/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) 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}])))) diff --git a/test/erv/utils/scale_test.clj b/test/erv/utils/scale_test.clj index d77074b..3d5883b 100644 --- a/test/erv/utils/scale_test.clj +++ b/test/erv/utils/scale_test.clj @@ -3,10 +3,11 @@ [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 - find-subset-degrees get-degrees rotate-scale - scale->stacked-subscale scale-intervals - scale-steps->degrees tritriadic]])) + [erv.utils.scale :refer [cross-set dedupe-scale degree-stack diamond + 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] @@ -207,3 +208,48 @@ (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])))))))) + +(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])))))