defaultxr / cl-patterns

Library for writing patterns to generate or process (a)musical sequences of mathematically (un)related (non-)compound values in Lisp.
https://w.struct.ws/cl-patterns
MIT License
76 stars 10 forks source link

Add 12-tone matrix generator #29

Closed jagrg closed 2 years ago

jagrg commented 2 years ago

This is a feature request. I'd like to generate 12-tone matrices. Something like:

(matrix (list (3 7 e 5 1 0 2 4 6 8 t 9)))

'((3 7 e 5 1 0 2 4 6 8 t 9)
  (e 3 7 1 9 8 t 0 2 4 6 5)
  (7 e 3 9 5 4 6 8 t 0 2 1)
  (1 5 9 3 e t 0 2 4 6 8 7)
  (5 9 1 7 3 2 4 6 8 t 0 e)
  (6 t 2 8 4 3 5 7 9 e 1 0)
  (4 8 0 6 2 1 3 5 7 9 e t)
  (2 6 t 4 0 e 1 3 5 7 9 8)
  (0 4 8 2 t 9 e 1 3 5 7 6)
  (t 2 6 0 8 7 9 e 1 3 5 4)
  (8 0 4 t 6 5 7 9 e 1 3 2)
  (9 1 5 e 7 6 8 t 0 2 4 3))

Then we could map each element to generate the music:

'((3 . "beat_00")
  (7 . "beat_01")
  (e . "beat_02")
  (5 . "beat_03")
  (1 . "beat_04")
  (0 . "beat_05")
  (2 . "beat_06")
  (4 . "beat_07")
  (6 . "beat_08")
  (8 . "beat_09")
  (t . "beat_10")
  (9 . "beat_11"))

WDYT?

defaultxr commented 2 years ago

I have to admit I'm not really familiar with 12-tone matrices and their use, but I did find a paper when searching that explained how to produce them, and I was able to write a function based on the instructions in the paper:


(defun tone-matrix (tones)
  "Generate a tone matrix from TONES."
  (labels ((row-head (row)
             (- 12 (nth row tones)))
           (generate-row (row &optional (col 0))
             (if (zerop row)
                 tones
                 (when (< col 12)
                   (cons (if (zerop col)
                             (row-head row)
                             (mod (+ (row-head row) (nth col tones)) 12))
                         (generate-row row (1+ col)))))))
    (loop :for row :from 0 :below 12 :collect (generate-row row))))

(tone-matrix (list 0 11 7 8 3 1 2 10 6 5 4 9))

This function seems to produce the same results as the example in the paper does, but it only works based on numbers, so it won't work with e and t like you have in your example. I'm not sure if maybe e and t are just alternate notation for 10 and 11 or similar though?

As for remapping the elements to generate music, this could simply be done with a mapcar like so:

(defparameter *map* '((3 . "beat_00")
                      (7 . "beat_01")
                      (10 . "beat_02")
                      (5 . "beat_03")
                      (1 . "beat_04")
                      (0 . "beat_05")
                      (2 . "beat_06")
                      (4 . "beat_07")
                      (6 . "beat_08")
                      (8 . "beat_09")
                      (11 . "beat_10")
                      (9 . "beat_11")))

(mapcar (lambda (n) (cdr (assoc n *map*)))
        (nth 1 (tone-matrix (list 0 11 7 8 3 1 2 10 6 5 4 9))))

(Again, I'm not sure if e and t are supposed to represent 10 and 11, but I swapped them for this example)

Of course, you can grab the row you want from the matrix using nth as shown, and once you've generated the list you want you can pass it to any pattern that accepts lists, like pseq or similar. But most patterns expect events rather than strings as we've generated here, so you might want to change the *map* so that it maps each number to an event or some other value that the patterns system would expect.

Is this along the lines of what you're looking for?

I would be open to adding something like this to the library since this seems to be a musically-useful function that others might want as well. Probably once I am more familiar with tone matrices I could add more features to this implementation and make sure it integrates with the rest of the library as much as possible.

Let me know if there is anything obvious missing from this implementation or if it's wrong or anything. Otherwise I'll probably add it in a future commit once I've played with it a bit more.

jagrg commented 2 years ago

The numbers don't repeat, and that's the idea, but the first column should be an inversion of the first row. In this example

| 5 | 6 | 9 | 8 | 7 | 4 | 3 | 11 | 3 | 0 | 1 | 2 | 10 |
| 4 |   |   |   |   |   |   |    |   |   |   |   |    |
| 1 |   |   |   |   |   |   |    |   |   |   |   |    |

the first number of the second row is 4 because from 5 to 6 is 1, so you move in the opposite direction to find its inversion, which in this case is 4 or (- 5 1). From 6 to 9 is 3, so (- 4 3) is 1 and so on. There are a few ways to solve this manually. Here's one. BTW your number system looks fine.

jagrg commented 2 years ago

BTW your function works if the initial row begins with a 0. Do you know how to fix this? I would also suggest using the length of TONES to determine the size of the matrix. This makes it possible to serialize sequences other than 12. Here's an example using a 4 x 4 matrix.

#+begin_src elisp
(defun tone-matrix-1 (tones)
  (let ((len (length tones)))
    (cl-labels ((row-head (row)
              (- len (nth row tones)))
        (generate-row (row &optional (col 0))
                  (if (zerop row)
                  tones
                (when (< col len)
                  (cons (if (zerop col)
                        (row-head row)
                      (mod (+ (row-head row) (nth col tones)) len))
                    (generate-row row (1+ col)))))))
      (cl-loop for row from 0 below len
           collect (generate-row row)))))
#+end_src

#+name: row
#+begin_src elisp 
'(0 2 1 3)
#+end_src

#+name: prime
#+begin_src elisp :var row=row
(tone-matrix-1 row)
#+end_src

#+results: prime
| 0 | 2 | 1 | 3 |
| 2 | 0 | 3 | 1 |
| 3 | 1 | 0 | 2 |
| 1 | 3 | 2 | 0 |

#+name: retrograde
#+begin_src elisp :var row=row
(let (table)
  (mapcar (lambda (row)
        (push (nreverse row) table))
      (tone-matrix-1 row))
  (nreverse table))
#+end_src

#+results: retrograde
| 3 | 1 | 2 | 0 |
| 1 | 3 | 0 | 2 |
| 2 | 0 | 1 | 3 |
| 0 | 2 | 3 | 1 |

#+name: inversion
#+begin_src elisp :var data=prime
(defun matrix-row (idx &optional reverse)
  (let (table)
    (mapcar (lambda (x)
          (push (nth idx x) table))
        data)
    (if reverse (nreverse table) table)))

(let (table)
  (cl-loop for i from 0 to (1- (length data))
       do (push (matrix-row i 'reverse) table))
  (nreverse table))
#+end_src

#+results: inversion
| 0 | 2 | 3 | 1 |
| 2 | 0 | 1 | 3 |
| 1 | 3 | 0 | 2 |
| 3 | 1 | 2 | 0 |

#+name: retrograde-inversion
#+begin_src elisp :var data=prime
(let (table)
  (cl-loop for i from 0 below (length data)
       do (push (matrix-row i) table))
  (nreverse table))
#+end_src

#+results: retrograde-inversion
| 1 | 3 | 2 | 0 |
| 3 | 1 | 0 | 2 |
| 2 | 0 | 3 | 1 |
| 0 | 2 | 1 | 3 |
jagrg commented 2 years ago

I found this, but I think it works with 12 tones only.

jagrg commented 2 years ago

I tried to implement something based on that video. Phew. What it does is it finds the inversion (first column) of a given row (first row) to find the transpositions of the remaining rows. Looks ugly but I think it works.

(defun invert-row (row)
  "Generate an inversion of ROW."
  (let ((prime-first (car row))
    (len (length row)) first inversion)
    (dolist (_ row)
      (let ((a (cl-first row))
        (b (cl-second row)))
    (when (> (length row) 1)
      (setq first (or (car inversion) a)
        row (cl-rest row))
      (let ((n (+ (- a b) first)))
        (push (cond ((< n 0)
             (+ n len))
            ((> n len)
             (- n len))
            (t n))
          inversion)))))
    (append (list prime-first) (nreverse inversion))))

(defun transpose-row (row index)
  "Transpose ROW from INDEX."
  (let* ((inversion (invert-row row))
     (len (length row))
     (n (- (car row) (nth index inversion)))
     transposition)
    (dolist (i row)
      (let ((j (+ i (- n))))
    (push (cond ((> j len)
             (- j len))
            ((< j 0)
             (+ j len))
            ((= j len) 0)
            (t j))
          transposition)))
    (nreverse transposition)))

(defun tone-matrix (row)
  "Build matrix from ROW."
  (let (matrix)
    (dotimes (i (length row))
      (push (transpose-row row i) matrix))
    (nreverse matrix)))
#+begin_src elisp
(tone-matrix '(5 6 9 8 7 4 3 11 0 1 2 10))
#+end_src

#+results:
|  5 |  6 |  9 |  8 |  7 |  4 |  3 | 11 |  0 |  1 |  2 | 10 |
|  4 |  5 |  8 |  7 |  6 |  3 |  2 | 10 | 11 |  0 |  1 |  9 |
|  1 |  2 |  5 |  4 |  3 |  0 | 11 |  7 |  8 |  9 | 10 |  6 |
|  2 |  3 |  6 |  5 |  4 |  1 |  0 |  8 |  9 | 10 | 11 |  7 |
|  3 |  4 |  7 |  6 |  5 |  2 |  1 |  9 | 10 | 11 |  0 |  8 |
|  6 |  7 | 10 |  9 |  8 |  5 |  4 |  0 |  1 |  2 |  3 | 11 |
|  7 |  8 | 11 | 10 |  9 |  6 |  5 |  1 |  2 |  3 |  4 |  0 |
| 11 |  0 |  3 |  2 |  1 | 10 |  9 |  5 |  6 |  7 |  8 |  4 |
| 10 | 11 |  2 |  1 |  0 |  9 |  8 |  4 |  5 |  6 |  7 |  3 |
|  9 | 10 |  1 |  0 | 11 |  8 |  7 |  3 |  4 |  5 |  6 |  2 |
|  8 |  9 |  0 | 11 | 10 |  7 |  6 |  2 |  3 |  4 |  5 |  1 |
|  0 |  1 |  4 |  3 |  2 | 11 | 10 |  6 |  7 |  8 |  9 |  5 |
defaultxr commented 2 years ago

Sorry for the delay in responses. Your function does indeed seem to work according to the description in the video. I also tried (re)implementing my version based on the instructions in the video and here's how it turned out:

(defun tone-matrix (tones)
  (let* ((length (length tones))
         (diffs (loop :repeat (1- length)
                      :for (one two) :on tones
                      :collect (- one two))))
    (labels ((row-head (row-number last-row)
               (mod (+ (first last-row)
                       (nth row-number diffs))
                    12))
             (generate-row (row-number last-row)
               (when (nth row-number diffs)
                 (let* ((num (row-head row-number last-row))
                        (row (cons num (loop :for diff :in diffs
                                             :do (setf num (mod (- num diff) 12))
                                             :collect num))))
                   (cons row (generate-row (1+ row-number) row))))))
      (cons tones (generate-row 0 tones)))))

I'm not sure if this is more or less clear than yours; it's shorter but it might actually be harder to read. But it seems to generate the correct results, at least according to the example in the video. Maybe the best version would take influence from each of ours. For example yours uses better terminology/variable names, but I think it could be made more clear by using (for example) (mod N 12) instead of the cond you have.

jagrg commented 2 years ago

Looks much better. Thanks a lot!

You need the variable length in place of 12. Also, the matrix is read from left to right, right to left, top to bottom, and bottom to top, so we need functions that give us that information as well. That's all I have for now.

defaultxr commented 2 years ago

Sorry for the delay in updates on this. To be clear, you're saying that there should also be functions to extract individual rows and columns from the matrix as well (and variants for the "reverse", i.e. right-to-left and bottom-to-top)? So if we do this:

(defparameter tones (list 5 6 9 8 7 4 3 11 0 1 2 10))
(defparameter matrix (tone-matrix tones))
;; result:
;; ((5 6 9 8 7 4 3 11 0 1 2 10)
;;  (4 5 8 7 6 3 2 10 11 0 1 9)
;;  (1 2 5 4 3 0 11 7 8 9 10 6)
;;  (2 3 6 5 4 1 0 8 9 10 11 7)
;;  (3 4 7 6 5 2 1 9 10 11 0 8)
;;  (6 7 10 9 8 5 4 0 1 2 3 11)
;;  (7 8 11 10 9 6 5 1 2 3 4 0)
;;  (11 0 3 2 1 10 9 5 6 7 8 4)
;;  (10 11 2 1 0 9 8 4 5 6 7 3)
;;  (9 10 1 0 11 8 7 3 4 5 6 2)
;;  (8 9 0 11 10 7 6 2 3 4 5 1)
;;  (0 1 4 3 2 11 10 6 7 8 9 5))

Then you're suggesting functions like this:

;; extract the matrix's third row from left to right:
(tone-matrix-row-left-right matrix 2) ;; result: (1 2 5 4 3 0 11 7 8 9 10 6)

;; extract the matrix's third row from right to left:
(tone-matrix-row-right-left matrix 2) ;; result: (6 10 9 8 7 11 0 3 4 5 2 1)

;; extract the matrix's second column from top to bottom:
(tone-matrix-column-top-bottom matrix 1) ;; result: (6 5 2 3 4 7 8 0 11 10 9 1)

;; extract the matrix's second column from bottom to top:
(tone-matrix-column-bottom-top matrix 1) ;; result: (1 9 10 11 0 8 7 4 3 2 5 6)

Am I understanding that correctly?

I was thinking maybe it would be even simpler if the tone-matrix function itself just accepted keyword arguments to specify which column/row are wanted. So storing the matrix in a variable would not be necessary. For example, instead of (tone-matrix-row-left-right matrix 2), you could just do (tone-matrix tones :row-left-right 2); instead of (tone-matrix-column-top-bottom matrix 1) you could do (tone-matrix tones :column-top-bottom 1); etc. And of course, if you just want the entire matrix, you can just omit the keyword arguments entirely and still get it as usual.

That way, all of the functionality for accessing the results of the tone matrix calculation are together in one function. To me, that seems cleaner/neater from an API design standpoint. But I'm not sure if maybe that makes less sense from the perspective of how the tone matrix functionality would actually be used in practice.

jagrg commented 2 years ago

Not individual rows, but all transformations in Lisp terms. Something like:

(tone-matrix tones)         ;left to right

'((0 1 2)
  (2 0 1)
  (1 2 0))

(tone-matrix tones 'inversion)      ;top to bottom

'((0 2 1)
  (1 0 2)
  (2 1 0))

(tone-matrix tones 'retrograde)     ;right to left

'((2 1 0)
  (1 0 2)
  (0 2 1))

(tone-matrix tones 'retrograde-inversion) ;bottom to top

'((1 2 0)
  (2 0 1)
  (0 1 2))

I'd keep things simple for now.

defaultxr commented 2 years ago

Sorry for the delay; I finally added tone-matrix to cl-patterns, as well as tests for the cases we discussed here. So I think it should be correct. I also made it work for lists of tones that are of lengths other than 12. Let me know if you find any issues with it.

jagrg commented 2 years ago

Many thanks for you work. I'm busy ATM, but I'll test this by the end of the month.

jagrg commented 2 years ago

Hi. I'm getting The function CL-PATTERNS::FLOP is undefined error.

defaultxr commented 2 years ago

Hmm, flop is exported by mutility, which cl-patterns uses. Do you have an old version of mutility in your local-projects perhaps? Or maybe you need to (ql:update-dist "quicklisp")?

jagrg commented 2 years ago

(ql:update-dist "quicklisp") fixed it. Thanks!

jagrg commented 1 year ago

Many thanks for you work. I'm busy ATM, but I'll test this by the end of the month.

defaultxr commented 1 year ago

No problem! And no rush either :)