Skip to content

Commit

Permalink
Tests, Performance Improvements (#1)
Browse files Browse the repository at this point in the history
- 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
  • Loading branch information
cofinley authored Sep 14, 2023
1 parent 1767144 commit e8d7077
Show file tree
Hide file tree
Showing 17 changed files with 458 additions and 148 deletions.
16 changes: 16 additions & 0 deletions .github/workflows/test.yml
Original file line number Diff line number Diff line change
@@ -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'
54 changes: 31 additions & 23 deletions karma.conf.js
Original file line number Diff line number Diff line change
@@ -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
}
})
}
21 changes: 11 additions & 10 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
15 changes: 9 additions & 6 deletions shadow-cljs.edn
Original file line number Diff line number Diff line change
Expand Up @@ -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"}}}
62 changes: 41 additions & 21 deletions src/why_does_that_sound_good/algo/chord.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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?))))))))

Expand Down
Loading

0 comments on commit e8d7077

Please sign in to comment.