merge-rests-with-preceeding-note

[torstenanders]

Sometimes you want to remove rests in an OMN expression without changing the actual rhythm, but instead lengthening the notes followed by a rest. The following function does that.

(merge-rests-with-preceeding-note '(e g6 f stacc -e e ab5 mp ten e c4 mf ten))
=> (1/4 g6 f stacc e ab5 mp ten e c4 mf ten)

 

The definition is below.

 

Best,

Torsten

 

(defun merge-rests-with-preceeding-note (sequence)
  "Remove all rests in sequence without changing the actual rhythm: extends the length of each note followed by that rest value, so that the overall duration remains as before.

  Args:
  - sequence: OMN expression, can be nested.

  Examples:
  ;;; (merge-rests-with-preceeding-note '(e g6 f stacc -e e ab5 mp ten e c4 mf ten))
  ;;; => (1/4 g6 f stacc e ab5 mp ten e c4 mf ten)"
  (do-verbose ("")
    (let* ((nested? (every #'listp sequence))
           (events (single-events (omn-merge-rests (if nested? 
                                                     (flatten sequence)
                                                     sequence))))
           (result 
            (append 
             (tu:mappend ;; mappend consecutive pairs
              #'(lambda (n1 n2)
                  (cond ((length-restp (first n1)) 
                         nil)
                        ((length-restp (first n2)) 
                         ;; add dur of n2 to n1
                         (cons (+ (omn-encode (first n1)) (abs (omn-encode (first n2))))
                               (rest n1)))
                        (T n1)))
              (butlast events)
              (last events (1- (length events))))
             (let ((last-event (first (last events))))
               (if (length-restp (first last-event))
                 nil
                 last-event)))))
      (if nested?
        (copy-time-signature sequence result)
        result))))

 

[Stephane Boussuge]

FILTER-TIE do the same, no ?

 

 

[torstenanders]

Thanks, but no, filter-tie does not change those rests, nor does it lengthen the notes preceding a rest. 

(merge-rests-with-preceeding-note '(e g6 f stacc -e e ab5 mp ten e c4 mf ten))
;; the rest is gone, and the first note is longer so that the start time of the next note is unchanged
=> (1/4 g6 f stacc e ab5 mp ten e c4 mf ten)

(filter-tie '(e g6 f stacc -e e ab5 mp ten e c4 mf ten))
=> (e g6 f stacc - ab5 mp ten c4 mf ten)

 

Best,

Torsten

[Stephane Boussuge]

Sorry, it is LENGTH-LEGATO function.

 

S.

[torstenanders]

Ah, thanks -- indeed length-legato does the same. So, I will simply remove my new but redundant function again

 

BTW, this function could be useful also for implementing Beethoven-like motif condensation, where (less important) notes are removed from a motif. Here is a simple example motif.

 

(setf my-motif '((q. c4 e d4 q. e4 e f4) (h g4 -h)))

 

Lets turn all the eighths notes in this motif into rests, and then extend the notes preceding the rests by the duration of the rests. The eighths notes occur at every 2nd position, and I am using a variant of length-rest-series to turn them into rests. While length-rest-series returns a list of lengths, this variant returns an OMN expression that retains all parameters. 

(setf my-motif2 (length-rest-series-omn '(2 2) my-motif))
=> ((q. c4 -e q. d4 -e) (h e4 -)) 

(length-legato my-motif2)
=> ((h c4 d4) (w e4))

 

Of course, the tricky bit here is to determine which notes to "remove", i.e. which notes are less important. Above, these notes are selected by hand in the argument to length-rest-series-omn. An alternative approach would be to select these notes with a test. In the example below, all notes that are shorter than a quarter note are automatically removed and turned into rests. 

(length-legato
 (filter-notes-if #'(lambda (dur pitch &rest other-args)  
                      (> (omn-encode dur) 1/4)) 
                  my-motif))
=> ((h c4 e4) (w g4))

 

filter-notes-if is defined at 

 

For completeness, below is the definition of length-rest-series-omn. It is defined with a (revision of) edit-omn that I reported before at 

 

 

Best,

Torsten

 

(defun length-rest-series-omn (rest-distances sequence)
  "Same as length-rest-series, but works on OMN expressions retaining all parameters. See doc of length-rest-series for more details."
  (edit-omn :length sequence 
            #'(lambda (ls) (length-rest-series rest-distances ls))))


(defun edit-omn (type notation fun &key (flat T))
  "Use function `fun', defined for transforming individual OMN parameters of `type' (e.g., :length, or :velocity) to transform omn expression `notation'. This function is intended as a convenient way to generalise functions your functions to support omn notation as input.

  Args:
  - type: a keyword like :length, :pitch, :velocity, :duration, or :articulation (any keyword supported by function omn or make-omn).
  - fun: a function expecting a parameter sequence of given type. It is sufficient to support only a flat input list, support for nested lists is added implicitly.
  - notation: a omn sequence or a plain parameter list (can be nested).
  - flat (default T): whether or not `fun' expects a flat input list.

  Example: roll your own transposition supporting omn input
  first aux def supporting only pitches
  ;;; (defun my-transposition-aux (interval pitches)
  ;;;   (midi-to-pitch (loop for p in (pitch-to-midi pitches)
  ;;;                        collect (+ p interval))))
  
  test
  ;;; (my-transposition-aux 7 '(c4 e4 g4)) 
  ;;;  => (g4 b4 d5)

  variant supporting also omn expressions
  ;;; (defun my-transposition (interval omn)
  ;;;   (edit-omn :pitch omn
  ;;;             #'(lambda (ps) (my-transposition-aux interval ps))))

  test with nested OMN including a rest
  ;;; (my-transposition 7 '((q c4 mp -q q e4 q f4) (h g4 tr2)))
  ;;;  => ((q g4 mp - b4 c5) (h d5 mp tr2))

  More information at {https://opusmodus.com/forums/topic/799-user-functions-supporting-arbitrary-omn-input-–-defining-them-more-easily/}."
  (if (omn-formp notation)
    (copy-time-signature 
     notation
     (let ((params (omn nil notation))
           (type-is-length? (equal type :length)))
       (apply #'make-omn 
              (append  
               (list type 
                     (funcall fun (if flat
                                    (flatten (getf params type))
                                    (getf params type))))
               (remove-properties (if type-is-length?
                                       '(:length :duration)
                                       type)
                                     params)
               ))))
    ;; notation is plain parameter list
    (span notation 
          (funcall fun (if flat
                         (flatten notation)
                         notation)))))

(defun copy-time-signature (music-with-time-signature music-to-rebar)
  "Rebars `music-to-rebar' so that it fits the meter of `music-with-time-signature'."
  ;; only rebar if music-with-time-signature is nested 
  (if (every #'listp music-with-time-signature)
    (omn-to-time-signature music-to-rebar
                           (get-time-signature music-with-time-signature))
    music-to-rebar))


(defun remove-properties (properties property-list)
  "Removes all properties and their values out of a property list"
  (reduce #'(lambda (list val)
	      (remove-property val list))
	  properties :initial-value property-list))
      

 

[Stephane Boussuge]

Hi Torsten,

 

very good and very interesting !!

thank you for sharing this, i enjoy it greatly !

 

All the best

 

S.

[lviklund]

Agree with SB.

Thank you, interesting and useful stuff.

 

Thx

Torsten