From e8d707717c57cdf02d04a057ff134d7af9f753c5 Mon Sep 17 00:00:00 2001 From: Connor Finley Date: Thu, 14 Sep 2023 17:09:16 -0400 Subject: [PATCH] Tests, Performance Improvements (#1) - Add unit tests for algorithms - Reduce scale generation time by 60+% - Avoid recalculating chord suggestions for blocks if they have already been calculated - Improve placement of suggested notes which were not played - Find best octave based on note distance - Fix same-pitch/octave-interval notes showing up as red (i.e. extra notes to not play) on piano roll - Improve clarity of some terms, function logic --- .github/workflows/test.yml | 16 +++ karma.conf.js | 54 ++++---- package.json | 21 +-- shadow-cljs.edn | 15 ++- src/why_does_that_sound_good/algo/chord.cljc | 62 ++++++--- src/why_does_that_sound_good/algo/scale.cljc | 120 ++++++++++-------- .../components/icons.cljs | 2 + .../components/live_suggestion_panel.cljs | 23 ++-- .../components/piano_panel.cljs | 2 +- .../components/scales_pane.cljs | 10 +- src/why_does_that_sound_good/events.cljs | 13 +- src/why_does_that_sound_good/utils.cljc | 22 ++-- .../algo/chord_test.cljc | 38 ++++++ .../algo/scale_test.cljc | 97 ++++++++++++++ test/why_does_that_sound_good/core_test.cljs | 7 - test/why_does_that_sound_good/test_utils.cljc | 20 +++ test/why_does_that_sound_good/utils_test.cljc | 84 ++++++++++++ 17 files changed, 458 insertions(+), 148 deletions(-) create mode 100644 .github/workflows/test.yml create mode 100644 test/why_does_that_sound_good/algo/chord_test.cljc create mode 100644 test/why_does_that_sound_good/algo/scale_test.cljc delete mode 100644 test/why_does_that_sound_good/core_test.cljs create mode 100644 test/why_does_that_sound_good/test_utils.cljc create mode 100644 test/why_does_that_sound_good/utils_test.cljc diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..f0517ba --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,16 @@ +name: Run tests + +on: [push, pull_request] + +jobs: + test: + name: Tests + runs-on: ubuntu-20.04 + steps: + - uses: actions/checkout@v3 + - name: Use Node.js + uses: actions/setup-node@v3 + with: + node-version: 18 + - run: npm ci + - run: 'npm run ci:node' diff --git a/karma.conf.js b/karma.conf.js index 5cf54d2..ec78e9a 100644 --- a/karma.conf.js +++ b/karma.conf.js @@ -1,27 +1,35 @@ module.exports = function (config) { - var junitOutputDir = process.env.CIRCLE_TEST_REPORTS || "target/junit" + var junitOutputDir = process.env.CIRCLE_TEST_REPORTS || "target/junit" - config.set({ - browsers: ['ChromeHeadless'], - basePath: 'target', - files: ['karma-test.js'], - frameworks: ['cljs-test'], - plugins: [ - 'karma-cljs-test', - 'karma-chrome-launcher', - 'karma-junit-reporter' - ], - colors: true, - logLevel: config.LOG_INFO, - client: { - args: ['shadow.test.karma.init'] - }, + config.set({ + browsers: ['ChromeHeadless'], + flags: [ + '--no-sandbox', + '--disable-web-security', + '--disable-gpu', + ], + browserDisconnectTimeout: 10000, + browserDisconnectTolerance: 3, + browserNoActivityTimeout: 60000, + basePath: 'target', + files: ['karma-test.js'], + frameworks: ['cljs-test'], + plugins: [ + 'karma-cljs-test', + 'karma-chrome-launcher', + 'karma-junit-reporter' + ], + colors: true, + logLevel: config.LOG_INFO, + client: { + args: ['shadow.test.karma.init'] + }, - // the default configuration - junitReporter: { - outputDir: junitOutputDir + '/karma', // results will be saved as outputDir/browserName.xml - outputFile: undefined, // if included, results will be saved as outputDir/browserName/outputFile - suite: '' // suite will become the package name attribute in xml testsuite element - } - }) + // the default configuration + junitReporter: { + outputDir: junitOutputDir + '/karma', // results will be saved as outputDir/browserName.xml + outputFile: undefined, // if included, results will be saved as outputDir/browserName/outputFile + suite: '' // suite will become the package name attribute in xml testsuite element + } + }) } diff --git a/package.json b/package.json index 4061ce8..a947c63 100644 --- a/package.json +++ b/package.json @@ -2,18 +2,19 @@ "name": "why-does-that-sound-good", "scripts": { "ancient": "clojure -Sdeps '{:deps {com.github.liquidz/antq {:mvn/version \"RELEASE\"}}}' -m antq.core", - "watch": "npx shadow-cljs watch app browser-test karma-test", + "watch": "npx shadow-cljs watch app node-test", "release": "npx shadow-cljs release app", "build-report": "npx shadow-cljs run shadow.cljs.build-report app target/build-report.html", - "ci": "npx shadow-cljs compile karma-test && npx karma start --single-run --reporters junit,dots" - }, - "dependencies": { - "highlight.js": "11.5.1", - "react": "17.0.2", - "react-dom": "17.0.2" - }, - "devDependencies": { - "karma": "6.4.0", + "ci:karma": "npx shadow-cljs compile karma-test && npx karma start --single-run --reporters junit,dots", + "ci:node": "npx shadow-cljs compile node-test && node target/node-test.js" + }, + "dependencies": { + "highlight.js": "11.5.1", + "react": "17.0.2", + "react-dom": "17.0.2" + }, + "devDependencies": { + "karma": "6.4.0", "karma-chrome-launcher": "3.1.1", "karma-cljs-test": "0.1.0", "karma-junit-reporter": "2.0.1", diff --git a/shadow-cljs.edn b/shadow-cljs.edn index 96a6607..b71dbfe 100644 --- a/shadow-cljs.edn +++ b/shadow-cljs.edn @@ -37,12 +37,15 @@ {:build-options {:ns-aliases {day8.re-frame.tracing day8.re-frame.tracing-stubs}}}} - :browser-test - {:target :browser-test - :ns-regexp "-test$" - :runner-ns shadow.test.browser - :test-dir "target/browser-test"} + ;; :browser-test + ;; {:target :browser-test + ;; :ns-regexp "-test$" + ;; :runner-ns shadow.test.browser + ;; :test-dir "target/browser-test"} :karma-test {:target :karma :ns-regexp "-test$" - :output-to "target/karma-test.js"}}} + :output-to "target/karma-test.js"} + :node-test + {:target :node-test + :output-to "target/node-test.js"}}} diff --git a/src/why_does_that_sound_good/algo/chord.cljc b/src/why_does_that_sound_good/algo/chord.cljc index b5af84f..fe443ea 100644 --- a/src/why_does_that_sound_good/algo/chord.cljc +++ b/src/why_does_that_sound_good/algo/chord.cljc @@ -27,9 +27,9 @@ (def ALL-CHORDS (into {} (for [root-pitch (vals pitch/REVERSE-NOTES) [chord-type intervals] pitch/CHORD - :let [combined-key {:root root-pitch :chord-type chord-type} + :let [chord-desc {:root root-pitch :chord-type chord-type} pitches (set (map #(pitch/interval->pitch root-pitch %) intervals))]] - [combined-key pitches]))) + [chord-desc pitches]))) (defn find-closest-note-name-to-pitch [pitch note-names] (loop [note-names note-names @@ -44,23 +44,43 @@ (recur (rest note-names) distance note-name) (recur (rest note-names) closest-distance closest-note-name)))))) +(defn find-closest-octave + "Find closest octave to note given a pitch (not necessarily same octave as note)" + [pitch closest-note] + (loop [octaves (map #(+ % (pitch/note->octave closest-note)) (range -1 2)) + min-distance 100 + closest-octave nil] + (if (empty? octaves) + closest-octave + (let [octave (first octaves) + note (pitch/construct-note pitch octave) + distance (abs (- closest-note note))] + (if (< distance min-distance) + (recur (rest octaves) distance octave) + (recur (rest octaves) min-distance closest-octave)))))) + (defn match-pitches-to-note-names "Try to match chord pitches (e.g. :D) to original note names (e.g. :D4) 1. Find exact matches between pitches and the pitches of the notes ({:D :D4}) 2. Separate out anything that wasn't matched (i.e. chord pitches which had no note match, and notes which had no chord pitch match)" - [pitches notes] - (let [note-pitch->note-name (reduce (fn [m note] (assoc m (pitch/find-pitch-class-name note) (pitch/find-note-name note))) {} notes) - chord-pitch->note-name (reduce (fn [m chord-pitch] (assoc m chord-pitch (get note-pitch->note-name chord-pitch))) {} pitches)] - {:matched-note-names (vals (into {} (filter (fn [[_ note-name]] (some? note-name)) - chord-pitch->note-name))) - :unmatched-pitches (keys (into {} (filter (fn [[_ note-name]] (nil? note-name)) - chord-pitch->note-name))) - :unmatched-note-names (filter (fn [note-name] - (not (some #(= % note-name) - (vals chord-pitch->note-name)))) - (vals note-pitch->note-name))})) + [chord-pitches original-notes] + (let [note-pitch->note-names (reduce (fn [m note] + ;; There might be multiple instances of the same pitch played; upsert them + (utils/upsert-in m [(pitch/find-pitch-class-name note)] (pitch/find-note-name note))) + {} + original-notes) + chord-pitch->note-names (reduce (fn [m chord-pitch] + (assoc m chord-pitch (get note-pitch->note-names chord-pitch))) + {} + chord-pitches) + {matched-chord-pitches true + unmatched-chord-pitches false} (group-by #(some? (val %)) chord-pitch->note-names)] + {:matched-note-names (flatten (vals matched-chord-pitches)) + :unmatched-pitches (or (keys unmatched-chord-pitches) (list)) + :unmatched-note-names (flatten (filter (fn [note-names] + (not (some #(= % note-names) (vals chord-pitch->note-names)))) + (vals note-pitch->note-names)))})) -;; TODO: keep same-pitch notes in chord, even if user plays same pitch in multiple octaves (defn get-relative-chord-notes "Voice chord closest to original notes AKA match chord pitch to closest original note octaves @@ -72,19 +92,19 @@ original-note-names-remaining (:unmatched-note-names matches) chord-notes []] (if (empty? chord-pitches-remaining) - (concat (map pitch/note (:matched-note-names matches)) chord-notes) + (sort (concat (map pitch/note (:matched-note-names matches)) chord-notes)) (let [chord-pitch (first chord-pitches-remaining) closest-note-name (when-not (empty? original-note-names-remaining) (find-closest-note-name-to-pitch chord-pitch original-note-names-remaining)) closest-octave (if (empty? original-note-names-remaining) original-octave-center - (:octave (pitch/note-info closest-note-name))) + (find-closest-octave chord-pitch (pitch/note closest-note-name))) chord-note (pitch/construct-note chord-pitch closest-octave)] (recur (rest chord-pitches-remaining) (remove #(= % closest-note-name) original-note-names-remaining) (conj chord-notes chord-note))))))) -(defn chord->readable-intervals [root chord-type] +(defn chord->readable-intervals [{:keys [root chord-type]}] (let [intervals (pitch/CHORD chord-type)] (reduce (fn [m interval] (let [pitch (pitch/interval->pitch root interval) @@ -97,10 +117,10 @@ (when (> (count notes) 1) (let [block-pitches (set (map pitch/find-pitch-class-name notes)) lowest-pitch (pitch/find-pitch-class-name (first (sort notes))) - chords (map (fn [[chord-key chord-pitches]] - (assoc chord-key + chords (map (fn [[chord-desc chord-pitches]] + (assoc chord-desc :chord-pitches chord-pitches - :similarity (utils/pitch-similarity block-pitches chord-pitches (:root chord-key)))) + :similarity (utils/pitch-similarity block-pitches chord-pitches (:root chord-desc)))) ALL-CHORDS) max-similarity-found (:similarity (apply max-key :similarity chords))] (->> chords @@ -110,7 +130,7 @@ (map #(assoc % :original-block-id (:id block) :lowest-note-root? (if (= lowest-pitch (:root %)) 1 0) - :chord-pitches->intervals (chord->readable-intervals (:root %) (:chord-type %)) + :chord-pitches->readable-intervals (chord->readable-intervals %) :chord-notes (get-relative-chord-notes notes (:chord-pitches %)))) (sort-by (juxt (comp - :similarity) (comp - :lowest-note-root?)))))))) diff --git a/src/why_does_that_sound_good/algo/scale.cljc b/src/why_does_that_sound_good/algo/scale.cljc index 3613305..cfa6ceb 100644 --- a/src/why_does_that_sound_good/algo/scale.cljc +++ b/src/why_does_that_sound_good/algo/scale.cljc @@ -6,43 +6,45 @@ [why-does-that-sound-good.algo.chord :as chord] [why-does-that-sound-good.utils :as utils])) -(defn steps-to-intervals +(defn steps->intervals " '(2 2 1 2) => '(0 2 4 5 7) " [steps] - (cons 0 (reductions + steps))) + (if (empty? steps) + (list 0) + (cons 0 (reductions + steps)))) (defn scale->pitches "[:C :major] => (2 2 1 2 2 2 1) => (0 2 4 5 7 9 12) => '(:C :D :E :F :G :A :B)" - [key scale] + [root-pitch scale-type] (->> - scale + scale-type pitch/SCALE - steps-to-intervals + steps->intervals butlast ; redundant root at end of scale - (map #(pitch/interval->pitch key %)))) + (map #(pitch/interval->pitch root-pitch %)))) (def ALL-SCALES (into {} (for [root-pitch (vals pitch/REVERSE-NOTES) scale-type (keys pitch/SCALE) - :let [combined-key {:root root-pitch :scale-type scale-type} + :let [scale-desc {:root root-pitch :scale-type scale-type} pitches (scale->pitches root-pitch scale-type)] :when (contains? pitch/ENABLED-SCALES scale-type)] - [combined-key pitches]))) + [scale-desc pitches]))) (defn pitches->scales [pitches & {:keys [min-scale-similarity find-closest?] :or {min-scale-similarity 0.95 find-closest? false}}] (when (> (count pitches) 1) - (let [scales (map (fn [[scale-key scale-pitches]] - (assoc scale-key + (let [scales (map (fn [[scale-desc scale-pitches]] + (assoc scale-desc :scale-pitches scale-pitches - :similarity (utils/pitch-similarity pitches (set scale-pitches) (:root scale-key)))) + :similarity (utils/pitch-similarity pitches (set scale-pitches) (:root scale-desc)))) ALL-SCALES) max-similarity-found (:similarity (apply max-key :similarity scales))] - (sort-by (comp - :similarity) - (filter #(if find-closest? - (= (:similarity %) max-similarity-found) - (>= (:similarity %) min-scale-similarity)) - scales))))) + (->> scales + (filter #(if find-closest? + (= (:similarity %) max-similarity-found) + (>= (:similarity %) min-scale-similarity))) + (sort-by (comp - :similarity)))))) (def max-chord-interval 21) ;; a 13th; highest interval in pitch/CHORD; anything higher can likely be folded down an octave @@ -58,7 +60,7 @@ (take max-chord-interval) (partition 2 1) (map #(apply utils/get-pitch-distance %)) - steps-to-intervals + steps->intervals (take-while #(<= % max-chord-interval)) (apply sorted-set))) @@ -75,15 +77,15 @@ {:root root-pitch :chord-type chord-type :chord-intervals chord-intervals - :chord-pitches->intervals (chord/chord->readable-intervals root-pitch chord-type) + :chord-pitches->readable-intervals (chord/chord->readable-intervals {:root root-pitch :chord-type chord-type}) :chord-notes (map #(+ root-note %) (sort chord-intervals))}) diatonic-chord-types))) (defn scale->diatonic-chords "For each pitch in scale, construct their diatonic chords" - [scale-index-key & {:keys [octave] - :or {octave 4}}] - (let [scale-pitches (get ALL-SCALES scale-index-key)] + [scale-desc & {:keys [octave] + :or {octave 4}}] + (let [scale-pitches (get ALL-SCALES scale-desc)] (zipmap scale-pitches (map-indexed (fn [idx scale-pitch] (let [last-pitch (if (zero? idx) nil (nth scale-pitches (dec idx))) @@ -104,7 +106,7 @@ all-chords-for-root (get all-chords root-pitch)] (assoc all-chords root-pitch ;; TODO: after similarity, sort by 'popularity'/complexity - (sort-by (comp - :similarity) + (sort-by (comp - #(or (:similarity %) 0)) (map (fn [all-chord] (if (= (:chord-type chord) (:chord-type all-chord)) chord ; Replace scale chord with suggested chord [has :similarity, block Id] @@ -123,48 +125,64 @@ scales (pitches->scales combined-variation-combo-pitches :min-scale-similarity min-scale-similarity :find-closest? find-closest?) lowest-octave (min (pitch/note->octave (apply min combined-variation-combo-notes))) chord-blocks (filter #(some? (:chord-notes %)) block-variation-combo)] - (reduce (fn [new-scales scale] - (let [scale-key (select-keys scale [:root :scale-type]) - diatonic-chords (scale->diatonic-chords scale-key :octave lowest-octave)] - (if (contains? new-scales scale-key) - (update-in new-scales [scale-key :chord-combos] conj block-variation-combo) - (assoc new-scales scale-key - {:scale-pitches (:scale-pitches scale) - :combined-pitches combined-variation-combo-pitches - :original-pitches original-pitches - :variation-combo-pitch-similarity (:similarity scale) ;; Similarity based on the variation combo (could include chord suggestions) - :original-pitch-similarity (utils/pitch-similarity original-pitches (set (:scale-pitches scale)) (:root scale-key)) ;; Similarity based on exactly what was played/selected - :chord-combos [block-variation-combo] - :all-chords (merge-chord-suggestions-with-scale-diatonic-chords chord-blocks diatonic-chords)})))) - current-scales - scales))) + (reduce (fn [final-scales scale] + (let [scale-desc (select-keys scale [:root :scale-type]) + diatonic-chords (scale->diatonic-chords scale-desc :octave lowest-octave)] + (if (contains? final-scales scale-desc) + ;; Might not be necessary to track chord combos for a scale + (update-in final-scales [scale-desc :chord-combos] conj block-variation-combo) + (assoc final-scales scale-desc + {:scale-pitches (:scale-pitches scale) + :combined-pitches combined-variation-combo-pitches + :original-pitches original-pitches + :variation-combo-pitch-similarity (:similarity scale) ;; Similarity based on the variation combo (could include chord suggestions) + :original-pitch-similarity (utils/pitch-similarity original-pitches (set (:scale-pitches scale)) (:root scale-desc)) ;; Similarity based on exactly what was played/selected + :chord-combos [block-variation-combo] + :all-chords (merge-chord-suggestions-with-scale-diatonic-chords chord-blocks diatonic-chords)})))) + current-scales + scales))) + +(defn blocks->block-variations + "For each block, return a list of variations. + If the block has 2+ notes, return the chord suggestions. + If the block only has one note, return the note in a list. + Leverage pre-existing chord suggestions {block-id suggestions} if provided (true if within UI context)" + [blocks & {:keys [pregenerated-block-chord-suggestions] + :or {pregenerated-block-chord-suggestions {}}}] + (let [{chord-blocks true + note-blocks false} (group-by #(>= (count (:notes %)) 2) blocks) + {blocks-with-chord-selection true + blocks-without-chord-selection false} (group-by #(some? (:selected-suggestion %)) chord-blocks) + selected-chords (->> blocks-with-chord-selection + (map :selected-suggestion) + (remove nil?) + (map list)) + new-chords (->> blocks-without-chord-selection + ;; UI will pass in existing block chord suggestions (:chord-suggestions db) to avoid recalculation + ;; Running outside of UI context will generate chord suggestions for any blocks which haven't selected any (selection stored in block) + (map #(or (get pregenerated-block-chord-suggestions (:id %)) + (chord/mem-block->chords % :find-closest? true))))] + (concat selected-chords new-chords (map list note-blocks)))) ;; seq of variations for every block (defn blocks->scales "Find scales by combining block variations (i.e. chord suggestion if 2+ notes in block or individual note) Returns similar scales with diatonic chords + any suggested chords" - [blocks & {:keys [min-scale-similarity find-closest?] - :or {min-scale-similarity 0.95 find-closest? false}}] + [blocks & {:keys [min-scale-similarity find-closest? pregenerated-block-chord-suggestions] + :or {min-scale-similarity 0.95 find-closest? false pregenerated-block-chord-suggestions {}}}] (let [original-pitches (->> blocks (map utils/block->pitches) (apply set/union)) - {chord-blocks true note-blocks false} (group-by #(>= (count (:notes %)) 2) blocks) - existing-chords (->> chord-blocks - (map :selected-suggestion) - (remove nil?) - (map list)) - new-chords (->> chord-blocks - (filter #(nil? (:selected-suggestion %))) - (map #(chord/block->chords % :find-closest? true))) - block-variations (concat existing-chords new-chords (map list note-blocks)) ;; seq of variations for every block + block-variations (blocks->block-variations blocks :pregenerated-block-chord-suggestions pregenerated-block-chord-suggestions) ;; seq of variations for every block block-variation-combos (apply combo/cartesian-product block-variations)] (loop [combos block-variation-combos scales {} seen-pitch-sets #{}] (if (empty? combos) - (into (sorted-map-by (fn [scale-key-1 scale-key-2] + (into (sorted-map-by (fn [scale-desc-1 scale-desc-2] + ;; Compare similarity _and_ scale name since going into map where similarity might be same across multiple scales ;; Should maybe compare :original-pitch-similarity, though might be close enough - (compare [(get-in scales [scale-key-2 :variation-combo-pitch-similarity]) (utils/music-structure->str scale-key-2)] - [(get-in scales [scale-key-1 :variation-combo-pitch-similarity]) (utils/music-structure->str scale-key-1)]))) + (compare [(get-in scales [scale-desc-2 :variation-combo-pitch-similarity]) (utils/music-structure->str scale-desc-2)] + [(get-in scales [scale-desc-1 :variation-combo-pitch-similarity]) (utils/music-structure->str scale-desc-1)]))) scales) (let [variation-combo (first combos) combined-variation-combo-notes (apply set/union (map #(or (:chord-notes %) (:notes %)) variation-combo)) diff --git a/src/why_does_that_sound_good/components/icons.cljs b/src/why_does_that_sound_good/components/icons.cljs index cac3277..65720e8 100644 --- a/src/why_does_that_sound_good/components/icons.cljs +++ b/src/why_does_that_sound_good/components/icons.cljs @@ -1,6 +1,8 @@ (ns why-does-that-sound-good.components.icons (:require [clojure.string :as str])) +;; These exist as svg tags instead of img tags so that I can style them (e.g. fill) + (def icon-classes "h-5 w-5 dark:fill-neutral-100 group-hover:dark:fill-neutral-900") (defn icon [{:keys [class view-box]} & children] diff --git a/src/why_does_that_sound_good/components/live_suggestion_panel.cljs b/src/why_does_that_sound_good/components/live_suggestion_panel.cljs index 055b27d..5f8b330 100644 --- a/src/why_does_that_sound_good/components/live_suggestion_panel.cljs +++ b/src/why_does_that_sound_good/components/live_suggestion_panel.cljs @@ -21,9 +21,7 @@ (re-frame/dispatch [::events/on-chord-suggestion-hover s]) (reset! hovered? true)) :on-mouse-leave #(do (re-frame/dispatch [::events/on-chord-suggestion-hover nil]) - (reset! hovered? false)) - :title "Click to play" - :on-click #(re-frame/dispatch [::events/on-notes-play (:chord-notes s)])} + (reset! hovered? false))} [:div {:class (str/join " " [(if @hovered? "visible" "invisible") "relative right-4"])} [button @@ -37,6 +35,8 @@ (utils/music-structure->str s)] [similarity-badge (:similarity s)]] [:div + {:on-click #(re-frame/dispatch [::events/on-notes-play (:chord-notes s)]) + :title "Click to play"} [piano-preview (:notes block) :chord-notes (:chord-notes s)]]]))) (defn live-block-chord-suggestions [block suggestions & {:keys [current?] @@ -60,8 +60,6 @@ :on-mouse-leave #(re-frame/dispatch [::events/on-block-hover-toggle nil])} [:div {:class " flex items-center justify-between w-full cursor-pointer py-3 px-8 dark:bg-neutral-600 rounded-t-xl" - :on-click #(re-frame/dispatch [::events/on-notes-play (:notes block)]) - :title "Click to play" :on-mouse-enter #(reset! hovered? true) :on-mouse-leave #(reset! hovered? false)} [:div @@ -79,7 +77,10 @@ [:span {:class "dark:text-neutral-100"} "Input"] - [piano-preview (:notes block)]] + [:div + {:on-click #(re-frame/dispatch [::events/on-notes-play (:notes block)]) + :title "Click to play"} + [piano-preview (:notes block)]]] [live-block-chord-suggestions block chord-suggestions :current? current?]])))) (defn live-section-panel [] @@ -89,11 +90,11 @@ [:<> (when (seq live-section-blocks) [button - {:class "flex gap-x-2 items-center self-start" - :on-click #(when (js/confirm "Are you sure you want to delete all live blocks?") - (re-frame/dispatch [::events/on-section-clear :live]))} - [delete-icon] - "Clear Live Blocks"]) + {:class "flex gap-x-2 items-center self-start" + :on-click #(when (js/confirm "Are you sure you want to delete all live blocks?") + (re-frame/dispatch [::events/on-section-clear :live]))} + [delete-icon] + "Clear Live Blocks"]) [:div {:class (str/join " " [(when (= 1 max-live-blocks) "justify-center") "flex grow gap-x-4 overflow-y-auto"])} (when (< 1 max-live-blocks) diff --git a/src/why_does_that_sound_good/components/piano_panel.cljs b/src/why_does_that_sound_good/components/piano_panel.cljs index d15e858..7350d1e 100644 --- a/src/why_does_that_sound_good/components/piano_panel.cljs +++ b/src/why_does_that_sound_good/components/piano_panel.cljs @@ -54,7 +54,7 @@ highlighted? (or (utils/in? live-notes (:midi key)) (utils/in? notes (:midi key))) chord-note? (utils/in? (:chord-notes temp-chord-suggestion) (:midi key)) overridden? (and notes-overridden? highlighted?) - interval (if chord-note? (get (:chord-pitches->intervals temp-chord-suggestion) (:pitch key)) nil) + interval (if chord-note? (get (:chord-pitches->readable-intervals temp-chord-suggestion) (:pitch key)) nil) key-color (if white? (cond overridden? white-key-color-overridden diff --git a/src/why_does_that_sound_good/components/scales_pane.cljs b/src/why_does_that_sound_good/components/scales_pane.cljs index e837c96..13ec7ec 100644 --- a/src/why_does_that_sound_good/components/scales_pane.cljs +++ b/src/why_does_that_sound_good/components/scales_pane.cljs @@ -82,12 +82,12 @@ :max 100 :on-change #(re-frame/dispatch [::events/on-section-min-scale-similarity-change section-id (-> % .-target .-value js/parseInt (/ 100))])}] [:div.max-h-full.overflow-y-auto.flex.flex-col.divide-y.dark:divide-neutral-400 - (for [[scale-key scale-details] suggestions] - ^{:key scale-key} + (for [[scale-desc scale-details] suggestions] + ^{:key (utils/music-structure->str scale-desc)} [:div.p-4.pl-0 [:div.flex.justify-between.items-center [:div.flex.flex-col.items-start.gap-y - [:h3.text-xl.font-bold (:root scale-key) " " (:scale-type scale-key)] + [:h3.text-xl.font-bold (:root scale-desc) " " (:scale-type scale-desc)] [similarity-badge (:variation-combo-pitch-similarity scale-details)]] ;; Should maybe be :original-pitch-similarity, though might close enough [scale-piano-preview (:scale-pitches scale-details)]] [:div.ml-4 @@ -103,8 +103,8 @@ (fn [] (let [suggestions @(re-frame/subscribe [::subs/section-scale-suggestions (:id section)]) top-suggestion (first suggestions) - [scale-key _] (or top-suggestion []) - top-name (if scale-key (str/join " " [(name (:root scale-key)) (name (:scale-type scale-key))]) "None") + [scale-desc _] (or top-suggestion []) + top-name (if scale-desc (utils/music-structure->str scale-desc :space? true) "None") display-text "Top scale suggestion: "] (if (< 1 (count (:block-ids section))) [:<> diff --git a/src/why_does_that_sound_good/events.cljs b/src/why_does_that_sound_good/events.cljs index 54ee1c4..05938bb 100644 --- a/src/why_does_that_sound_good/events.cljs +++ b/src/why_does_that_sound_good/events.cljs @@ -105,7 +105,7 @@ (assoc :min-chord-similarity (:min-chord-similarity block)) (cond-> ;; Select chord suggestion if saving from live block's suggestions - (not (nil? chord)) (assoc :selected-suggestion chord))) + (some? chord) (assoc :selected-suggestion chord))) chord-suggestions (get-in db [:chord-suggestions (:id block)])] (-> db (assoc-in [:data :blocks next-block-id] new-block) @@ -409,10 +409,11 @@ :or {min-similarity nil}}]] (let [section-block-ids (get-in db [:data :sections section-id :block-ids]) blocks (vals (select-keys (get-in db [:data :blocks]) section-block-ids)) + pregenerated-block-chord-suggestions (select-keys (:chord-suggestions db) section-block-ids) scales (when (<= 2 (count blocks)) (if (nil? min-similarity) - (scale/mem-blocks->scales blocks :find-closest? true) - (scale/mem-blocks->scales blocks :min-scale-similarity min-similarity)))] + (scale/mem-blocks->scales blocks :pregenerated-block-chord-suggestions pregenerated-block-chord-suggestions :find-closest? true) + (scale/mem-blocks->scales blocks :pregenerated-block-chord-suggestions pregenerated-block-chord-suggestions :min-scale-similarity min-similarity)))] (-> db (assoc-in [:scale-suggestions section-id] scales) (cond-> @@ -424,9 +425,10 @@ (assoc db :scale-suggestions (reduce (fn [m [section-id section]] (let [section-block-ids (:block-ids section) - blocks (vals (select-keys (get-in db [:data :blocks]) section-block-ids))] + blocks (vals (select-keys (get-in db [:data :blocks]) section-block-ids)) + pregenerated-block-chord-suggestions (select-keys (:chord-suggestions db) section-block-ids)] (when (<= 2 (count blocks)) - (assoc m section-id (scale/mem-blocks->scales blocks :find-closest? true))))) + (assoc m section-id (scale/mem-blocks->scales blocks :pregenerated-block-chord-suggestions pregenerated-block-chord-suggestions :find-closest? true))))) {} (get-in db [:data :sections]))))) @@ -440,6 +442,7 @@ ;; TODO dispatch scale generation and/or merge this into a bigger 'add block to section' event handler (reg-event-db ::on-scale-chord-save + db->local-store (fn [db [_ chord]] (let [next-block-id (get-in db [:data :next-block-id]) new-block (-> (db/create-block next-block-id) diff --git a/src/why_does_that_sound_good/utils.cljc b/src/why_does_that_sound_good/utils.cljc index a3c9592..89077de 100644 --- a/src/why_does_that_sound_good/utils.cljc +++ b/src/why_does_that_sound_good/utils.cljc @@ -1,7 +1,8 @@ (ns why-does-that-sound-good.utils (:require - [why-does-that-sound-good.pitch :as pitch] - [clojure.set :as set])) + [clojure.set :as set] + [clojure.string :as str] + [why-does-that-sound-good.pitch :as pitch])) (defn block->used-notes [block] (or (get-in block [:selected-suggestion :chord-notes]) @@ -15,7 +16,7 @@ set)) (defn in? - "true if coll contains element" + "true if coll contains element, else nil" [coll el] (some #(= el %) coll)) @@ -28,8 +29,9 @@ (get-cyclic-distance (pitch/NOTES a) (pitch/NOTES b) (count pitch/REVERSE-NOTES))) (defn music-structure->str - [{:keys [root chord-type scale-type]}] - (str (name root) (name (or chord-type scale-type)))) + [{:keys [root chord-type scale-type]} & {:keys [space?] + :or {space? false}}] + (str/join (if space? " " "") [(name root) (name (or chord-type scale-type))])) (defn median [coll] (if (= (count coll) 1) @@ -45,15 +47,14 @@ (defn pitch-similarity "Get Jaccard Index of input pitches vs. chord/scale pitches (weighted more if root pitch in input)" - [input-pitches dest-pitches dest-root] + [input-pitches dest-pitches dest-pitches-root] (let [jaccard-index (jaccard-index input-pitches dest-pitches) - dest-root-in-pitches (contains? input-pitches dest-root) + dest-root-in-pitches (contains? input-pitches dest-pitches-root) dest-root-in-input-pitches-weight 1 dest-root-in-input-pitches-coefficient (if dest-root-in-pitches dest-root-in-input-pitches-weight 0)] (/ (+ jaccard-index dest-root-in-input-pitches-coefficient) (+ 1 dest-root-in-input-pitches-weight)))) - (defn pitches->example-notes "For showing scale pitches on piano preview at middle C Add root pitch to end as well to round it out" @@ -69,3 +70,8 @@ (if pitch-match? (recur (conj notes note) (range (inc note) 85) (subvec ps 1)) (recur notes (range (inc note) 85) ps)))))) + +(defn upsert-in [m ks v] + (if (get-in m ks) + (update-in m ks conj v) + (assoc-in m ks [v]))) diff --git a/test/why_does_that_sound_good/algo/chord_test.cljc b/test/why_does_that_sound_good/algo/chord_test.cljc new file mode 100644 index 0000000..c575613 --- /dev/null +++ b/test/why_does_that_sound_good/algo/chord_test.cljc @@ -0,0 +1,38 @@ +(ns why-does-that-sound-good.algo.chord-test + (:require + [clojure.test :refer [deftest are]] + [why-does-that-sound-good.pitch :as pitch] + [why-does-that-sound-good.algo.chord :as chord])) + +(deftest find-closest-octave-test + (are [pitch closest-note expected-closest-octave] (= expected-closest-octave (chord/find-closest-octave pitch closest-note)) + :C (pitch/note :C4) 4 + :B (pitch/note :C4) 3)) + +(deftest get-relative-chord-notes-test + (are [original-notes chord-pitches expected-notes] (= expected-notes (chord/get-relative-chord-notes original-notes chord-pitches)) + [60 64 67] #{:C :E :G} '(60 64 67) + [60 64 67] #{:C :E :G :B} '(60 64 67 71) + [60 64 67 71] #{:C :E :G} '(60 64 67) + [60 64 67 72] #{:C :E :G} '(60 64 67 72))) + +(deftest block->chords-test + (are [block expected-chords] (= expected-chords (chord/block->chords block :find-closest? true)) + {:id 1 :notes #{60 64 67}} '({:root :C + :chord-type :maj + :chord-pitches #{:C :G :E} + :similarity 1 + :original-block-id 1 + :lowest-note-root? 1 + :chord-pitches->readable-intervals {:C :1 :G :5 :E :M3} + :chord-notes (60 64 67)} + {:root :E + :chord-type :m+5 + :chord-pitches #{:E :G :C} + :similarity 1 + :original-block-id 1 + :lowest-note-root? 0 + :chord-pitches->readable-intervals {:E :1 :G :m3 :C :+5} + :chord-notes (60 64 67)}) + + {:id 1 :notes #{}} nil)) diff --git a/test/why_does_that_sound_good/algo/scale_test.cljc b/test/why_does_that_sound_good/algo/scale_test.cljc new file mode 100644 index 0000000..dc12561 --- /dev/null +++ b/test/why_does_that_sound_good/algo/scale_test.cljc @@ -0,0 +1,97 @@ +(ns why-does-that-sound-good.algo.scale-test + (:require + [clojure.test :refer [deftest testing is are]] + [why-does-that-sound-good.algo.scale :as scale])) + +(deftest steps->intervals-test + (are [input-steps expected-intervals] (= expected-intervals (scale/steps->intervals input-steps)) + () '(0) + '(1 2 3) '(0 1 3 6) + '(2 2 1 2 2 2 1) '(0 2 4 5 7 9 11 12))) + +(deftest scale->pitches-test + (are [root-pitch scale-type expected-pitches] (= expected-pitches (scale/scale->pitches root-pitch scale-type)) + :C :major '(:C :D :E :F :G :A :B) + :C :minor '(:C :D :Eb :F :G :Ab :Bb) + :C# :major '(:C# :Eb :F :F# :Ab :Bb :C) + ;; TODO: convert accidentals accordingly + :Db :major '(:C# :Eb :F :F# :Ab :Bb :C))) + +(deftest scale-pitches->intervals-test + ;; Intervals all the way to up a 13th + (is (= #{0 2 4 5 7 9 11 12 14 16 17 19 21} (scale/scale-pitches->intervals #{:C :D :E :F :G :A :B} :C)))) + +(deftest pitches->scales-test + (testing "find-closest? true" + (is (= '({:root :C, + :scale-type :major, + :scale-pitches (:C :D :E :F :G :A :B), + :similarity 1.0} + {:root :A, + :scale-type :minor, + :scale-pitches (:A :B :C :D :E :F :G), + :similarity 1.0}) + (scale/pitches->scales #{:C :D :E :F :G :A :B} :find-closest? true)))) + (testing "min-similarity" + (is (= '({:root :C, + :scale-type :major, + :scale-pitches (:C :D :E :F :G :A :B), + :similarity 0.9375} + {:root :A, + :scale-type :melodic-major, + :scale-pitches (:A :B :C# :D :E :F :G), + :similarity 0.9375} + {:root :D, + :scale-type :melodic-minor, + :scale-pitches (:D :E :F :G :A :B :C#), + :similarity 0.9375} + {:root :A, + :scale-type :minor, + :scale-pitches (:A :B :C :D :E :F :G), + :similarity 0.9375}) + (scale/pitches->scales #{:C :C# :D :E :F :G :A :B} :min-scale-similarity 0.90))))) + +(deftest scale-pitch->diatonic-chords-test + (is (= '({:root :C, + :chord-type :maj, + :chord-intervals #{0 7 4}, + :chord-pitches->readable-intervals {:C :1, :G :5, :E :M3}, + :chord-notes (60 64 67)} + {:root :C, + :chord-type :6*9, + :chord-intervals #{0 7 4 9 14}, + :chord-pitches->readable-intervals {:C :1, :G :5, :E :M3, :A :6, :D :9}, + :chord-notes (60 64 67 69 74)} + {:root :C, + :chord-type :maj7, + :chord-intervals #{0 7 4 11}, + :chord-pitches->readable-intervals {:C :1, :G :5, :E :M3, :B :M7}, + :chord-notes (60 64 67 71)} + {:root :C, + :chord-type :maj9, + :chord-intervals #{0 7 4 11 14}, + :chord-pitches->readable-intervals {:C :1, :G :5, :E :M3, :B :M7, :D :9}, + :chord-notes (60 64 67 71 74)} + {:root :C, + :chord-type :maj11, + :chord-intervals #{0 7 4 17 11 14}, + :chord-pitches->readable-intervals + {:C :1, :G :5, :E :M3, :F :11, :B :M7, :D :9}, + :chord-notes (60 64 67 71 74 77)} + {:root :C, + :chord-type :sus2, + :chord-intervals #{0 7 2}, + :chord-pitches->readable-intervals {:C :1, :G :5, :D :M2}, + :chord-notes (60 62 67)} + {:root :C, + :chord-type :6, + :chord-intervals #{0 7 4 9}, + :chord-pitches->readable-intervals {:C :1, :G :5, :E :M3, :A :6}, + :chord-notes (60 64 67 69)} + {:root :C, + :chord-type :sus4, + :chord-intervals #{0 7 5}, + :chord-pitches->readable-intervals {:C :1, :G :5, :F :4}, + :chord-notes (60 65 67)}) + (scale/scale-pitch->diatonic-chords (get scale/ALL-SCALES {:root :C :scale-type :major}) + :C)))) diff --git a/test/why_does_that_sound_good/core_test.cljs b/test/why_does_that_sound_good/core_test.cljs deleted file mode 100644 index b69f5f6..0000000 --- a/test/why_does_that_sound_good/core_test.cljs +++ /dev/null @@ -1,7 +0,0 @@ -(ns why-does-that-sound-good.core-test - (:require [cljs.test :refer-macros [deftest testing is]] - [why-does-that-sound-good.core :as core])) - -(deftest fake-test - (testing "fake description" - (is (= 1 2)))) diff --git a/test/why_does_that_sound_good/test_utils.cljc b/test/why_does_that_sound_good/test_utils.cljc new file mode 100644 index 0000000..30b31dc --- /dev/null +++ b/test/why_does_that_sound_good/test_utils.cljc @@ -0,0 +1,20 @@ +(ns why-does-that-sound-good.test-utils + (:require + [why-does-that-sound-good.algo.chord :as chord] + [why-does-that-sound-good.pitch :as pitch])) + +(defn chord->example-notes [root chord-type] + (->> {:root root :chord-type chord-type} + chord/ALL-CHORDS + (map #(pitch/construct-note % 4)))) + +(def c-major-blocks + (map-indexed (fn [i [root chord-type]] + {:id i :notes (chord->example-notes root chord-type)}) + [[:C :maj] + [:D :min] + [:E :min] + [:F :maj] + [:G :maj] + [:A :min] + [:B :dim]])) diff --git a/test/why_does_that_sound_good/utils_test.cljc b/test/why_does_that_sound_good/utils_test.cljc new file mode 100644 index 0000000..a86a0f2 --- /dev/null +++ b/test/why_does_that_sound_good/utils_test.cljc @@ -0,0 +1,84 @@ +(ns why-does-that-sound-good.utils-test + (:require + [clojure.test :refer [deftest testing is are]] + [why-does-that-sound-good.utils :as utils])) + +(deftest block->used-notes-test + (testing "with just notes, no block wrapper/metadata" + (is (= #{60 64 67} (utils/block->used-notes #{60 64 67})))) + (testing "with block, no chord selection" + (is (= #{60 64 67} (utils/block->used-notes {:id 1 :notes #{60 64 67}})))) + (testing "with block and chord selection" + (is (= '(60 64 67) (utils/block->used-notes {:id 1 :notes #{60 64 67} :selected-suggestion {:root :C :chord-type :major :chord-notes '(60 64 67)}}))))) + +(deftest block->pitches-test + (testing "with just notes, no block wrapper/metadata" + (is (= #{:C :E :G} (utils/block->pitches #{60 64 67})))) + (testing "with block, no chord selection" + (is (= #{:C :E :G} (utils/block->pitches {:id 1 :notes #{60 64 67}})))) + (testing "with block and chord selection" + (is (= #{:C :E :G} (utils/block->pitches {:id 1 :notes #{60 64 67} :selected-suggestion {:root :C :chord-type :major :chord-notes '(60 64 67)}}))))) + +(deftest in?-test + (are [coll el expected] (= expected (utils/in? coll el)) + [] 1 nil + [1 2 3] 1 true + [1 2 3] 4 nil)) + +(deftest get-cyclic-distance-test + (are [start end total-length expected-distance] (= expected-distance (utils/get-cyclic-distance start end total-length)) + 1 1 10 0 + 2 1 10 1 ;; Going backwards in the cycle is shorter + 3 1 10 2 + 4 1 10 3 + 5 1 10 4 + 6 1 10 5 ;; Furthest distance + 7 1 10 4 ;; Going forwards and wrapping around the cycle is shorter now + 8 1 10 3 + 9 1 10 2 + 10 1 10 1)) + +(deftest get-pitch-distance + (are [start-pitch end-pitch expected-distance] (= expected-distance (utils/get-pitch-distance start-pitch end-pitch)) + :C :C 0 + :C# :C 1 ;; Going backwards in the cycle is shorter + :Db :C 1 ;; Either accidental representation works + :D :C 2 + :D# :C 3 + :E :C 4 + :F :C 5 + :F# :C 6 ;; Furthest distance + :G :C 5 + :G# :C 4 ;; Going forwards and wrapping around to next C is shorter now + :A :C 3 + :A# :C 2 + :B :C 1)) + +(deftest music-structure->str-test + (testing "chord" + (is (= "Cmaj" (utils/music-structure->str {:root :C :chord-type :maj}))) + (is (= "C#maj" (utils/music-structure->str {:root :C# :chord-type :maj})))) + (testing "scale" + (is (= "Cmajor" (utils/music-structure->str {:root :C :scale-type :major})))) + (testing "supports spaces" + (is (= "C major" (utils/music-structure->str {:root :C :scale-type :major} :space? true))))) + +(deftest jaccard-index-test + (are [set-1 set-2 expected-index] (= expected-index (utils/jaccard-index set-1 set-2)) + #{1 2 3} #{1 2 3} 1.0 + #{1 2 3 4} #{1 2} 0.5 + #{1 2} #{1 2 3 4} 0.5 ;; order-independent + #{} #{} 0 + #{1 2} #{3 4} 0.0)) + +(deftest pitch-similarity-test + (are [input-pitches dest-pitches dest-pitches-root expected-index] (= expected-index (utils/pitch-similarity input-pitches dest-pitches dest-pitches-root)) + #{:C :D :E} #{:C :D :E} :C 1.0 + #{:C :D :E :F} #{:C :D} :C 0.75 ;; If chord/scale root pitch is in input-pitches, give more weight (base Jaccard Index would normally be 0.5) + #{} #{} :C 0 + #{:C :D} #{:E :F} :C 0.5)) + +(deftest upsert-in-test + (are [m ks v expected] (= expected (utils/upsert-in m ks v)) + {} [:foo] 1 {:foo [1]} + {:foo [1]} [:foo] 2 {:foo [1 2]}))