Hi Stefan,
Am 20.09.22 um 13:00 schrieb Stefan Thomas:
Dear community,
sorry, it's a bit an off topic: If You are not interested in
pitch-class set theory, You don't have to read the following.
I've worked on a python module dealing with pitch-class set theory as
I've read in "The structure of atonal music" by Allen Forte.
I know that there already exists some modules like that but I want to
integrate it in lilypond.
I'm still working on this module, but at the moment I can do:
* Getting the normal form and prime form of a pcs.
* Transposing and inverting a pcs
* Finding subsets of a pcs given in primeform.
I'm working on:
* Finding different kinds of similarity of pcs.
* Getting subcomplexes k and kh of a pcs.
* Finding primeform and so on, when pitches in lilypond-style are given.
* Getting pitches in lilypond-style when pitches in midinote-nums or
as pcs are given.
Let me know it if You are interested. Maybee it's only something of
interest for nerdy persons like me, but maybee for others too.
I don't know if this is of use to you, but I created a bunch of LilyPond
routines for dealing with PC sets (like in Forte, but also with a finer
equivalence relation not identifying a set with its inverse) last year.
I attach it unchanged, as I don't have time to clean it up at the
moment; you'll probably want to uncomment some of the routines at the
end to see what the functions do.
I'm curious: You write that you are working on a Python module; how does
this integrate in LilyPond?
Lukas
\version "2.22.0"
\include "dodeka.ily"
% ---------------------- Forte number dictionaries ------------------------------
forte-distinct-inverses = % Taken from https://en.wikipedia.org/wiki/List_of_pitch-class_sets
#'((0-1 . ())
(1-1 . (0))
(2-1 . (0 1))
(2-2 . (0 2))
(2-3 . (0 3))
(2-4 . (0 4))
(2-5 . (0 5))
(2-6 . (0 6))
(3-1 . (0 1 2))
(3-2A . (0 1 3))
(3-2B . (0 2 3))
(3-3A . (0 1 4))
(3-3B . (0 3 4))
(3-4A . (0 1 5))
(3-4B . (0 4 5))
(3-5A . (0 1 6))
(3-5B . (0 5 6))
(3-6 . (0 2 4))
(3-7A . (0 2 5))
(3-7B . (0 3 5))
(3-8A . (0 2 6))
(3-8B . (0 4 6))
(3-9 . (0 2 7))
(3-10 . (0 3 6))
(3-11A . (0 3 7))
(3-11B . (0 4 7))
(3-12 . (0 4 8))
(4-1 . (0 1 2 3))
(4-2A . (0 1 2 4))
(4-2B . (0 2 3 4))
(4-3 . (0 1 3 4))
(4-4A . (0 1 2 5))
(4-4B . (0 3 4 5))
(4-5A . (0 1 2 6))
(4-5B . (0 4 5 6))
(4-6 . (0 1 2 7))
(4-7 . (0 1 4 5))
(4-8 . (0 1 5 6))
(4-9 . (0 1 6 7))
(4-10 . (0 2 3 5))
(4-11A . (0 1 3 5))
(4-11B . (0 2 4 5))
(4-12A . (0 2 3 6))
(4-12B . (0 3 4 6))
(4-13A . (0 1 3 6))
(4-13B . (0 3 5 6))
(4-14A . (0 2 3 7))
(4-14B . (0 4 5 7))
(4-z15A . (0 1 4 6))
(4-z15B . (0 2 5 6))
(4-16A . (0 1 5 7))
(4-16B . (0 2 6 7))
(4-17 . (0 3 4 7))
(4-18A . (0 1 4 7))
(4-18B . (0 3 6 7))
(4-19A . (0 1 4 8))
(4-19B . (0 3 4 8))
(4-20 . (0 1 5 8))
(4-21 . (0 2 4 6))
(4-22A . (0 2 4 7))
(4-22B . (0 3 5 7))
(4-23 . (0 2 5 7))
(4-24 . (0 2 4 8))
(4-25 . (0 2 6 8))
(4-26 . (0 3 5 8))
(4-27A . (0 2 5 8))
(4-27B . (0 3 6 8))
(4-28 . (0 3 6 9))
(4-z29A . (0 1 3 7))
(4-z29B . (0 4 6 7))
(5-1 . (0 1 2 3 4))
(5-2A . (0 1 2 3 5))
(5-2B . (0 2 3 4 5))
(5-3A . (0 1 2 4 5))
(5-3B . (0 1 3 4 5))
(5-4A . (0 1 2 3 6))
(5-4B . (0 3 4 5 6))
(5-5A . (0 1 2 3 7))
(5-5B . (0 4 5 6 7))
(5-6A . (0 1 2 5 6))
(5-6B . (0 1 4 5 6))
(5-7A . (0 1 2 6 7))
(5-7B . (0 1 5 6 7))
(5-8 . (0 2 3 4 6))
(5-9A . (0 1 2 4 6))
(5-9B . (0 2 4 5 6))
(5-10A . (0 1 3 4 6))
(5-10B . (0 2 3 5 6))
(5-11A . (0 2 3 4 7))
(5-11B . (0 3 4 5 7))
(5-z12 . (0 1 3 5 6))
(5-13A . (0 1 2 4 8))
(5-13B . (0 2 3 4 8))
(5-14A . (0 1 2 5 7))
(5-14B . (0 2 5 6 7))
(5-15 . (0 1 2 6 8))
(5-16A . (0 1 3 4 7))
(5-16B . (0 3 4 6 7))
(5-z17 . (0 1 3 4 8))
(5-z18A . (0 1 4 5 7))
(5-z18B . (0 2 3 6 7))
(5-19A . (0 1 3 6 7))
(5-19B . (0 1 4 6 7))
(5-20A . (0 1 5 6 8))
(5-20B . (0 2 3 7 8))
(5-21A . (0 1 4 5 8))
(5-21B . (0 3 4 7 8))
(5-22 . (0 1 4 7 8))
(5-23A . (0 2 3 5 7))
(5-23B . (0 2 4 5 7))
(5-24A . (0 1 3 5 7))
(5-24B . (0 2 4 6 7))
(5-25A . (0 2 3 5 8))
(5-25B . (0 3 5 6 8))
(5-26A . (0 2 4 5 8))
(5-26B . (0 3 4 6 8))
(5-27A . (0 1 3 5 8))
(5-27B . (0 3 5 7 8))
(5-28A . (0 2 3 6 8))
(5-28B . (0 2 5 6 8))
(5-29A . (0 1 3 6 8))
(5-29B . (0 2 5 7 8))
(5-30A . (0 1 4 6 8))
(5-30B . (0 2 4 7 8))
(5-31A . (0 1 3 6 9))
(5-31B . (0 2 3 6 9))
(5-32A . (0 1 4 6 9))
(5-32B . (0 3 5 8 9))
(5-33 . (0 2 4 6 8))
(5-34 . (0 2 4 6 9))
(5-35 . (0 2 4 7 9))
(5-z36A . (0 1 2 4 7))
(5-z36B . (0 3 5 6 7))
(5-z37 . (0 3 4 5 8))
(5-z38A . (0 1 2 5 8))
(5-z38B . (0 3 6 7 8))
(6-1 . (0 1 2 3 4 5))
(6-2A . (0 1 2 3 4 6))
(6-2B . (0 2 3 4 5 6))
(6-z3A . (0 1 2 3 5 6))
(6-z3B . (0 1 3 4 5 6))
(6-z4 . (0 1 2 4 5 6))
(6-5A . (0 1 2 3 6 7))
(6-5B . (0 1 4 5 6 7))
(6-z6 . (0 1 2 5 6 7))
(6-7 . (0 1 2 6 7 8))
(6-8 . (0 2 3 4 5 7))
(6-9A . (0 1 2 3 5 7))
(6-9B . (0 2 4 5 6 7))
(6-z10A . (0 1 3 4 5 7))
(6-z10B . (0 2 3 4 6 7))
(6-z11A . (0 1 2 4 5 7))
(6-z11B . (0 2 3 5 6 7))
(6-z12A . (0 1 2 4 6 7))
(6-z12B . (0 1 3 5 6 7))
(6-z13 . (0 1 3 4 6 7))
(6-14A . (0 1 3 4 5 8))
(6-14B . (0 3 4 5 7 8))
(6-15A . (0 1 2 4 5 8))
(6-15B . (0 3 4 6 7 8))
(6-16A . (0 1 4 5 6 8))
(6-16B . (0 2 3 4 7 8))
(6-z17A . (0 1 2 4 7 8))
(6-z17B . (0 1 4 6 7 8))
(6-18A . (0 1 2 5 7 8))
(6-18B . (0 1 3 6 7 8))
(6-z19A . (0 1 3 4 7 8))
(6-z19B . (0 1 4 5 7 8))
(6-20 . (0 1 4 5 8 9))
(6-21A . (0 2 3 4 6 8))
(6-21B . (0 2 4 5 6 8))
(6-22A . (0 1 2 4 6 8))
(6-22B . (0 2 4 6 7 8))
(6-z23 . (0 2 3 5 6 8))
(6-z24A . (0 1 3 4 6 8))
(6-z24B . (0 2 4 5 7 8))
(6-z25A . (0 1 3 5 6 8))
(6-z25B . (0 2 3 5 7 8))
(6-z26 . (0 1 3 5 7 8))
(6-27A . (0 1 3 4 6 9))
(6-27B . (0 3 5 6 8 9))
(6-z28 . (0 1 3 5 6 9))
(6-z29 . (0 2 3 6 7 9))
(6-30A . (0 1 3 6 7 9))
(6-30B . (0 2 3 6 8 9))
(6-31A . (0 1 4 5 7 9))
(6-31B . (0 2 4 5 8 9))
(6-32 . (0 2 4 5 7 9))
(6-33A . (0 2 3 5 7 9))
(6-33B . (0 2 4 6 7 9))
(6-34A . (0 1 3 5 7 9))
(6-34B . (0 2 4 6 8 9))
(6-35 . (0 2 4 6 8 10))
(6-z36A . (0 1 2 3 4 7))
(6-z36B . (0 3 4 5 6 7))
(6-z37 . (0 1 2 3 4 8))
(6-z38 . (0 1 2 3 7 8))
(6-z39A . (0 2 3 4 5 8))
(6-z39B . (0 3 4 5 6 8))
(6-z40A . (0 1 2 3 5 8))
(6-z40B . (0 3 5 6 7 8))
(6-z41A . (0 1 2 3 6 8))
(6-z41B . (0 2 5 6 7 8))
(6-z42 . (0 1 2 3 6 9))
(6-z43A . (0 1 2 5 6 8))
(6-z43B . (0 2 3 6 7 8))
(6-z44A . (0 1 2 5 6 9))
(6-z44B . (0 3 4 7 8 9))
(6-z45 . (0 2 3 4 6 9))
(6-z46A . (0 1 2 4 6 9))
(6-z46B . (0 3 5 7 8 9))
(6-z47A . (0 1 2 4 7 9))
(6-z47B . (0 2 5 7 8 9))
(6-z48 . (0 1 2 5 7 9))
(6-z49 . (0 1 3 4 7 9))
(6-z50 . (0 1 4 6 7 9))
(7-1 . (0 1 2 3 4 5 6))
(7-2A . (0 1 2 3 4 5 7))
(7-2B . (0 2 3 4 5 6 7))
(7-3A . (0 1 2 3 4 5 8))
(7-3B . (0 3 4 5 6 7 8))
(7-4A . (0 1 2 3 4 6 7))
(7-4B . (0 1 3 4 5 6 7))
(7-5A . (0 1 2 3 5 6 7))
(7-5B . (0 1 2 4 5 6 7))
(7-6A . (0 1 2 3 4 7 8))
(7-6B . (0 1 4 5 6 7 8))
(7-7A . (0 1 2 3 6 7 8))
(7-7B . (0 1 2 5 6 7 8))
(7-8 . (0 2 3 4 5 6 8))
(7-9A . (0 1 2 3 4 6 8))
(7-9B . (0 2 4 5 6 7 8))
(7-10A . (0 1 2 3 4 6 9))
(7-10B . (0 2 3 4 5 6 9))
(7-11A . (0 1 3 4 5 6 8))
(7-11B . (0 2 3 4 5 7 8))
(7-z12 . (0 1 2 3 4 7 9))
(7-13A . (0 1 2 4 5 6 8))
(7-13B . (0 2 3 4 6 7 8))
(7-14A . (0 1 2 3 5 7 8))
(7-14B . (0 1 3 5 6 7 8))
(7-15 . (0 1 2 4 6 7 8))
(7-16A . (0 1 2 3 5 6 9))
(7-16B . (0 1 3 4 5 6 9))
(7-z17 . (0 1 2 4 5 6 9))
(7-z18A . (0 1 4 5 6 7 9))
(7-z18B . (0 1 4 6 7 8 9))
(7-19A . (0 1 2 3 6 7 9))
(7-19B . (0 1 2 3 6 8 9))
(7-20A . (0 1 2 5 6 7 9))
(7-20B . (0 1 2 5 7 8 9))
(7-21A . (0 1 2 4 5 8 9))
(7-21B . (0 1 3 4 5 8 9))
(7-22 . (0 1 2 5 6 8 9))
(7-23A . (0 2 3 4 5 7 9))
(7-23B . (0 2 4 5 6 7 9))
(7-24A . (0 1 2 3 5 7 9))
(7-24B . (0 2 4 6 7 8 9))
(7-25A . (0 2 3 4 6 7 9))
(7-25B . (0 2 3 5 6 7 9))
(7-26A . (0 1 3 4 5 7 9))
(7-26B . (0 2 4 5 6 8 9))
(7-27A . (0 1 2 4 5 7 9))
(7-27B . (0 2 4 5 7 8 9))
(7-28A . (0 1 3 5 6 7 9))
(7-28B . (0 2 3 4 6 8 9))
(7-29A . (0 1 2 4 6 7 9))
(7-29B . (0 2 3 5 7 8 9))
(7-30A . (0 1 2 4 6 8 9))
(7-30B . (0 1 3 5 7 8 9))
(7-31A . (0 1 3 4 6 7 9))
(7-31B . (0 2 3 5 6 8 9))
(7-32A . (0 1 3 4 6 8 9))
(7-32B . (0 1 3 5 6 8 9))
(7-33 . (0 1 2 4 6 8 10))
(7-34 . (0 1 3 4 6 8 10))
(7-35 . (0 1 3 5 6 8 10))
(7-z36A . (0 1 2 3 5 6 8))
(7-z36B . (0 2 3 5 6 7 8))
(7-z37 . (0 1 3 4 5 7 8))
(7-z38A . (0 1 2 4 5 7 8))
(7-z38B . (0 1 3 4 6 7 8))
(8-1 . (0 1 2 3 4 5 6 7))
(8-2A . (0 1 2 3 4 5 6 8))
(8-2B . (0 2 3 4 5 6 7 8))
(8-3 . (0 1 2 3 4 5 6 9))
(8-4A . (0 1 2 3 4 5 7 8))
(8-4B . (0 1 3 4 5 6 7 8))
(8-5A . (0 1 2 3 4 6 7 8))
(8-5B . (0 1 2 4 5 6 7 8))
(8-6 . (0 1 2 3 5 6 7 8))
(8-7 . (0 1 2 3 4 5 8 9))
(8-8 . (0 1 2 3 4 7 8 9))
(8-9 . (0 1 2 3 6 7 8 9))
(8-10 . (0 2 3 4 5 6 7 9))
(8-11A . (0 1 2 3 4 5 7 9))
(8-11B . (0 2 4 5 6 7 8 9))
(8-12A . (0 1 3 4 5 6 7 9))
(8-12B . (0 2 3 4 5 6 8 9))
(8-13A . (0 1 2 3 4 6 7 9))
(8-13B . (0 2 3 5 6 7 8 9))
(8-14A . (0 1 2 4 5 6 7 9))
(8-14B . (0 2 3 4 5 7 8 9))
(8-z15A . (0 1 2 3 4 6 8 9))
(8-z15B . (0 1 3 5 6 7 8 9))
(8-16A . (0 1 2 3 5 7 8 9))
(8-16B . (0 1 2 4 6 7 8 9))
(8-17 . (0 1 3 4 5 6 8 9))
(8-18A . (0 1 2 3 5 6 8 9))
(8-18B . (0 1 3 4 6 7 8 9))
(8-19A . (0 1 2 4 5 6 8 9))
(8-19B . (0 1 3 4 5 7 8 9))
(8-20 . (0 1 2 4 5 7 8 9))
(8-21 . (0 1 2 3 4 6 8 10))
(8-22A . (0 1 2 3 5 6 8 10))
(8-22B . (0 1 2 3 5 7 9 10))
(8-23 . (0 1 2 3 5 7 8 10))
(8-24 . (0 1 2 4 5 6 8 10))
(8-25 . (0 1 2 4 6 7 8 10))
(8-26 . (0 1 3 4 5 7 8 10))
(8-27A . (0 1 2 4 5 7 8 10))
(8-27B . (0 1 2 4 6 7 9 10))
(8-28 . (0 1 3 4 6 7 9 10))
(8-z29A . (0 1 2 3 5 6 7 9))
(8-z29B . (0 2 3 4 6 7 8 9))
(9-1 . (0 1 2 3 4 5 6 7 8))
(9-2A . (0 1 2 3 4 5 6 7 9))
(9-2B . (0 2 3 4 5 6 7 8 9))
(9-3A . (0 1 2 3 4 5 6 8 9))
(9-3B . (0 1 3 4 5 6 7 8 9))
(9-4A . (0 1 2 3 4 5 7 8 9))
(9-4B . (0 1 2 4 5 6 7 8 9))
(9-5A . (0 1 2 3 4 6 7 8 9))
(9-5B . (0 1 2 3 5 6 7 8 9))
(9-6 . (0 1 2 3 4 5 6 8 10))
(9-7A . (0 1 2 3 4 5 7 8 10))
(9-7B . (0 1 2 3 4 5 7 9 10))
(9-8A . (0 1 2 3 4 6 7 8 10))
(9-8B . (0 1 2 3 4 6 8 9 10))
(9-9 . (0 1 2 3 5 6 7 8 10))
(9-10 . (0 1 2 3 4 6 7 9 10))
(9-11A . (0 1 2 3 5 6 7 9 10))
(9-11B . (0 1 2 3 5 6 8 9 10))
(9-12 . (0 1 2 4 5 6 8 9 10))
(10-1 . (0 1 2 3 4 5 6 7 8 9))
(10-2 . (0 1 2 3 4 5 6 7 8 10))
(10-3 . (0 1 2 3 4 5 6 7 9 10))
(10-4 . (0 1 2 3 4 5 6 8 9 10))
(10-5 . (0 1 2 3 4 5 7 8 9 10))
(10-6 . (0 1 2 3 4 6 7 8 9 10))
(11-1 . (0 1 2 3 4 5 6 7 8 9 10))
(12-1 . (0 1 2 3 4 5 6 7 8 9 10 11)))
forte =
#'((0-1 . ())
(1-1 . (0))
(2-1 . (0 1))
(2-2 . (0 2))
(2-3 . (0 3))
(2-4 . (0 4))
(2-5 . (0 5))
(2-6 . (0 6))
(3-1 . (0 1 2))
(3-10 . (0 3 6))
(3-11 . (0 3 7))
(3-11 . (0 4 7))
(3-12 . (0 4 8))
(3-2 . (0 1 3))
(3-2 . (0 2 3))
(3-3 . (0 1 4))
(3-3 . (0 3 4))
(3-4 . (0 1 5))
(3-4 . (0 4 5))
(3-5 . (0 1 6))
(3-5 . (0 5 6))
(3-6 . (0 2 4))
(3-7 . (0 2 5))
(3-7 . (0 3 5))
(3-8 . (0 2 6))
(3-8 . (0 4 6))
(3-9 . (0 2 7))
(4-1 . (0 1 2 3))
(4-10 . (0 2 3 5))
(4-11 . (0 1 3 5))
(4-11 . (0 2 4 5))
(4-12 . (0 2 3 6))
(4-12 . (0 3 4 6))
(4-13 . (0 1 3 6))
(4-13 . (0 3 5 6))
(4-14 . (0 2 3 7))
(4-14 . (0 4 5 7))
(4-16 . (0 1 5 7))
(4-16 . (0 2 6 7))
(4-17 . (0 3 4 7))
(4-18 . (0 1 4 7))
(4-18 . (0 3 6 7))
(4-19 . (0 1 4 8))
(4-19 . (0 3 4 8))
(4-20 . (0 1 5 8))
(4-21 . (0 2 4 6))
(4-22 . (0 2 4 7))
(4-22 . (0 3 5 7))
(4-23 . (0 2 5 7))
(4-24 . (0 2 4 8))
(4-25 . (0 2 6 8))
(4-26 . (0 3 5 8))
(4-27 . (0 2 5 8))
(4-27 . (0 3 6 8))
(4-28 . (0 3 6 9))
(4-2 . (0 1 2 4))
(4-2 . (0 2 3 4))
(4-3 . (0 1 3 4))
(4-4 . (0 1 2 5))
(4-4 . (0 3 4 5))
(4-5 . (0 1 2 6))
(4-5 . (0 4 5 6))
(4-6 . (0 1 2 7))
(4-7 . (0 1 4 5))
(4-8 . (0 1 5 6))
(4-9 . (0 1 6 7))
(4-z15 . (0 1 4 6))
(4-z15 . (0 2 5 6))
(4-z29 . (0 1 3 7))
(4-z29 . (0 4 6 7))
(5-1 . (0 1 2 3 4))
(5-10 . (0 1 3 4 6))
(5-10 . (0 2 3 5 6))
(5-11 . (0 2 3 4 7))
(5-11 . (0 3 4 5 7))
(5-13 . (0 1 2 4 8))
(5-13 . (0 2 3 4 8))
(5-14 . (0 1 2 5 7))
(5-14 . (0 2 5 6 7))
(5-15 . (0 1 2 6 8))
(5-16 . (0 1 3 4 7))
(5-16 . (0 3 4 6 7))
(5-19 . (0 1 3 6 7))
(5-19 . (0 1 4 6 7))
(5-20 . (0 1 5 6 8))
(5-20 . (0 2 3 7 8))
(5-21 . (0 1 4 5 8))
(5-21 . (0 3 4 7 8))
(5-22 . (0 1 4 7 8))
(5-23 . (0 2 3 5 7))
(5-23 . (0 2 4 5 7))
(5-24 . (0 1 3 5 7))
(5-24 . (0 2 4 6 7))
(5-25 . (0 2 3 5 8))
(5-25 . (0 3 5 6 8))
(5-26 . (0 2 4 5 8))
(5-26 . (0 3 4 6 8))
(5-27 . (0 1 3 5 8))
(5-27 . (0 3 5 7 8))
(5-28 . (0 2 3 6 8))
(5-28 . (0 2 5 6 8))
(5-29 . (0 1 3 6 8))
(5-29 . (0 2 5 7 8))
(5-2 . (0 1 2 3 5))
(5-2 . (0 2 3 4 5))
(5-30 . (0 1 4 6 8))
(5-30 . (0 2 4 7 8))
(5-31 . (0 1 3 6 9))
(5-31 . (0 2 3 6 9))
(5-32 . (0 1 4 6 9))
(5-32 . (0 3 5 8 9))
(5-33 . (0 2 4 6 8))
(5-34 . (0 2 4 6 9))
(5-35 . (0 2 4 7 9))
(5-3 . (0 1 2 4 5))
(5-3 . (0 1 3 4 5))
(5-4 . (0 1 2 3 6))
(5-4 . (0 3 4 5 6))
(5-5 . (0 1 2 3 7))
(5-5 . (0 4 5 6 7))
(5-6 . (0 1 2 5 6))
(5-6 . (0 1 4 5 6))
(5-7 . (0 1 2 6 7))
(5-7 . (0 1 5 6 7))
(5-8 . (0 2 3 4 6))
(5-9 . (0 1 2 4 6))
(5-9 . (0 2 4 5 6))
(5-z12 . (0 1 3 5 6))
(5-z17 . (0 1 3 4 8))
(5-z18 . (0 1 4 5 7))
(5-z18 . (0 2 3 6 7))
(5-z36 . (0 1 2 4 7))
(5-z36 . (0 3 5 6 7))
(5-z37 . (0 3 4 5 8))
(5-z38 . (0 1 2 5 8))
(5-z38 . (0 3 6 7 8))
(6-1 . (0 1 2 3 4 5))
(6-14 . (0 1 3 4 5 8))
(6-14 . (0 3 4 5 7 8))
(6-15 . (0 1 2 4 5 8))
(6-15 . (0 3 4 6 7 8))
(6-16 . (0 1 4 5 6 8))
(6-16 . (0 2 3 4 7 8))
(6-18 . (0 1 2 5 7 8))
(6-18 . (0 1 3 6 7 8))
(6-20 . (0 1 4 5 8 9))
(6-21 . (0 2 3 4 6 8))
(6-21 . (0 2 4 5 6 8))
(6-22 . (0 1 2 4 6 8))
(6-22 . (0 2 4 6 7 8))
(6-27 . (0 1 3 4 6 9))
(6-27 . (0 3 5 6 8 9))
(6-2 . (0 1 2 3 4 6))
(6-2 . (0 2 3 4 5 6))
(6-30 . (0 1 3 6 7 9))
(6-30 . (0 2 3 6 8 9))
(6-31 . (0 1 4 5 7 9))
(6-31 . (0 2 4 5 8 9))
(6-32 . (0 2 4 5 7 9))
(6-33 . (0 2 3 5 7 9))
(6-33 . (0 2 4 6 7 9))
(6-34 . (0 1 3 5 7 9))
(6-34 . (0 2 4 6 8 9))
(6-35 . (0 2 4 6 8 10))
(6-5 . (0 1 2 3 6 7))
(6-5 . (0 1 4 5 6 7))
(6-7 . (0 1 2 6 7 8))
(6-8 . (0 2 3 4 5 7))
(6-9 . (0 1 2 3 5 7))
(6-9 . (0 2 4 5 6 7))
(6-z10 . (0 1 3 4 5 7))
(6-z10 . (0 2 3 4 6 7))
(6-z11 . (0 1 2 4 5 7))
(6-z11 . (0 2 3 5 6 7))
(6-z12 . (0 1 2 4 6 7))
(6-z12 . (0 1 3 5 6 7))
(6-z13 . (0 1 3 4 6 7))
(6-z17 . (0 1 2 4 7 8))
(6-z17 . (0 1 4 6 7 8))
(6-z19 . (0 1 3 4 7 8))
(6-z19 . (0 1 4 5 7 8))
(6-z23 . (0 2 3 5 6 8))
(6-z24 . (0 1 3 4 6 8))
(6-z24 . (0 2 4 5 7 8))
(6-z25 . (0 1 3 5 6 8))
(6-z25 . (0 2 3 5 7 8))
(6-z26 . (0 1 3 5 7 8))
(6-z28 . (0 1 3 5 6 9))
(6-z29 . (0 2 3 6 7 9))
(6-z36 . (0 1 2 3 4 7))
(6-z36 . (0 3 4 5 6 7))
(6-z37 . (0 1 2 3 4 8))
(6-z38 . (0 1 2 3 7 8))
(6-z39 . (0 2 3 4 5 8))
(6-z39 . (0 3 4 5 6 8))
(6-z3 . (0 1 2 3 5 6))
(6-z3 . (0 1 3 4 5 6))
(6-z4 . (0 1 2 4 5 6))
(6-z40 . (0 1 2 3 5 8))
(6-z40 . (0 3 5 6 7 8))
(6-z41 . (0 1 2 3 6 8))
(6-z41 . (0 2 5 6 7 8))
(6-z42 . (0 1 2 3 6 9))
(6-z43 . (0 1 2 5 6 8))
(6-z43 . (0 2 3 6 7 8))
(6-z44 . (0 1 2 5 6 9))
(6-z44 . (0 3 4 7 8 9))
(6-z45 . (0 2 3 4 6 9))
(6-z46 . (0 1 2 4 6 9))
(6-z46 . (0 3 5 7 8 9))
(6-z47 . (0 1 2 4 7 9))
(6-z47 . (0 2 5 7 8 9))
(6-z48 . (0 1 2 5 7 9))
(6-z49 . (0 1 3 4 7 9))
(6-z50 . (0 1 4 6 7 9))
(6-z6 . (0 1 2 5 6 7))
(7-1 . (0 1 2 3 4 5 6))
(7-10 . (0 1 2 3 4 6 9))
(7-10 . (0 2 3 4 5 6 9))
(7-11 . (0 1 3 4 5 6 8))
(7-11 . (0 2 3 4 5 7 8))
(7-13 . (0 1 2 4 5 6 8))
(7-13 . (0 2 3 4 6 7 8))
(7-14 . (0 1 2 3 5 7 8))
(7-14 . (0 1 3 5 6 7 8))
(7-15 . (0 1 2 4 6 7 8))
(7-16 . (0 1 2 3 5 6 9))
(7-16 . (0 1 3 4 5 6 9))
(7-19 . (0 1 2 3 6 7 9))
(7-19 . (0 1 2 3 6 8 9))
(7-20 . (0 1 2 5 6 7 9))
(7-20 . (0 1 2 5 7 8 9))
(7-21 . (0 1 2 4 5 8 9))
(7-21 . (0 1 3 4 5 8 9))
(7-22 . (0 1 2 5 6 8 9))
(7-23 . (0 2 3 4 5 7 9))
(7-23 . (0 2 4 5 6 7 9))
(7-24 . (0 1 2 3 5 7 9))
(7-24 . (0 2 4 6 7 8 9))
(7-25 . (0 2 3 4 6 7 9))
(7-25 . (0 2 3 5 6 7 9))
(7-26 . (0 1 3 4 5 7 9))
(7-26 . (0 2 4 5 6 8 9))
(7-27 . (0 1 2 4 5 7 9))
(7-27 . (0 2 4 5 7 8 9))
(7-28 . (0 1 3 5 6 7 9))
(7-28 . (0 2 3 4 6 8 9))
(7-29 . (0 1 2 4 6 7 9))
(7-29 . (0 2 3 5 7 8 9))
(7-2 . (0 1 2 3 4 5 7))
(7-2 . (0 2 3 4 5 6 7))
(7-30 . (0 1 2 4 6 8 9))
(7-30 . (0 1 3 5 7 8 9))
(7-31 . (0 1 3 4 6 7 9))
(7-31 . (0 2 3 5 6 8 9))
(7-32 . (0 1 3 4 6 8 9))
(7-32 . (0 1 3 5 6 8 9))
(7-33 . (0 1 2 4 6 8 10))
(7-34 . (0 1 3 4 6 8 10))
(7-35 . (0 1 3 5 6 8 10))
(7-3 . (0 1 2 3 4 5 8))
(7-3 . (0 3 4 5 6 7 8))
(7-4 . (0 1 2 3 4 6 7))
(7-4 . (0 1 3 4 5 6 7))
(7-5 . (0 1 2 3 5 6 7))
(7-5 . (0 1 2 4 5 6 7))
(7-6 . (0 1 2 3 4 7 8))
(7-6 . (0 1 4 5 6 7 8))
(7-7 . (0 1 2 3 6 7 8))
(7-7 . (0 1 2 5 6 7 8))
(7-8 . (0 2 3 4 5 6 8))
(7-9 . (0 1 2 3 4 6 8))
(7-9 . (0 2 4 5 6 7 8))
(7-z12 . (0 1 2 3 4 7 9))
(7-z17 . (0 1 2 4 5 6 9))
(7-z18 . (0 1 4 5 6 7 9))
(7-z18 . (0 1 4 6 7 8 9))
(7-z36 . (0 1 2 3 5 6 8))
(7-z36 . (0 2 3 5 6 7 8))
(7-z37 . (0 1 3 4 5 7 8))
(7-z38 . (0 1 2 4 5 7 8))
(7-z38 . (0 1 3 4 6 7 8))
(8-1 . (0 1 2 3 4 5 6 7))
(8-10 . (0 2 3 4 5 6 7 9))
(8-11 . (0 1 2 3 4 5 7 9))
(8-11 . (0 2 4 5 6 7 8 9))
(8-12 . (0 1 3 4 5 6 7 9))
(8-12 . (0 2 3 4 5 6 8 9))
(8-13 . (0 1 2 3 4 6 7 9))
(8-13 . (0 2 3 5 6 7 8 9))
(8-14 . (0 1 2 4 5 6 7 9))
(8-14 . (0 2 3 4 5 7 8 9))
(8-16 . (0 1 2 3 5 7 8 9))
(8-16 . (0 1 2 4 6 7 8 9))
(8-17 . (0 1 3 4 5 6 8 9))
(8-18 . (0 1 2 3 5 6 8 9))
(8-18 . (0 1 3 4 6 7 8 9))
(8-19 . (0 1 2 4 5 6 8 9))
(8-19 . (0 1 3 4 5 7 8 9))
(8-20 . (0 1 2 4 5 7 8 9))
(8-21 . (0 1 2 3 4 6 8 10))
(8-22 . (0 1 2 3 5 6 8 10))
(8-22 . (0 1 2 3 5 7 9 10))
(8-23 . (0 1 2 3 5 7 8 10))
(8-24 . (0 1 2 4 5 6 8 10))
(8-25 . (0 1 2 4 6 7 8 10))
(8-26 . (0 1 3 4 5 7 8 10))
(8-27 . (0 1 2 4 5 7 8 10))
(8-27 . (0 1 2 4 6 7 9 10))
(8-28 . (0 1 3 4 6 7 9 10))
(8-2 . (0 1 2 3 4 5 6 8))
(8-2 . (0 2 3 4 5 6 7 8))
(8-3 . (0 1 2 3 4 5 6 9))
(8-4 . (0 1 2 3 4 5 7 8))
(8-4 . (0 1 3 4 5 6 7 8))
(8-5 . (0 1 2 3 4 6 7 8))
(8-5 . (0 1 2 4 5 6 7 8))
(8-6 . (0 1 2 3 5 6 7 8))
(8-7 . (0 1 2 3 4 5 8 9))
(8-8 . (0 1 2 3 4 7 8 9))
(8-9 . (0 1 2 3 6 7 8 9))
(8-z15 . (0 1 2 3 4 6 8 9))
(8-z15 . (0 1 3 5 6 7 8 9))
(8-z29 . (0 1 2 3 5 6 7 9))
(8-z29 . (0 2 3 4 6 7 8 9))
(9-1 . (0 1 2 3 4 5 6 7 8))
(9-10 . (0 1 2 3 4 6 7 9 10))
(9-11 . (0 1 2 3 5 6 7 9 10))
(9-11 . (0 1 2 3 5 6 8 9 10))
(9-12 . (0 1 2 4 5 6 8 9 10))
(9-2 . (0 1 2 3 4 5 6 7 9))
(9-2 . (0 2 3 4 5 6 7 8 9))
(9-3 . (0 1 2 3 4 5 6 8 9))
(9-3 . (0 1 3 4 5 6 7 8 9))
(9-4 . (0 1 2 3 4 5 7 8 9))
(9-4 . (0 1 2 4 5 6 7 8 9))
(9-5 . (0 1 2 3 4 6 7 8 9))
(9-5 . (0 1 2 3 5 6 7 8 9))
(9-6 . (0 1 2 3 4 5 6 8 10))
(9-7 . (0 1 2 3 4 5 7 8 10))
(9-7 . (0 1 2 3 4 5 7 9 10))
(9-8 . (0 1 2 3 4 6 7 8 10))
(9-8 . (0 1 2 3 4 6 8 9 10))
(9-9 . (0 1 2 3 5 6 7 8 10))
(10-1 . (0 1 2 3 4 5 6 7 8 9))
(10-2 . (0 1 2 3 4 5 6 7 8 10))
(10-3 . (0 1 2 3 4 5 6 7 9 10))
(10-4 . (0 1 2 3 4 5 6 8 9 10))
(10-5 . (0 1 2 3 4 5 7 8 9 10))
(10-6 . (0 1 2 3 4 6 7 8 9 10))
(11-1 . (0 1 2 3 4 5 6 7 8 9 10))
(12-1 . (0 1 2 3 4 5 6 7 8 9 10 11)))
% Setup of forte-dictionary as a vector of alists in which the
% keys are normal/prime forms of PC sets.
#(define forte-dictionary (make-vector 13))
#(define (set-pc-style all-sets)
(for-each
(lambda (n)
(let ((all-n-sets
(filter
(lambda (entry) (eq? (length (cdr entry)) n))
all-sets)))
(vector-set!
forte-dictionary n
(map
(lambda (number-set-pair)
(cons (cdr number-set-pair)
(symbol->string (car number-set-pair))))
all-n-sets))))
(iota 13)))
#(set-pc-style forte)
% ---------------------- General tools ----------------------------------------
#(define (assoc-list alist keys)
"Return the first entry in alist whose for the first possible key in keys. Keys are compared using equal?"
; "Vertical" searching (first choose a key and use assoc for this key) seems to be faster
; than "horizontal" searching.
(if (pair? keys)
(let* ((first-key (car keys))
(other-keys (cdr keys))
(instance (assoc first-key alist)))
(if instance
instance
(assoc-list alist other-keys)))
#f))
#(define* (comma-separate-strings lst #:optional (separator ","))
(if (pair? lst)
(if (pair? (cdr lst))
(string-append (car lst)
separator
(comma-separate-strings (cdr lst) separator))
(car lst))
""))
#(define (group-classes lst equivalent?)
; groups list in sublists of equivalent elements.
; equivalent? is assumed to be an equivalence relation
; TODO: Keep order (at the moment, reversed list is returned)
; (Solution: Wrap in let loop?)
(if (pair? lst)
(let* ((head
(car lst))
(tail-groups
(group-classes (cdr lst) equivalent?))
(group-of-head
(list-index (lambda (group) (equivalent? (car group) head))
tail-groups)))
(if group-of-head
(begin
(list-set! tail-groups group-of-head
(cons head (list-ref tail-groups group-of-head)))
tail-groups)
(cons (list head) tail-groups)))
'()))
#(define (all-numbers from to)
(iota (1+ (abs (- to from))) (min from to)))
#(define (sort-with-valuation lst val less)
; val is a valuation function on lst
; returns sorted list of pairs (x . (val x))
; The sort is stable.
(stable-sort!
(map (lambda (x) (cons x (val x))) lst)
(lambda (p q) (less (cdr p) (cdr q)))))
#(define (sort-by-valuation lst val less)
(map car (sort-with-valuation lst val less)))
#(define (print-and-return val)
(pretty-print val)
val)
#(define (range set) (- (last set) (first set)))
#(define (set-find-pattern set pattern)
; given a pattern (a b ...), return the first sublist
; of set starting with an element x such that
; x+a, x+b etc. are also in set.
; set is assumed to be sorted!
; Returns #f (not empty list) if pattern is not found!
(if (pair? set)
(if (every
(lambda (k) (member (+ (car set) k) set))
pattern)
set
(set-find-pattern (cdr set) pattern))
#f))
#(define (set-replace! set old new)
; replaces old by new in set.
; set is assumed to be (strictly) sorted and will be sorted!
; may operate destructively, but is NOT guaranteed to
; modify set in-place as desired!
; TODO: At the moment, no check is new is already in set!
(let ((sublist (member old set)))
(if (pair? sublist)
(begin
(list-set! sublist 0 new)
(sort! set <))
set)))
#(define (mark-duplicates els)
; given a list of elements, produces a same-length list of
; booleans indicating, for each element of the given list;
; if it has a twin in the list.
; e.g. input '(1 2 3 4 1 5 6 3)
; output '(#t #f #t #f #t #f #f #t)
(if (pair? els)
(let* ((head (car els))
(tail (cdr els))
(tail-duplicates (mark-duplicates tail))
(twin-in-tail (list-index (lambda (n) (eq? n head)) tail)))
(if twin-in-tail
(begin
(list-set! tail-duplicates twin-in-tail #t)
(cons #t tail-duplicates))
(cons #f tail-duplicates)))
'()))
#(define (lexicographic less) ; should less be assumed to be strictly less or less-or-equal?
(lambda (x y)
(cond ((null? x) #t)
((null? y) #f)
((equal? (car x) (car y)) ; which notion of equality should be used?
((lexicographic less) (cdr x) (cdr y)))
(else (less (car x) (car y))))))
#(define (lexicographic-by-size less) ; should less be assumed to be strictly less or less-or-equal?
(lambda (x y)
(let* ((length-x (length x))
(length-y (length y)))
(if (eq? length-x length-y)
(if (null? x)
#t ; arbitrary, might also be #f?
(if (equal? (car x) (car y)) ; which notion of equality should be used?
((lexicographic-by-size less) (cdr x) (cdr y))
(less (car x) (car y))))
(< length-x length-y)))))
#(define (strictly-sorted? numlist)
(cond ((null? numlist) #t)
((null? (cdr numlist)) #t)
(else (and (< (car numlist) (cadr numlist))
(strictly-sorted? (cdr numlist))))))
#(define (vector-increase-at! pos vec)
(vector-set! vec pos (1+ (vector-ref vec pos)))
vec)
% ---------------------- The chromatic_clash_engraver ----------------------------------
% This engraver, to be used in voice or staff contexts, forces the use of
% accidentals if diatonic clashes (such as c + cis) occur.
chromatic_clash_engraver =
#(lambda (ctx)
; writing the engraver as a context-dependent lambda
; makes sure that the notes are collected per-staff
; if the engraver is \consist'ed to all \Staff contexts.
(let ((note-events '()))
(make-engraver
(listeners
((note-event engraver event)
(set! note-events (cons event note-events))))
((process-music translator)
(let* ((pitches (map (lambda (ev) (ly:event-property ev 'pitch))
note-events))
(pitch-steps (map ly:pitch-steps pitches))
(clashes (mark-duplicates pitch-steps)))
(for-each (lambda (ev clash?)
(if clash? (ly:event-set-property! ev 'force-accidental #t)))
note-events clashes))
(set! note-events '())))))
% ---------------------- Basic PC set definitions -----------------------------
% "Chromatic pitches" are integers where 0 = middle c.
% A PC-set shall always be
% a) be sorted,
% b) made up of elements {0,...,11},
% c) without duplicates.
% normalize-pc-set guarantees a) and b).
% make-pc-set guarantees a)-c).
% PC sets made by make-pc-set are guaranteed to fulfill a)-c).
% A PC-set is _not_ assumed to always be rooted in 0.
% (i.e. a PC-set is an ordered subset of Z/12, but without
% identification of translates).
#(define (pitch-class? n)
(and (index? n)
(< n 12)))
#(define (pc-set? set)
(and (every pitch-class? set)
(strictly-sorted? set)))
% May be used instead of make-pc-set if input set is guaranteed
% not to contain duplicate pitch classes
#(define (normalize-pc-set set)
(sort (map (lambda (p) (modulo p 12)) set) <))
#(define (make-pc-set notes) (delete-duplicates (normalize-pc-set notes)))
% ---------------------- Elementary PC set operations --------------------------
#(define (set+ . sets) ; robust
(make-pc-set (apply append sets)))
#(define (set- set-a set-b) ; assumes conditions a)-c)
(filter (lambda (n) (not (memq n set-b))) set-a))
#(define chromatic-total (iota 12))
#(define (set-complement set) ; assumes conditions a)-c)
(filter (lambda (n) (not (memq n set))) chromatic-total))
% all-subsets does not produce a natural ordering of subsets.
% Maybe lexicographic-by-size?
#(define (all-subsets set)
(if (null? set)
(list set)
(let
((head (car set))
(subsets-without-head (all-subsets (cdr set))))
(append (map (lambda (subset) (cons head subset)) subsets-without-head)
subsets-without-head))))
#(define (all-supersets set)
(map (lambda (summand) (set+ set summand))
(all-subsets (set-complement set))))
% ---------------------- Interval vector operations ----------------------------
#(define (interval-class p1 p2)
; Calculates the intervall class in {0,...,6} between two chromatic pitches
(let ((diff (modulo (- p1 p2) 12)))
(if (> diff 6)
(- 12 diff)
diff)))
#(define (interval-vector set)
(if (pair? set)
(let* ((head (car set))
(tail (cdr set))
(work-vector (interval-vector tail)))
(for-each
(lambda (k)
(vector-increase-at! (1- (interval-class head k)) work-vector))
tail)
work-vector)
(make-vector 6 0)))
#(define (format-interval-vector vect)
(string-append
"<"
(string-concatenate (map number->string (vector->list vect)))
">"))
#(define (format-interval-vector-with-comma vect)
(string-append
"<"
(comma-separate-strings (map number->string (vector->list vect)))
">"))
% ---------------------- Unsorted operations -----------------------------------
#(define (zerobase-pc-set set)
(map (lambda (p) (- p (car set))) set))
#(define (rotate-pc-set set) ; TODO: Does not accept empty set at the moment.
(if (and (pair? set) ; test if set is non-empty ...
(pair? (cdr set))) ; ... and contains more than one element.
(normalize-pc-set (map (lambda (p) (- p (cadr set))) set))
set))
#(define (all-rotations set)
; generates list of all rotations of pitch class set, each zero-based.
(if (null? set)
(list set)
(fold (lambda (n lst)
(cons (rotate-pc-set (car lst)) lst)) ; ignore counter, add rotated version of list-head to list
(list (zerobase-pc-set set)) ; start with zerobased-version of set
(iota (1- (length set))))))
#(define (normal-forms set)
; Returns list of normal forms, i.e. rotations with minimal overall interval range
; expects a zero-based set!
; The list is unsorted (whereas a recursive lexicocraphic sorting might produce some kind of prime form as well).
; TODO: This function works with last's a lot; it might be more efficient to produce reversed rotations and work with car's.
(let* ((rotations (all-rotations set))
(ranges (map (lambda (rotation) (last rotation)) rotations))
(minimum-range (apply min ranges)))
(filter (lambda (rotation) (= (last rotation) minimum-range)) rotations)))
% What's the difference between sort and sort-list?
#(define (recurse-sets add-length base-part proc)
; In this function, pc-sets are ordered right-to-left for recursion.
; A right-hand base-part is amended at the start
; If recursion is complete, proc is called for the completed pc sets.
(if (zero? add-length)
(proc (reverse base-part))
(let ((new-minimum (1+ (car base-part))))
(for-each
(lambda (n) (recurse-sets (1- add-length) (cons n base-part) proc))
(iota (- 12 new-minimum) new-minimum)))))
#(define (for-each-zerobased-pc-set proc n)
(if (positive? n)
(recurse-sets (1- n) '(0) proc)
(proc '())))
#(define (set-equivalent? set-a set-b)
; tests transposition equivalence
; expects sets with condition a), b)
; returns empty list as #f value
(member (zerobase-pc-set set-b) (all-rotations set-a)))
#(define (set-invert set) (zerobase-pc-set (normalize-pc-set (map - set))))
#(define (set-transpose set k) (normalize-pc-set (map (lambda (p) (+ p k)) set)))
#(define (prime-form set) ; This is not the actual prime form in case of ambiguity!
(car (sort (normal-forms set) (lexicographic <))))
#(define (lookup-primeform-fortenumber set)
(let* ((rotations (all-rotations (make-pc-set set)))
(dictionary (vector-ref forte-dictionary (length (car rotations)))))
(assoc-list dictionary rotations)))
#(define (lookup-fortenumber set) (cdr (lookup-primeform-fortenumber set)))
#(define (lookup-primeform set) (car (lookup-primeform-fortenumber set)))
#(define (format-set set)
(string-append
"["
(comma-separate-strings (map number->string set))
"]"))
#(define (format-hex-set set)
(string-upcase (string-concatenate
(map (lambda (x) (number->string x 16)) set))))
#(define (generate-js-dictionary port)
(define* (format-js-variable-assignment variable-value)
(let ((variable (car variable-value))
(value (cdr variable-value)))
(if (list? value)
(string-append (format #f " ~s: [\n" variable)
(comma-separate-strings
(map (lambda (entry)
(format #f " ~s" entry))
value)
",\n")
(format #f "\n ]"))
(format #f " ~s: ~s" variable value))))
(define (format-js-variable-assignments variable-value-list)
(display (comma-separate-strings
(map format-js-variable-assignment variable-value-list) ",\n")
port))
(define (hex-prime-form set)
(format-hex-set (lookup-primeform set)))
(format port "export default {\n")
(map (lambda (n)
(map
(lambda (primeform-fortename)
(let* ((primeform (car primeform-fortename))
(fortename (cdr primeform-fortename))
(subsets (delete-duplicates (map hex-prime-form (all-subsets primeform))))
(supersets (delete-duplicates (map hex-prime-form (all-supersets primeform)))))
(format port " ~s: {\n" (format-hex-set primeform))
(format-js-variable-assignments
(list (cons "forteName" fortename)
(cons "complement" (lookup-fortenumber
(set-complement primeform)))
(cons "intervalVector" (format-interval-vector-with-comma
(interval-vector (car primeform-fortename))))
(cons "subSets" subsets)
(cons "superSets" supersets)))
(format port "\n },\n")))
(vector-ref forte-dictionary n)))
(iota 13))
(format port "};\n")
(ly:warning "Don't forget to remove last comma in .js output!"))
% ---------------------- LilyPond interface ------------------------------------
forteNumber =
#(define-scheme-function (set) (pc-set?) (lookup-fortenumber set))
tablePrimeForm =
#(define-scheme-function (set) (pc-set?)
(markup (format-set (car (lookup-primeform-fortenumber set)))))
addChordForteNumber =
#(define-music-function (mus) (ly:music?)
(if (music-is-of-type? mus 'event-chord)
#{
$mus - \forteNumber \PCset #mus #}
mus))
addChordPrimeForm =
#(define-music-function (mus) (ly:music?)
(if (music-is-of-type? mus 'event-chord)
#{
<<
$mus
\context Lyrics = "pf" \lyricmode {
\markup { \rotate #30 \tiny \typewriter \tablePrimeForm \PCset #mus }
}
>>
#}
mus))
addChordPrimeFormAndIntervalVector =
#(define-music-function (mus) (ly:music?)
(if (music-is-of-type? mus 'event-chord)
(let ((set (PCset mus)))
#{
<<
$mus
\context Lyrics = "pf" \lyricmode {
\markup { \rotate #30 \teeny \bold \typewriter \tablePrimeForm #set }
}
\context Lyrics = "iv" \lyricmode {
\markup { \rotate #30 \teeny \typewriter #(format-interval-vector (interval-vector set)) }
}
>>
#})
mus))
PCset =
#(define-scheme-function (notes) (ly:music?)
(make-pc-set (map ly:pitch-semitones (music-pitches notes))))
% ---------------------- Circle of fifths tools --------------------------------
% PC set = set of chromatic pitch classes in Z/12Z (c = 0, c# = 1 etc.)
% CFPC set = circle of fifth chromatic pitch classes in Z/12Z (d = 0, a = 1 etc.)
% SFPC set = stack of fifth diatonic pitch classes in Z (d = 0)
%
% C/SFPC pitch classes are centered on 0 = d since that way
% the white keys are
% { f = -3, c = -2, g = -1, d = 0, a = 1, e = 2, b = 3 }
#(define cfpc-set? pc-set?)
% Internally, both sets are represented by (wlog ordered) sets in Z/12Z
#(define (sfpc-set? set)
(and (every integer? set)
(strictly-sorted? set)))
#(define make-cfpc-set make-pc-set)
#(define (pc-set->cfpc-set set)
(make-cfpc-set (map (lambda (p) (* (- p 2) 7)) set)))
#(define (cfpc-set->pc-set set)
(make-pc-set (map (lambda (p) (+ (* p 7) 2)) set)))
#(define (accidental-count sfpc)
; sfpc is a stack-of-fifth class, 0 = d.
(round (/ sfpc 7)))
#(define (accidental-weight n)
; 0 accidentals: weight 0
; 1 accidental: weight 3
; 2 accidentals: weight 15
(1- (ash 1 (* 2 (abs n)))))
#(define (sfpc-set-accidental-weight set)
(apply +
(map (lambda (k) (accidental-weight (accidental-count k))) set)))
#(define (all-sfpc-liftings-of-cfpc-set set)
; expects a chromatic fifths set, sorted, elements in 0..11.
; the resulting list is sorted by range (last - first)
(sort
(fold
(lambda (n prev)
(cons
(cdr (append (car prev) (list (+ 12 (caar prev)))))
prev))
(list set)
(iota (1- (length set))))
(lambda (p q) (< (range p) (range q)))))
#(define (cfpc-set->sfpc-set set)
; Lifts a CFPC set to a SFPC set.
; The lifted set is guaranteed to map to cfpc-set via Z -> Z/12Z
; The lifting is chosen as follows:
; - First, a lifting with least possible fifth ranges is chosen
; - Then, we try to eliminate doubly-chromatic clashes
; - Lastly, we move by multiples of 12 in order to center around 0
; as far as possible
(let* ((lifted-set (car (all-sfpc-liftings-of-cfpc-set set))))
; (range (last lifted-set))
; (shift (truncate (/ range 2))))
(do ((i 1 (1+ i)))
((> i 3)) ; Three rounds of optimization seem to suffice ...
; TODO: The following four operations repeat code in a bad way...
; Turn (c cis d) into (his cis d), i.e. (0 2 7) into (2 7 12)
(let ((c-cis-d (set-find-pattern lifted-set '(2 7))))
(if c-cis-d
(set! lifted-set (set-replace! lifted-set (car c-cis-d) (+ 12 (car c-cis-d))))))
; Turn (h c cis) into (h c des), i.e. (0 5 7) into (0 5 -5)
(let ((c-h-cis (set-find-pattern lifted-set '(5 7))))
(if c-h-cis
(set! lifted-set (set-replace! lifted-set (+ 7 (car c-h-cis)) (+ -5 (car c-h-cis))))))
; Turn (c cis dis) into (his cis dis), i.e. (0 7 9) into (7 9 12)
(let ((c-cis-dis (set-find-pattern lifted-set '(7 9))))
(if c-cis-dis
(set! lifted-set (set-replace! lifted-set (car c-cis-dis) (+ 12 (car c-cis-dis))))))
; Turn (c d dis) into (c d es), i.e. (0 2 9) into (0 2 3)
(let ((c-d-dis (set-find-pattern lifted-set '(2 9))))
(if c-d-dis
(set! lifted-set (set-replace! lifted-set (+ 9 (car c-d-dis)) (+ -3 (car c-d-dis))))))
) ; end of stupid loop to do 4 passes of optimization
(let* ((mean (/ (+ (first lifted-set) (last lifted-set)) 2))
(correction (* 12 (round (/ mean 12)))))
(map (lambda (p) (- p correction)) lifted-set))))
#(define (whitecenter-sfpc-set set)
; transposes an sfpc set in such a way that we prefer white
; keys and make double accidentals expensive.
; Idea: Given a sorted sfpc-set (a b ... z),
; left-most candidate arises by shifting by z to the left,
; right-most candidate arises by shifting by a to the left.
; Hence: Add all indices from (-z, ..., -a)
(first (sort-by-valuation
(map (lambda (shift)
(map (lambda (x) (- x shift)) set))
(all-numbers (first set) (last set)))
sfpc-set-accidental-weight
<)))
#(define (sfpc->pitch p)
(let* ((mittle-d (ly:make-pitch 0 1))
(fifth-up (ly:make-pitch 0 4))
(fifth-down (ly:make-pitch -1 3))
(step (if (negative? p) fifth-down fifth-up)))
(car (fold
(lambda (n lst) (cons (ly:pitch-transpose (car lst) step) lst))
(list mittle-d)
(iota (abs p))))))
chordFromCFPCset =
#(define-music-function (set) (cfpc-set?)
#{
% Should add a function to sanitize chords
% in order to remove f-fis-clashes.
< $@(map normalize-pitch (map sfpc->pitch (whitecenter-sfpc-set (cfpc-set->sfpc-set set)))) >
#})
niceChordFromPCset =
#(define-music-function (set) (pc-set?)
(chordFromCFPCset (pc-set->cfpc-set set)))
% ---------------------- Tests and examples ------------------------------------
%{
#(map (lambda (entry)
(let ((prime-form (car entry))
(number (cdr entry)))
(format #t "~a ~a\n" number (lookup-fortenumber (set-complement prime-form)))))
(vector-ref forte-dictionary 5))
%}
#(set-pc-style forte-distinct-inverses)
%{
\fixed c'
{
\musicMap #addChordForteNumber {
\textLengthOn
\accidentalStyle modern
\time 1/4
\omit Stem
\omit Score.TimeSignature
\omit Score.BarLine
\override TextScript.baseline-skip = 2.4
<c es g>^Molldreiklang
<c e g>^Durdreiklang
<c e gis>^\markup\column{übermäßiger Dreiklang}
<c es ges>^\markup\column{verminderter Dreiklang}
<c d g>^"sus2"
<c f g>^"sus4"
<c f bes>^Doppelquarte
<c f b>^\markup\column{Viennese Trichord}
<c fis b>^\markup\column{Viennese Trichord?}
% <c e bes>
% <c ges bes>
% <c e b>
% <c g b>
\once\undo\omit Score.BarLine \bar "."
<cis e g b>^"Halbverminderter"
<c e g bes>^"Dominantseptakkord"
<c es g bes>^"moll7"
<cis e g bes>^"Verminderter"
<c e g b>^"maj7"
<c e g d'>^"add9"
<c es g d'>^"m-add9"
\once\undo\omit Score.BarLine \bar "."
}
}
%}
PCsetChord =
#(define-music-function (set) (pc-set?)
#{
<
$@(map (lambda (n)
(make-music
'NoteEvent
'duration
(ly:make-duration 2)
'pitch
(normalize-and-respell-pitch (ly:make-pitch 0 0 (/ n 2)))))
set)
>
#}
)
\paper {
system-system-spacing.padding = 5
}
\layout {
\context {
\Staff
\consists \chromatic_clash_engraver
}
\accidentalStyle modern
\textLengthOn
\omit Score.TimeSignature
\override TextScript.direction = #UP
\override TextScript.self-alignment-X = #CENTER
\override TextScript.parent-alignment-X = #CENTER
\override TextScript.X-align-on-main-noteheads = ##t
\override TextScript.font-size = -1
\omit Score.BarNumber
}
%{
\new Staff {
\time 1/4
$@
(map addChordForteNumber
(map addChordPrimeForm
(map niceChordFromPCset
(map car (vector-ref forte-dictionary 5)))))
}
%}
#(define (list-of-pc-set-tuples n)
; Yields the list of all n-sets in the current forte-dictionary
; in groups of set, inverse and (if n = 6) complement.
(group-classes
(map car (vector-ref forte-dictionary n))
(if (equal? n 6)
(lambda (set-a set-b)
(or (set-equivalent? set-a set-b)
(set-equivalent? set-a (set-invert set-b))
(set-equivalent? set-a (set-complement set-b))
(set-equivalent? set-a (set-complement (set-invert set-b)))))
(lambda (set-a set-b)
(or (set-equivalent? set-a set-b)
(set-equivalent? set-a (set-invert set-b)))))))
allSets =
#(define-void-function (n) (index?)
(add-score
#{
\score {
\layout {
indent = 0
ragged-last = ##t
\override Lyrics.VerticalAxisGroup.nonstaff-nonstaff-spacing.padding = 0.7
\override Lyrics.VerticalAxisGroup.nonstaff-nonstaff-spacing.minimum-distance = 0
}
\new Staff {
\set Timing.defaultBarType = ""
\textLengthOn
\time 1/4
$@(map (lambda (list-of-sets) #{
$@
(map addChordPrimeFormAndIntervalVector
(map addChordForteNumber
(map niceChordFromPCset list-of-sets)))
\bar "|" #})
(list-of-pc-set-tuples n))
}
} #}
))
%{
"027": {
"rahnPrimeForm": "027",
"fortePrimeForm": "027",
"intervalVector": "010020",
"forteName": "3-9",
"cardinality": 3,
"zMate": null
}
%}
#(format #t "~a ~a\n" (get-internal-real-time) (get-internal-run-time))
#(let ((port (open-output-file "list.js")))
(generate-js-dictionary port)
(close-port port))
#(format #t "~a ~a\n" (get-internal-real-time) (get-internal-run-time))
%{
\book {
\paper {
page-breaking = #ly:one-page-breaking
score-system-spacing.padding = 15
}
\header {
tagline = ##f
}
#(for-each allSets (iota 12 1))
}
%}
