Jump to content

merge-voices on bar/beat


Recommended Posts

(defun merge-voices** (seq &key insert bar/beat)
   (car 
    (last
     (let ((bar) (beat) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           
          do (setf time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (car i) (cadr i))))
                                 (/ (1- (car be)) (cadr be)))
                              (+ (* (1- ba) (/ (car time-sign) (cadr time-sign)))
                                 (/ (1- (car be)) (cadr be)))))

           do (setf ins (append (list (neg! distance)) ins))
           do (setf seq (omn-to-time-signature 
                         (length-rest-merge 
                          (flatten (merge-voices (omn-merge-ties seq) ins)))
                          ord-time-sign))
           collect seq
           do (setf time-sign ord-time-sign)))))))

(merge-voices** '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
                :insert '((q a4 a4 a4))
                :bar/beat '((2 (2 8))))

(merge-voices** '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
                :insert '((q b5 b5 b5)
                          (e a4 a4 a4))
                :bar/beat '((2 (2 8))
                            (3 (2 16))))

 

Link to comment
Share on other sites

  • 1 month later...

Thanks for sharing, this is a useful function. 

 

However, I must say it took me some time to realise that this function is useful, because you did not provide any documentation. If I may say so, I would recommend you always document your functions, not only in the interest of potential other users, but in your own interest. Many years ago I developed a library over several months (a higher-level score language for the physical modelling synthesiser Tao, http://taopm.sourceforge.net) that helped me composing some piece. Some time later I wanted to use this library again, and was unable to do so, because of its lacking documentation -- I did not know how to use my own code anymore, and several months of work were effectively lost. Since then I am rather careful documenting my own work :)

 

Because I like your function, I documented it myself for my own purposes (see doc string in the code block below). Please let me know if my documentation contains any misunderstandings. Also, please share if you are aware of any bugs.

 

I am using this somewhat strange formatting of the doc string, because the library cldoc (https://gitlab.common-lisp.net/cldoc/cldoc/) can create some rather nice HTML doc files with this format. I tried a bunch of other doc generators, but cldoc worked best for me. In case you are interested in doc generators for your own work, cldoc's main downside is that internal and exported symbols are not distinguished (but also nested functions, e.g., global functions within flet are skipped). If you are looking for a doc generator, a useful overview is provided by https://sites.google.com/site/sabraonthehill/lisp-document-generation-apps.

 

I also slightly changed your function for my purposes. I changed the name to merge-voices2, because that is slightly shorter. Perhaps more importantly, I changed your keyword arguments to plain arguments, because in my code I retain keyword arguments for named optional arguments, but the arguments of this function are not optional (there is no default value).

 

 Sincere apologies if I am sounding patronising. I just wanted to make this function more useful for myself, and perhaps also for others. 

 

Best,

Torsten

 

(defun merge-voices2 (seq insert bar/beat)
  "Merges multiple monophonic lines resulting in a polyphonic part. 

  Args:
  - seq (OMN sequence, must be nested): Voice to which other voices are added. The result retains the time signatures of SEQ. 
  - insert (list of flat OMN sequences): Voices to merge into SEQ. Their time signatures are overwritten by the meter of SEQ.
  - bar/beat (list): List of start times of inserted sequences. 

  Each INSERT start time is specified in the following format, where <bar-number> is a 1-based bar number (an int), <beat-number> is a 1-based beat number (an int), and <beat-subdivision> is the divisor for the beat number (also an int). 

;;; (<bar-number> (<beat-number> <beat-subdivision>))
  
  For example, (3 (2 4)) indicates the 2nd quarter note in the 3rd bar.  

  Examples:

  Merge two OMN sequences.
  
;;; (merge-voices2 '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
;;;                 '((q a4 a4 a4))
;;;                 '((2 (2 8))))  

  Merge three sequences.
  
;;; (merge-voices2 '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
;;;                '((q b5 b5 b5)
;;;                  (e a4 a4 a4))
;;;                '((2 (2 8))
;;;                  (3 (2 16))))

  See also: 
  The built-in function MERGE-VOICES is similar, but does not support shifting/offsetting added voices in time. 
  "
   (car 
    (last
     (let ((bar) (beat) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           
          do (setf time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (car i) (cadr i))))
                                 (/ (1- (car be)) (cadr be)))
                              (+ (* (1- ba) (/ (car time-sign) (cadr time-sign)))
                                 (/ (1- (car be)) (cadr be)))))

           do (setf ins (append (list (neg! distance)) ins))
           do (setf seq (omn-to-time-signature 
                         (length-rest-merge 
                          (flatten (merge-voices (omn-merge-ties seq) ins)))
                          ord-time-sign))
           collect seq
           do (setf time-sign ord-time-sign)))))))

 

 

Link to comment
Share on other sites

BTW: I am taking back my comments regarding keyword arguments. Keyword arguments allow for changing the order of arguments, and therefore there can be good reasons for using keyword arguments even without default values. For example, you might assemble the argument list of your function from different places, as I happen to do in map-parts, see below.

 

Best, Torsten

 

 

Link to comment
Share on other sites

"I changed your keyword arguments to plain arguments, because in my code I retain keyword arguments for named optional arguments, but the arguments of this function are not optional (there is no default value)."

 

sometimes i'm using keyword arguments for "better understandig"/legibility/overview of the function. but i see it's not "state of the art", thanks for the hint! :-)

Link to comment
Share on other sites

using keyword arguments for "better understandig"/legibility/overview of the function

 

That makes perfectly sense -- we tend to spend more time reading code than writing it. 

 

However, don't forget that Lisp development environments can also provide you information like the name of function arguments. If you complete a function name then its arguments are automatically shown in the status line between the editor (composer) and the lister. You can also later show the argument list by placing the cursor at the end of the function name and typing a space, or by having your cursor anywhere in your function call and typing C-x C-a (ctrl-x and then ctrl-a). For remembering that think, e.g., "eXecute Argument list".

 

Finally, when you have your cursor in your function call and you type M-. (alt-. -- M stands for the Emacs Meta key) then you can see the function definition. This last trick only works when you did not already open the file with that definition somewhere in Opusmodus, and of course if you have that definition in your installation. 

 

Best,

Torsten 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy