-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathanalysis.lisp
156 lines (129 loc) · 5.47 KB
/
analysis.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
;;;; analysis.lisp
;;;;
;;;; Copyright (c) 2022 Izaak Walton
(in-package #:vibratsia)
;;; Sympathetic analysis functions
(defun symp-collection (pitch strings)
"Collects all resonant notes for each string"
(cond ((null strings) nil)
(t (append (compare-overtones pitch (first strings))
(symp-collection pitch (rest strings))))))
(defmethod freq-rating ((instrument instrument) freq)
(length (symp-collection freq (mapcar #'freq-float (strings instrument)))))
(defmethod note-rating ((note note) instrument)
"Takes note and instrument,
returns the total number of sympathetic vibrations."
(length (symp-collection (freq-float note) (mapcar #'freq-float (strings instrument)))))
(defun string-symping (pitch strings)
(cond ((null strings) nil)
(t (append (list (list (note-name (first strings)) 'string)
(mapcar #'make-note (compare-overtones pitch (freq-float (first strings)))))
(string-symping pitch (rest strings))))))
(defmethod symp-by-string ((instrument instrument) freq)
"Compiles a list of sympathetic vibrations organized by string."
(string-symping freq (strings instrument)))
;;; Resonance Stat Generation
(defclass note-assessment ()
((note-obj :initarg :note-obj
:accessor note-obj)
(instr :initarg :instr
:accessor instr)
(rating :initarg :rating
:accessor rating)
(res-list :initarg :res-list
:accessor res-list)))
(defmethod assess-note ((instrument instrument) note)
(make-instance 'note-assessment :note-obj note
:instr instrument
:rating (note-rating note instrument)
:res-list (symp-by-string
instrument (freq-float note))))
(defmethod print-object ((obj note-assessment) stream)
(print-unreadable-object (obj stream :type t)
(with-accessors ((note-obj note-obj)
(instr instr)
(rating rating)
(res-list res-list))
obj
(format stream "~%The resonant profile of:~%~%~a
~%as played on the: ~%~a~%
~%Sympathetic Vibration Rating: ~a, which is ~a.~%
~%A list of Frequencies by String:~%~%~{~a~%~}"
note-obj instr rating
(cond ((> rating 20) "highly resonant")
((> rating 10) "moderately resonant")
((<= rating 10) "marginally resonant"))
res-list))))
;;; Instrument Resonance Profile
(defmethod most-resonant ((instrument instrument))
(loop :with most-res := (first (frequency-ladder (lower-bound instrument)
(upper-bound instrument)))
:for f in (frequency-ladder (lower-bound instrument)
(upper-bound instrument))
:when (> (note-rating (make-note f) instrument)
(note-rating (make-note most-res) instrument))
:do (setf most-res f)
:finally (return (make-note most-res))))
(defmethod resonance-ranking ((instrument instrument))
(mapcar #'(lambda (f)
(list (note-rating (make-note f) instrument) (make-note f)))
(sort (frequency-ladder (lower-bound instrument)
(upper-bound instrument))
#'(lambda (freq1 freq2)
(> (note-rating (make-note freq1) instrument) (note-rating (make-note freq2) instrument))))))
(defmethod optimal-keys ((instrument instrument))
(mapcar #'(lambda (scale)
(list (round (avg-resonance instrument (notes scale)))
(first (freq-to-note (root scale)))
(quality scale)))
(sort (mapcar #'(lambda (note) (build-scale note 'major 3))
(frequency-ladder (lower-bound instrument) (freq-adjust (lower-bound instrument) 11)))
#'(lambda (scale1 scale2)
(> (avg-resonance instrument (notes scale1)) (avg-resonance instrument (notes scale2)))))))
;;; Instrument assessment
(defclass instrument-assessment ()
((instrument :initarg :instrument
:accessor instrument)
(key-ranks :initarg :key-ranks
:accessor key-ranks)
(note-ranks :initarg :note-ranks
:accessor note-ranks)))
(defmethod print-object ((obj instrument-assessment) stream)
(print-unreadable-object (obj stream :type t)
(with-accessors ((instrument instrument)
(key-ranks key-ranks)
(note-ranks note-ranks))
obj
(format stream "~%~a~%~%Most Optimal Keys:~{~%~a~}~%~%Note Ranking by Number of Sympathetic Vibrations:~% ~{~a~%~}"
instrument key-ranks note-ranks))))
(defmethod assess-instrument ((instrument instrument))
(make-instance 'instrument-assessment :instrument instrument
:key-ranks (optimal-keys instrument)
:note-ranks (resonance-ranking instrument)))
;;; Excerpt Analysis -in progress (might try to merge with Lilypond parser)
(defmethod avg-resonance ((instrument instrument) freq-list)
"Takes a set of frequencies, returns avg resonance on a given instrument."
(float (/ (reduce #'+ (mapcar #'(lambda (f)
(note-rating (make-note f) instrument))
freq-list))
(length freq-list))))
(defclass excerpt ()
((title :initarg :title
:initform 'untitled
:accessor title)
(notes :initarg :notes
:accessor notes)))
(defmethod print-object ((obj excerpt) stream)
(print-unreadable-object (obj stream :type t)
(with-accessors ((title title)
(notes notes))
obj
(format stream "title: ~a, notes: ~a" title notes))))
;(defclass excerpt-assessment ()
; ((excerpt-title :initarg :excerpt-title
; :accessor excerpt-title)
; (instr :initarg :instr
; :accessor instr)
; (avg-rating :initarg :avg-rating
; :accessor instr)
; (