Hello Eef, if you are going to do something like this I’d suggest a somewhat modular design. In part writing there are many rules that apply to different voices, so I suggest to do something that allows to do arbitrary checks in a nice and extendable manner. I’ve sketched up a small proof of concept.
Cheers, Valentin Am Donnerstag, 20. Juli 2023, 08:57:11 CEST schrieb Eef Weenink: > thank you all for these great suggestions! > However these solutions do more then my job for me ;-) > I need to learn to do this myself, not automate it. > > The suggesions made me find this: https://lsr.di.unimi.it/LSR/Item?id=1100 > about colouring intervals. I will try to combine that and the > partwriter.ly<http://partwriter.ly> in a tool. What should it do: - take > all chords apart and save the intervals in an array: > with 4 voices chords, this will be 6 intervals per chord: > SB (Soprano Basso) > SA (Soprano Alto) > ST (Soprano Tenor) > AT (Alto Tenor) > AB (Alto Basso) > TB (Tenor Basso) > numbering intervals per half step: 1, 2, ..... 12 > > Compare the intervals of two consecutive chords > and search for issues: > examples: > - are there two voices with consecutive fifths (intervals are both 8) > - are there two voices with consecutive octaves (ntervals are both 12) > etc. > > If so, colour the noteheads > > Applying this tool would help to check if I overlooked issues. > > If a tool like that already exists? would be great :-) > > Eef > > > > > > Op 16 jul. 2023, om 10:33 heeft Vaughan McAlley > <[email protected]<mailto:[email protected]>> het volgende > geschreven: > > I wrote a script in Lua to check MIDI files for consecutives. It assumes one > voice per track, so may not suit your needs for figured bass. I need to > make it more user-friendly, but would be happy to do so if anyone is > interested. > > Congratulations to Thomas Tallis for having no consecutive fifths at all in > Spem in alium! > > Vaughan > > > On Sat, 15 Jul 2023 at 07:13, Eef Weenink > <[email protected]<mailto:[email protected]>> wrote: Maybe > somebody already made a script for this: > > In figured bass there are two fundamental rules: Avoid parallell octaves and > or fifhts. So it would be nice to have some scipts what checks for this. So > if two voices have a distance of a fifth or octave, the next chord is > checked if the same two voices have a fifth or octave too. If so, they are > parallel. > > Any ideas, suggestions? > > regards, Eef
%%%%% LIBRARY
% Create a checking closure
% proc takes n-voices lists of notes of length n-notes and either returns #f or a message
% If n-voices is #f all voices are provided
% voice-constraints may filter the applicable voices
% positive entries specify entries from the from, negatives from the back (python style)
% If the list starts with 'not the inverse is used
% e.g. '(not -1) -> Do not apply to bass
%
% extra-args may pass voices always passed to proc, e.g. for comparing voices to the bass voice
#(define* (make-check proc #:key (n-notes 2) (n-voices 2) (voice-contraints #f) (extra-args #f))
(lambda (action)
(cond ((equal? action 'n-notes) n-notes)
((equal? action 'n-voices) n-voices)
((equal? action 'voice-contraints) voice-contraints)
((equal? action 'extra-args) extra-args)
((equal? action 'proc) proc))))
% Iterate over all length k subsets of 1, ..., n
#(define (subset-index-iterator n k)
(let ((indices (list->vector (iota k))))
(define (increase-index)
(define (impl i)
(if (= (vector-ref indices i) (+ (- n k) i))
(if (= i 0)
(vector-set! indices i (1+ (vector-ref indices i)))
(vector-set! indices i (1+ (impl (1- i)))))
(vector-set! indices i (1+ (vector-ref indices i))))
(vector-ref indices i))
(impl (1- k)))
(lambda ()
(if (< (- n k) (vector-ref indices 0))
#f
(let ((val (vector->list indices)))
(increase-index)
val)))))
% Iterate over all length k subsets of set. If enumerate is #t return a pair of index list and subset
#(define* (subset-iterator set k #:optional (enumerate #f))
(let* ((n (length set))
(set (list->vector set))
(iter (subset-index-iterator n k)))
(lambda ()
(let ((val (iter)))
(and val
(if enumerate
(list val (map (lambda (i) (vector-ref set i)) val))
(map (lambda (i) (vector-ref set i)) val)))))))
% Apply procedure proc to all subsets of length k
#(define (map-subsets proc set k)
(let ((iter (subset-iterator set k)))
(define (impl)
(let ((sset (iter)))
(if sset
(cons (proc sset) (impl))
'())))
(impl)))
% Apply procedure proc to all indices and subsets of length k
#(define (map-enumerated-subsets proc set k)
(let ((iter (subset-iterator set k #t)))
(define (impl)
(let ((sset (iter)))
(if sset
(cons (apply proc sset) (impl))
'())))
(impl)))
% Given a check and a selection of voices perform check for all frames of size n-notes
#(define (perform-check-on-voice-data check vdata)
(let ((n (check 'n-notes))
(m (length vdata))
(N (length (car vdata))))
(define (cndr list)
(define (impl l i)
(if (= i 1)
l
(impl (cdr l) (1- i))))
(impl list n))
(define (cdr-cut! list)
(let ((val (cdr list)))
(set-cdr! list '())
val))
(if (< N n)
#f
(let* ((frame (map list-copy vdata))
(end-pairs (map cndr frame))
(rest (map cdr-cut! end-pairs))
(from 0)
(to n))
(define (impl)
(let ((val (apply (check 'proc) frame)))
(if (null? (car rest))
(cons (cons (cons from to) val) '())
(begin
(for-each (lambda (ep r) (set-cdr! ep r)) end-pairs rest)
(set! frame (map cdr frame))
(set! end-pairs (map cdr end-pairs))
(set! rest (map cdr-cut! end-pairs))
(set! from (1+ from))
(set! to (1+ to))
(cons (cons (cons (1- from) (1- to)) val) (impl))))))
(let ((val (filter cdr (impl))))
(if (null? val) #f val))))))
% Given a check and some voices perform check for each combination of voices of length n-voices
#(define (perform-check-on-combinations check vdata)
(let* ((N (length vdata))
(constraints (check 'voice-contraints))
(constraints (or constraints (iota N)))
(invert (equal? (car constraints) 'not))
(constraints (if invert (cdr constraints) constraints))
(constraints (map (lambda (x) (if (< x 0) (+ N x) x)) constraints))
(constraints (sort! (delete-duplicates constraints) <))
(constraints (if invert (lset-difference = (iota N) constraints) constraints))
(extra-args (check 'extra-args))
(extra-args (or extra-args '()))
(extra-args (map (lambda (x) (if (< x 0) (+ N x) x)) extra-args))
(constraints (lset-difference = constraints extra-args))
(extra-data (map (lambda (i) (list-ref vdata i)) extra-args))
(vdata (map (lambda (i) (list-ref vdata i)) constraints))
(N (length vdata))
(n (or (check 'n-voices) N)))
(if (< N n)
#f
(let ((val
(filter cdr
(map-enumerated-subsets (lambda (x y) (cons (append x extra-args)
(perform-check-on-voice-data check
(append y extra-data))))
vdata n))))
(if (null? val) #f val)))))
% Get numeric duration of moment
#(define (moment->number m)
(/ (ly:moment-main-numerator m) (ly:moment-main-denominator m)))
% Cumulative sum of list
#(define (cumsum x)
(cdr (reverse (fold (lambda (x prev) (cons (+ x (car prev)) prev)) (list 0) x))))
% Create pair of table of concurrent pitches from arbitrary number of voices and index maps to original notes.
#(define (voices->pitch-matrix . voices)
(define (impl pitches times idx all-times)
(if (null? all-times)
'()
(let* ((time (car all-times))
(outdated (map (lambda (t) (< (car t) time)) times))
(pitches (map (lambda (v o) (if (and o (> (length v) 1)) (cdr v) v)) pitches outdated))
(times (map (lambda (t o) (if (and o (> (length t) 1)) (cdr t) t)) times outdated))
(idx (map (lambda (i o) (if (and o (> (length i) 1)) (cdr i) i)) idx outdated))
(frame-pitches (map car pitches))
(frame-idx (map car idx))
(rest-frame (impl pitches times idx (cdr all-times))))
(if (null? rest-frame)
(cons (map list frame-pitches) (map list frame-idx))
(cons (map cons frame-pitches (car rest-frame)) (map cons frame-idx (cdr rest-frame)))))))
(let* ((notes (map (lambda (v) (extract-named-music v 'NoteEvent)) voices))
(pitches (map (lambda (v) (map (lambda (n) (ly:music-property n 'pitch)) v)) notes))
(times (map (lambda (x) (cumsum (map moment->number (map ly:music-duration-length x)))) notes))
(idx (map (lambda (t) (iota (length t))) times))
(all-times (sort (delete-duplicates (apply append times)) <)))
(impl pitches times idx all-times)))
#(define (perform-checks-on-voices checks . voices)
(let* ((matrices (apply voices->pitch-matrix voices))
(pitch-matrix (car matrices))
(idx-matrix (cdr matrices))
(check-results (filter (lambda (x) x)
(map (lambda (check) (perform-check-on-combinations check pitch-matrix))
checks)))
(check-results (apply append check-results)))
(cons check-results idx-matrix)))
% Create rgb color from hsv values
#(define (hsv->rbg h s v)
(if (= s 0)
(list v v v)
(let* ((i (truncate (* h 6)))
(f (- (* h 6) i))
(p (* v (- 1 s)))
(q (* v (- 1 (* s f))))
(t (* v (- 1 (* s (- 1 f)))))
(i (modulo i 6)))
(cond ((= i 0) (list v t p))
((= i 1) (list q v p))
((= i 2) (list p v t))
((= i 3) (list p q t))
((= i 4) (list t p v))
((= i 5) (list v p q))))))
% Create an even hue palette of n colors
#(define ((rainbow n) i) (hsv->rbg (/ i n) 1 0.7))
% Color note heads and add texts
#(define (apply-check-results-to-notes results notes idx-matrix)
(let ((n-results (length results)))
(for-each
(lambda (result cnt)
(let ((voices (car result))
(results (cdr result)))
(for-each
(lambda (result)
(let* ((bound (car result))
(message (cdr result))
(start (car bound))
(stop (1- (cdr bound))))
(for-each
(lambda (voice-idx)
(let* ((notes (list-ref notes voice-idx))
(idxes (list-ref idx-matrix voice-idx))
(idx-start (list-ref idxes start))
(idx-stop (list-ref idxes stop))
(notes (list-tail notes idx-start))
(notes (list-head notes (1+ (- idx-stop idx-start)))))
(for-each
(lambda (note)
(let* ((tweaks (ly:music-property note 'tweaks))
(tweaks (cons (cons 'color ((rainbow n-results) cnt)) tweaks)))
(ly:music-set-property! note 'tweaks tweaks)))
notes)
(let* ((note (car notes))
(articulations (ly:music-property note 'articulations))
(articulations (cons
(make-music 'TextScriptEvent 'direction 1 'text message
'tweaks (list (cons 'color ((rainbow n-results) cnt))))
articulations)))
(ly:music-set-property! note 'articulations articulations))))
voices)))
results)))
results (iota n-results))))
% Find checks and color heads and add texts
applyChecks =
#(define-music-function (checks music) (list? ly:music?)
(let* ((voices (ly:music-property music 'elements))
(check-data (apply perform-checks-on-voices checks voices))
(check-results (car check-data))
(idx-matrix (cdr check-data))
(notes (map (lambda (v) (extract-named-music v 'NoteEvent)) voices)))
(apply-check-results-to-notes check-results notes idx-matrix)
music))
% DEFINING SOME CHECKS
% Do all voices move in the same direction?
#(define all-same-direction-check
(make-check
(lambda (. voices)
(and
(or
(reduce (lambda (x y) (and x y)) #t (map (lambda (v) (apply ly:pitch<? v)) voices))
(reduce (lambda (x y) (and x y)) #t (map (lambda (v) (apply ly:pitch<? (reverse v))) voices)))
"All voices move in same direction"))
#:n-voices #f))
% Does any voice feature augmented/diminished intervals?
#(define interval-check
(make-check
(lambda (voice)
(let* ((p1 (car voice))
(p2 (cadr voice))
(delta (if (ly:pitch<? p1 p2) (ly:pitch-diff p2 p1) (ly:pitch-diff p1 p2)))
(steps (ly:pitch-notename delta))
(alt (ly:pitch-alteration delta))
(down? (< alt 0))
(alt (* 2 (abs alt)))
(alt (cond ((= steps 1) (if down? (1- alt) alt)) ; 2nd can be major or minor
((= steps 2) (if down? (1- alt) alt)) ; 3rd can be major or minor
((= steps 5) (if down? (1- alt) alt)) ; 6th can be major or minor
((= steps 6) (if down? (1- alt) alt)) ; 7th can be major or minor
(else alt))) ; pure intervals
(interval (list-ref '("unison" "2nd" "3rd" "4th" "5th" "6th" "7th") steps))
(type (if down? "diminished" "augmented")))
(if (= 0 alt)
#f
(if (= 1 alt)
(format #f "~a ~a" type interval)
(format #f "~ax ~a ~a" alt type interval)))))
#:n-voices 1))
% Do two voices have parallel consonances?
#(define parallel-consonance-check
(make-check
(lambda (v1 v2)
(let* ((p11 (car v1))
(p21 (cadr v1))
(p12 (car v2))
(p22 (cadr v2))
(delta1 (ly:pitch-diff p12 p11))
(delta2 (ly:pitch-diff p22 p21))
(delta (if (ly:pitch<? p11 p12) (ly:pitch-diff p12 p11) (ly:pitch-diff p11 p12)))
(steps (ly:pitch-steps delta)))
(and (memq steps '(0 4))
(equal? delta1 delta2)
(format #f "parallel ~a" (if (= steps 0) "octave" "fifth")))))))
% Do two voices have a voice crossing?
#(define voice-crossing-check
(make-check
(lambda (v1 v2)
(let* ((p1 (car v1))
(p2 (car v2)))
(and (ly:pitch<? p1 p2)
"Voice crossing")))
#:n-notes 1))
%%%%% TESTS
{ \applyChecks #(list parallel-consonance-check interval-check voice-crossing-check all-same-direction-check)
<< { c d e d e es f as c' fis' ces' bes } { d2 e4 d c\breve eses4 } { e4 d c b, a,\breve } >> }
signature.asc
Description: This is a digitally signed message part.
