Composing various polyphonic textures concisely

[torstenanders]

I am interested in controlling musical textures, i.e., relations between polyphonic parts. I defined a bunch of functions that use the simple polyphonic music representation used also by my function preview-score that I presented shortly (see https://opusmodus.com/forums/topic/902-polyphonic-preview/#comment-2686). Apologies that this post is a bit longer. 

 

Here is a particularly flexible function: map-parts transforms a polyphonic score. It is a variant of the standard Lisp function mapcar, where a function is applied to every part in a score, but each instrument/part can be given its own function arguments for the transformation. One argument is the respective part of the score. This argument is marked by an underscore (_) in the argument lists.

 

In the following example, the function pitch-transpose is applied to a score with two very simple parts consisting of only a single note each. This function has two required arguments, a transposition interval (measured in semitones), and the pitch sequence or OMN to transpose. The transposition interval for the first part is 4 (major third upwards), and the underscore marks the position of the violin part to transpose, etc.

 

Note that you can always see and hear the resulting score by wrapping preview-score around each example. Hopefully these examples sufficiently demonstrate my need to have some shortcut for preview-score :)

(map-parts '(:vln ((h e4)) :vlc ((h c3)))  
     	   #'pitch-transpose   
     	   '(:vln (4 _) :vlc (12 _))) 
=> (:vln ((h gs4)) :vlc ((h c4)))

 

Here are a few more relatively simple application examples. I am first defining some musical material to reduce the length of the remaining definitions. 

(setf material '((-3h fs4 pp eb4 <) (q e4 < fs4 <) (3h gs4 mp> a4 > bb4 >) (q a4 pp -)
                 (-5h - g4 pp leg eb4 < leg d4 < leg) (q bb4 < e4 <)
                 (5h g4 mp> leg b4 > leg a4 > leg bb4 > leg d4 > leg) (q gs4 pp -)))

 

Now, the next example creates a strict canon formed with the given material -- but without following any counterpoint rules :)  For different parts the material is metrically shifted and transposed.

This example also shows that map-parts calls can be nested (naturally). The function metric-shift appends some rest before some musical material, but preserves its rhythmical structure, i.e. metrically shifts the material.   

(map-parts  
       (map-parts `(:vl1 ,material 
                    :vl2 ,material   
                    :vla ,material 
                    :vlc ,material) 
                  #'metric-shift  
                  '(:vl1 :skip ;; :skip means to leave part unchanged 
                    :vl2 (-q _)   
                    :vla (-h _) 
                    :vlc (-h. _))) 
       #'pitch-transpose 
       '(:vl1 (6 _)  
         :vl2 (4 _)   
         :vla (2 _) 
         :vlc :skip)) 

 

The next examples shows some simple homorhythmic texture created by randomised transpositions. Each part shares a similar overall pitch profile. Note also that calls can be more concise with a (lambda) function that nests calls to transformation functions -- instead of nesting map-parts as shown above.

(map-parts `(:vl1 ,material 
                  :vl2 ,material   
     	     :vla ,material 
     	     :vlc ,material) 
     	   #'(lambda (transpose seq) 
     	       ;; static transposition for moving parts into different registers 
     	       (pitch-transpose  
     		transpose  
     		;; randomised transposition of notes in parts 
     		(pitch-transpose-n (rnd 10 :low -2 :high 2) seq))) 
     	   '(:vl1 (7 _)  
     	     :vl2 (0 _)   
     	     :vla (-10 _) 
     	     :vlc (-20 _)))

 

Finally, here is a homophonic texture created by random pitch variants (retrograde, inversion etc.). The global pitch profiles of parts differ here, in contrast to the previous example.

(map-parts  
       `(:vl1 ,material 
         :vl2 ,material   
         :vla ,material 
         :vlc ,material) 
       #'pitch-variant  
       `(:vl1 (_ :transpose 7 :seed 10)  
         :vl2 (_ :transpose 0 :seed 20)   
         :vla (_ :transpose -10 :seed 30) 
         :vlc (_ :transpose -20 :seed 40)) 
        :shared-args '(:variant ?))

 

All these examples demonstrate very conventional textures, as such textures are more easy to explain.  

 

For completeness, below is the definition of MAP-PARTS. There are various dependencies that I tried all to add as well. Please let me know if I missed any definition, and apologies in advance.

 

Best,

Torsten

(defun map-parts (score fn part-args &key 
			(parameter nil) 
                        (shared-args nil))
  "Create or transform a polyphonic score. The original purpose is for creating/transforming musical textures, i.e., relations between polyphonic parts.

  Applies function `fn' to parts in `score': this function is a variant of the standard Lisp function `mapcar', but specialised for scores. A score is represented in the format discussed in the documentation of the function `preview-score'.     
    
    Additional arguments for `fn' can be specified in `part-args', and these argument lists can be different for each part. However, one argument is the part of the score. This argument is marked by an underscore (_) in the argument lists. In the following example, the function `pitch-transpose' is applied to a score with two parts. This function has two required arguments, a transposition interval (measured in semitones), and the pitch sequence or OMN to transpose. The transposition interval for the first part is 4 (major third upwards), and the underscore marks the position of the violin part to transpose, etc. 
 
;;; (map-parts '(:vln ((h e4)) 
;;; 	     :vlc ((h c3))) 
;;; 	   #'pitch-transpose  
;;; 	   '(:vln (4 _)  
;;; 	     :vlc (12 _)))

    Args:
    - score (headerless score): See {defun preview-score} for format description. 
    - fn: A function that expects and returns an OMN sequence or a sequence of parameter values (e.g., lengths, or pitches) as specified in the argument `parameter'. 
    - part-args (plist): Alternating instrument keywords (same as in `score') followed by arguments list for `fn' for that instrument/part. If arguments is :skip, then that part is returned unchanged. 
    - parameter (omn parameter, e.g., :length or :pitch, default nil means processing full OMN expression): If `fn' expects only single parameter to process, then it can be set here. 
    - shared-args (list): For all instruments/parts, these arguments are appended at end end of its part-specific arguments. They are useful, e.g., for keyword arguments. 
    "
  ;; catching hard-to-find user error...
  (let* ((instruments (get-instruments score))
         (missing-instruments (remove-if #'(lambda (arg-instr) (member arg-instr instruments)) (get-instruments part-args))))
    (assert (not missing-instruments)
            (part-args)
            "map-parts: Some instruments in `part-args' don't have a matching instrument in `score'. ~A.~%" missing-instruments))  
  (let ((parts (make-hash-table :test #'equal)))
    ;; fill hash table, using leading keywords as keys
    (loop for part in (tu:plist->pairs score)
      do (setf (gethash (first part) parts) part))
    (tu:pairs->plist 
     (loop 
       for instrument-arg-pair in (tu:plist->pairs part-args) 
       for instrument = (first instrument-arg-pair)
       for part = (gethash instrument parts)
       for part-omn = (second part)
       for fn-args = (second instrument-arg-pair) 
       collect (if (equal fn-args :skip)
                 part ; no processing
                 (cons instrument
                       (let ((result (apply fn (append (substitute 
                                                        (if parameter
                                                          (omn parameter part-omn)
                                                          part-omn)
                                                        '_ fn-args)
                                                       shared-args))))
                         (list 
                          (if parameter
                            (omn-replace parameter result part-omn)
                            result)))))
       ))))
       
(defun metric-shift (l lengths)
  "Appends `l' (a length or omn) before `lengths' (a list of lengths or omn), but maintains the metric structure, i.e., the function shifts `lengths' metrically 'to the right' by `l'.
  Returns an OMN form if lengths is an OMN form, otherwise a length form.

  Related: assemble-seq (but that does not shift across bars)"
  (let* ((time-sigs (get-time-signature lengths))
         (result (omn-to-time-signature (cons l (flatten lengths)) time-sigs)))
    (if (omn-formp lengths)
        result
      (omn :length result))))
      
; (metric-shift '-h '((q q q q) (q q q q)))
; (metric-shift '(h g4) '((q c4 q d4 q e4 q f4) (q c4 q d4 q e4 q f4)))

(defun get-instruments (score)
  "Returns all instruments of `score', a headerless score (see {defun preview-score} for its format)."
  (at-even-position score))
  
(defun at-even-position (in-list)
  (at-position in-list 2 0))
  
(defun at-position (in-list factor offset)
  "Returns a list containing every factor-th elements of in-list starting at offset"
  (mapcar #'(lambda (i) (nth i in-list))
          (arithmeric-series factor offset (ceiling (/ (length in-list)
                                                       factor)))))
                                                       
(defun arithmeric-series (factor offset length)
  (let (result)
    (reverse
     (dotimes (i length result)
       (push (+ (* i factor) offset)
             result)))))
           
(defun plist->pairs (plist)
  (loop :for (key val) :on plist :by #'cddr
    :collect (list key val)))

(defun pairs->plist (pairs)
  (one-level-flat pairs))

(defun one-level-flat (list)
  "flatens one level of the given form.
Example: (one-level-flat '(((note) (note)) ((pause) (pause)) ((note))))
-> ( (note) (note)  (pause) (pause)  (note))"
  (apply #'append list))

 

[Stephane Boussuge]

Hi Torsten,

i get a:

Error: There is no package named "TU"

 

 

i like the metric-shift function (not only), i will add it to my toolbox.

 

Thx

S.

[torstenanders]

I aim to have this and related code released via Github with dependencies resolved and brief installation instructions.  In the meantime, below is the missing definition.

 

Torsten

 

(defun plist->pairs (plist)
  (loop :for (key val) :on plist :by #'cddr
    :collect (list key val)))