torstenanders

As you likely already know, what you can do in a single voice/part is specifying various articulations, which can result in different timbres of your playback, including user-defined specifications with the function def-sound-set. Beyond that, you could split your part into multiple parts, in the score, where each is performed by its own MIDI channel (basically reproducing how a Klangfarbenmelodie would be realised in an orchestra setting). The advantage of expressing different timbres of different instruments with multiple parts is that it allows for dove-tailing, where the last note of one instrument and the first note of the next are shared by both for a better connecting. 
 
Anyway, if you want to generate only a single part with timbre specifications, why not defining a function that allows to split it into multiple parts for the orchestra later. I proposed such a function for your convenience at 
 
 
Best,
Torsten
 

Great, thanks! Would you consider adding a documentation file for that function? If not, could you at least add a doc string to the code, so that it could be of use for at least more advanced users?
 
For everyone else: when you are searching for a function that is not documented by its own RTF file and thus cannot be found via the standard Opusmodus documentation search, you could use the following function. Some internal Opusmodus functions without standard Opusmodus documentation have at least a documentation string. 
 
;; return all functions that contain 'omn' in their name, together with their documentation string (if there is any).
(apropos-function-documentation "omn")
 
The function apropos-function-documentation is defined below.
 
Best,
Torsten
 
(defun apropos-function-documentation (my-string &optional (package *package*)) "Lists all functions that contain `my-string' alongside their documentation in a list of pairs (<function-symbol> <doc-string>)" (mapcar #'(lambda (x) (list x (documentation x 'function))) (remove-if-not #'fboundp (apropos-list my-string package))))  

For generating a harmonic rhythm, I needed to merge notes that are tied. If extracting only the length values with omn directly, then all ties are lost.
 
 (omn :length '((h c4 pizz q arco+tie) (q h tie) (h.)))
 => ((1/2 1/4) (1/4 1/2) (3/4))
 
So, I wrote myself a function that merges the lengths of tied notes.
 
 (lengths-with-merged-ties '((h c4 pizz q arco+tie) (q h tie) (h.)))
 => (1/2 1/2 5/4)
 
 
The definition is below.
 
Best,
Torsten
 
(defun lengths-with-merged-ties (sequence) "Returns a flat list of lengths that preserves the lengths in sequence including their tied notes. Example: (lengths-with-merged-ties '((h c4 pizz q arco+tie) (q h tie) (h.))) => (1/2 1/2 5/4) Contrast: (omn :length '((h c4 pizz q arco+tie) (q h tie) (h.))) => ((1/2 1/4) (1/4 1/2) (3/4))" (butlast (reduce #'(lambda (&optional accum pair2) (when (and accum pair2) (append (butlast accum 2) (if (equal (first (last accum)) 'tie) (list (+ (first (last (butlast accum))) (first pair2)) (second pair2)) (list (first (last (butlast accum))) (first pair2) (second pair2))) ))) (matrix-transpose (list (omn :length (flatten-omn sequence)) (mapcar #'(lambda (arts) (when (member 'tie arts) 'tie)) (mapcar #'disassemble-articulations (omn :articulation (flatten-omn sequence))))))))) ;; I shared the function disassemble-articulations alongside similar functions before, ;; but repeat it here for your convenience (defun disassemble-articulations (art) "Splits a combined OMN articulations into a list of its individual attributes. Example: (disassemble-articulations 'leg+ponte) => (leg ponte)" (mapcar #'intern (split-string (symbol-name art) :separator "+")))  

(apply #'mapcar #'list '((1 3 5) (2 4 6)))  

Here is another approach to implement the same thing, but a but more concisely in just one line (most of the code below is the documentation :)
(defun mat-trans (lists)   "Matrix transformation.    (mat-trans '((a1 a2 a3) (b1 b2 b3) (c1 c2 c3) ...))    => ((a1 b1 c1 ...) (a2 b2 c2 ...) (a3 b3 c3 ...))"   (apply #'mapcar #'(lambda (&rest all) all) lists))  

As Stephane also pointed out earlier, if you want to create a number of randomised solutions, but then later want to fix the result to one solution/seed of your choice, one way to do that is to always print the current seed, and in the end to simply replace your randomly generated seed with a seed of your choice. 
(progn  (setf seed (random 1000))   (print seed) ;; replace seed below ultimately with seed generating a result you like (init-seed seed)) Best,
Torsten

Nice idea! I reduced your code a bit by using case instead of nested if statements, and in particular higher-order programming. This should do this same.
 
Moreover, you can now do things you could not do before like comparing with >=.
 
(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)
=> ((q c4eb4 mf q d4fs4 mf q e4g4 mf q f4a4 mf e g4 mf e a4 mf) (e f4 mf e e4 mf q d4f4 mf q c4e4 mf q a4c5 mf q g4b4 mf h f4gs4 mf))
 
Best,
Torsten
 
;;; ============================================== ;;; UTILITY FUNCTIONS ;;; (defun add-interval-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3))) (let ((s-events (single-events omn))) (loop for e in s-events for i in (gen-trim (length s-events) interval-list) when (funcall test (omn-encode (first e)) length-val) append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e) else append e))) ;(add-interval-if-length-aux '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11)) ;;; ============================= ;;; MAIN FUNCTION (defun add-interval-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3))) (do-verbose ("add-interval-if-length") (let ((test-fn (case test (> #'>) (< #'<) (= #'=) (otherwise test)))) (if (listp (car omn)) (mapcar #'(lambda (x) (add-interval-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)) omn) (add-interval-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list))))) ;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11)) ;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)  

Nice idea! I reduced your code a bit by using case instead of nested if statements, and in particular higher-order programming. This should do this same.
 
Moreover, you can now do things you could not do before like comparing with >=.
 
(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)
=> ((q c4eb4 mf q d4fs4 mf q e4g4 mf q f4a4 mf e g4 mf e a4 mf) (e f4 mf e e4 mf q d4f4 mf q c4e4 mf q a4c5 mf q g4b4 mf h f4gs4 mf))
 
Best,
Torsten
 
;;; ============================================== ;;; UTILITY FUNCTIONS ;;; (defun add-interval-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3))) (let ((s-events (single-events omn))) (loop for e in s-events for i in (gen-trim (length s-events) interval-list) when (funcall test (omn-encode (first e)) length-val) append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e) else append e))) ;(add-interval-if-length-aux '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11)) ;;; ============================= ;;; MAIN FUNCTION (defun add-interval-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3))) (do-verbose ("add-interval-if-length") (let ((test-fn (case test (> #'>) (< #'<) (= #'=) (otherwise test)))) (if (listp (car omn)) (mapcar #'(lambda (x) (add-interval-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)) omn) (add-interval-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list))))) ;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11)) ;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)  

I guess you want to replace the length values in your OMN expression pianomain with the result of (mapcar #'anyfunction some-other-length-values).  
 
You are relatively close already, but it seems there are some misconceptions in your existing function, therefore I am addressing that first. If you test your function with actual OMN expressions then you will realise that it may not quite work as you expect. 
 
(defun my-omn (omn &optional (no 0)) 
  (nth no (disassemble-omn omn)))

(my-omn '(q c4 e d4 e4 h f4 q g4))
=> :length
 
Probably you did not want to access the keyword :length, but instead the actual length values. You can do that by changing your function into the following. Alternatively, you could also simply use the built-in function omn.
 
(defun my-omn (xs &optional (type :length)) 
  (getf (disassemble-omn xs) type))

(my-omn '(q c4 e d4 e4 h f4 q g4))
=> (1/4 1/8 1/8 1/2 1/4)
 
;; built-in function omn
(omn :length '(q c4 e d4 e4 h f4 q g4))
=> (1/4 1/8 1/8 1/2 1/4)
 
Now you can process your length values with your function anyfunction, and then put the result back into your original list. Happy to show you how to do that, and how to roll all that into a single function, once you showed your definition of anyfunction :)
 
Best,
Torsten

Below is a link another way to write functions that process OMN more easily by defining only a function processing the parameter you are interested in, and then turning that quasi-automatically into a function that supports arbitrary OMN expressions (including nested expressions, preserving the nesting, and rests).  
 
Best,
Torsten

It is highly useful to have functions that support the full OMN language, because they allow us transform rich music snippets with all parameters. On the other hand, it is easier to define functions for individual parameters. So, why not having a function that automatically adds OMN support (including nested lists) for a function transforming only a single parameter.
 
Here is an example. Lets assume you want to roll your custom pitch transposition function. I choose this example, because everyone hopefully understands that very easily, and can then use this overall approach for their user functions. This demonstration function expects a list of pitch symbols and a numeric transposition interval -- it returns the transposed pitches.  Here is the definition of this auxiliary function and a test.
(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) Now, lets generalise this function to support arbitrary OMN input, including nested lists. Some background info for less experienced Lisp programmers: we need to give the new function edit-omn (defined below) as an argument another computer program -- another function. This function does not even have its own name, because it is not a big deal -- it is therefore a lambda expression (an anonymous function, for more on this see http://www.gigamonkeys.com/book/functions.html).
(defun my-transposition (interval omn) (edit-omn :pitch omn #'(lambda (ps) (my-transposition-aux interval ps)))) ; my-transposition now "magically" supports arbitrary OMN expressions including nested lists and rests (my-transposition 7 '((q c4 mp -q q e4 q f4) (h g4 tr2))) ; => ((q g4 mp - b4 c5) (h d5 mp tr2)) Below this message is the definition of edit-omn. As you can see, it is not a big deal either (the doc string is much longer than the definition), but hopefully useful.
 
Best,
Torsten
(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 (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)) " (let ((params (omn nil notation))) (apply #'make-omn (append (list type (span notation (funcall fun (if flat (flatten (getf params type)) (getf params type))))) (remove-property type params))))) ;; Auxiliary definition (defun remove-property (property property-list) "Removes a property and its value out of a property list" (let ((pos (position property property-list))) (if pos (append (subseq property-list 0 pos) (subseq property-list (+ pos 2))) property-list))) ; (remove-property :test '(:a 1 :test 2 :x 3)) ; => (:A 1 :X 3)  
 

Below is a link another way to write functions that process OMN more easily by defining only a function processing the parameter you are interested in, and then turning that quasi-automatically into a function that supports arbitrary OMN expressions (including nested expressions, preserving the nesting, and rests).  
 
Best,
Torsten

Thanks. For completeness, below is a link to another rnd-pick variant with probability support. 
 
Best,
Torsten
 

I want to manually revise some score, but I would get lost in a very long list of OMN data. So, I automatically added bar number comments to the pretty printout -- helps me a lot :)
 
(pprint-part '((s g1 ff gs1 p a1 ff b1) (s c2 mf cs2 ff d2 e2 mf) (e f2 p s fs2 ff g2 p a2) (s b2 mf e c3 s cs3 ff eb3) (s e3 mf f3 ff fs3 p a3 mf) (s bb3 ff b3 e c4 p s e4) (e e4 ff s f4 e s b4 p) (e b4 s s mf e fs5 ff) (s fs5 mf f5 p mf e cs6) (s cs6 c6 p e b5 mf s g6 ff) (s g6 p ff e f6 g6 mf) (s g6 g6 p ff e fs6) (s g6 mf p e s fs6) (s fs6 fs6 ff mf ff) (e fs6 p s ff fs6 fs6 mf) (s fs6 fs6 ff p f6) (s fs6 ff mf e e f6) (s f6 e fs6 fs6 p s f6) (s f6 mf fs6 fs6 p f6) (e f6 f6 ff s fs6 p f6 ff) (s f6 p e s s) (s f6 e mf p s ff) (s f6 mf p mf e ff) (s f6 p e s mf p) (s f6 ff e mf s e p) (e f6 s e ff mf) (s f6 p mf e6 ff f6 p) (s f6 ff e6 mf e eb6 p f6 mf) (s f6 e6 d6 f6) (s f6 e6 ff d6 e f6 p) (s f6 mf e6 ff cs6 f6 mf) (s f6 ff f6 cs6 mf f6 ff) (e f6 mf s s cs6 p fs6 mf) (s f6 ff e e6 p s bb5 mf f6) (s e6 p b5 f5 eb6) (s bb5 fs5 ff e cs5 p s a5 mf) (e e5 ff s c5 e gs4 mf s d5) (e bb4 s fs4 d4 e g4) (s e4 ff d4 b3 mf e eb4) (s cs4 p bb3 mf e gs3 p s c4 ff) (s a3 a3 mf e b3 ff gs3) (s bb3 c4 d4 e b3 mf) (s cs4 p eb4 mf e f4 p s eb4 ff) (s e4 fs4 gs4 p fs4 ff) (e g4 p s a4 mf bb4 a4) (s bb4 c5 cs5 p c5 mf) (s cs5 eb5 ff e e5 mf eb5 ff) (s e5 mf e fs5 g5 p s fs5 ff) (s g5 mf gs5 a5 p a5) (e bb5 ff b5 mf s c6 ff c6))) => ? ( ;; Bar 1 (s g1 ff gs1 p a1 ff b1) ;; Bar 2 (s c2 mf cs2 ff d2 e2 mf) ;; Bar 3 (e f2 p s fs2 ff g2 p a2) ;; Bar 4 (s b2 mf e c3 s cs3 ff eb3) ;; Bar 5 (s e3 mf f3 ff fs3 p a3 mf) ;; Bar 6 (s bb3 ff b3 e c4 p s e4) ;; Bar 7 (e e4 ff s f4 e s b4 p) ;; Bar 8 (e b4 s s mf e fs5 ff) ;; Bar 9 (s fs5 mf f5 p mf e cs6) ;; Bar 10 (s cs6 c6 p e b5 mf s g6 ff) ;; Bar 11 (s g6 p ff e f6 g6 mf) ;; Bar 12 (s g6 g6 p ff e fs6) ;; Bar 13 (s g6 mf p e s fs6) ;; Bar 14 (s fs6 fs6 ff mf ff) ;; Bar 15 (e fs6 p s ff fs6 fs6 mf) ;; Bar 16 (s fs6 fs6 ff p f6) ;; Bar 17 (s fs6 ff mf e e f6) ;; Bar 18 (s f6 e fs6 fs6 p s f6) ;; Bar 19 (s f6 mf fs6 fs6 p f6) ;; Bar 20 (e f6 f6 ff s fs6 p f6 ff) ;; Bar 21 (s f6 p e s s) ;; Bar 22 (s f6 e mf p s ff) ;; Bar 23 (s f6 mf p mf e ff) ;; Bar 24 (s f6 p e s mf p) ;; Bar 25 (s f6 ff e mf s e p) ;; Bar 26 (e f6 s e ff mf) ;; Bar 27 (s f6 p mf e6 ff f6 p) ;; Bar 28 (s f6 ff e6 mf e eb6 p f6 mf) ;; Bar 29 (s f6 e6 d6 f6) ;; Bar 30 (s f6 e6 ff d6 e f6 p) ;; Bar 31 (s f6 mf e6 ff cs6 f6 mf) ;; Bar 32 (s f6 ff f6 cs6 mf f6 ff) ;; Bar 33 (e f6 mf s s cs6 p fs6 mf) ;; Bar 34 (s f6 ff e e6 p s bb5 mf f6) ;; Bar 35 (s e6 p b5 f5 eb6) ;; Bar 36 (s bb5 fs5 ff e cs5 p s a5 mf) ;; Bar 37 (e e5 ff s c5 e gs4 mf s d5) ;; Bar 38 (e bb4 s fs4 d4 e g4) ;; Bar 39 (s e4 ff d4 b3 mf e eb4) ;; Bar 40 (s cs4 p bb3 mf e gs3 p s c4 ff) ;; Bar 41 (s a3 a3 mf e b3 ff gs3) ;; Bar 42 (s bb3 c4 d4 e b3 mf) ;; Bar 43 (s cs4 p eb4 mf e f4 p s eb4 ff) ;; Bar 44 (s e4 fs4 gs4 p fs4 ff) ;; Bar 45 (e g4 p s a4 mf bb4 a4) ;; Bar 46 (s bb4 c5 cs5 p c5 mf) ;; Bar 47 (s cs5 eb5 ff e e5 mf eb5 ff) ;; Bar 48 (s e5 mf e fs5 g5 p s fs5 ff) ;; Bar 49 (s g5 mf gs5 a5 p a5) ;; Bar 50 (e bb5 ff b5 mf s c6 ff c6) )  
I revise only a single part at a time, as I will also re-bar the music. If I later want to update bar number comments, I can just call pprint-part on the result again. BTW: get-time-signature is useful to extract the time signatures for def-score from the part data.
 
The function pprint-part is defined below.
 
Best,
Torsten
 
;; based on https://groups.google.com/forum/#!topic/comp.lang.lisp/_NP7Ub6hLsE (setf *print-pretty* t *print-miser-width* 0 *print-right-margin* 80) (defun pprint-part (part &optional (stream *standard-output*)) "Pretty prints a part one bar a time, adding a bar line comment before each bar. Args: part: nested OMN list. Example: (pprint-part '((q c4 d4 e4) (h f4 q e4) (h. d2)))" (pprint-logical-block (stream nil :prefix "(" :suffix ")") (pprint-logical-block (stream part) (loop for bar-no from 1 to (length part) for bar in part do (progn (pprint-indent :block 1 stream) (pprint-newline :mandatory stream) (format stream ";; Bar ~A" bar-no) (pprint-newline :mandatory stream) (prin1 bar stream)))) (pprint-indent :block -1 stream) (pprint-newline :mandatory stream)))  

I want to manually revise some score, but I would get lost in a very long list of OMN data. So, I automatically added bar number comments to the pretty printout -- helps me a lot :)
 
(pprint-part '((s g1 ff gs1 p a1 ff b1) (s c2 mf cs2 ff d2 e2 mf) (e f2 p s fs2 ff g2 p a2) (s b2 mf e c3 s cs3 ff eb3) (s e3 mf f3 ff fs3 p a3 mf) (s bb3 ff b3 e c4 p s e4) (e e4 ff s f4 e s b4 p) (e b4 s s mf e fs5 ff) (s fs5 mf f5 p mf e cs6) (s cs6 c6 p e b5 mf s g6 ff) (s g6 p ff e f6 g6 mf) (s g6 g6 p ff e fs6) (s g6 mf p e s fs6) (s fs6 fs6 ff mf ff) (e fs6 p s ff fs6 fs6 mf) (s fs6 fs6 ff p f6) (s fs6 ff mf e e f6) (s f6 e fs6 fs6 p s f6) (s f6 mf fs6 fs6 p f6) (e f6 f6 ff s fs6 p f6 ff) (s f6 p e s s) (s f6 e mf p s ff) (s f6 mf p mf e ff) (s f6 p e s mf p) (s f6 ff e mf s e p) (e f6 s e ff mf) (s f6 p mf e6 ff f6 p) (s f6 ff e6 mf e eb6 p f6 mf) (s f6 e6 d6 f6) (s f6 e6 ff d6 e f6 p) (s f6 mf e6 ff cs6 f6 mf) (s f6 ff f6 cs6 mf f6 ff) (e f6 mf s s cs6 p fs6 mf) (s f6 ff e e6 p s bb5 mf f6) (s e6 p b5 f5 eb6) (s bb5 fs5 ff e cs5 p s a5 mf) (e e5 ff s c5 e gs4 mf s d5) (e bb4 s fs4 d4 e g4) (s e4 ff d4 b3 mf e eb4) (s cs4 p bb3 mf e gs3 p s c4 ff) (s a3 a3 mf e b3 ff gs3) (s bb3 c4 d4 e b3 mf) (s cs4 p eb4 mf e f4 p s eb4 ff) (s e4 fs4 gs4 p fs4 ff) (e g4 p s a4 mf bb4 a4) (s bb4 c5 cs5 p c5 mf) (s cs5 eb5 ff e e5 mf eb5 ff) (s e5 mf e fs5 g5 p s fs5 ff) (s g5 mf gs5 a5 p a5) (e bb5 ff b5 mf s c6 ff c6))) => ? ( ;; Bar 1 (s g1 ff gs1 p a1 ff b1) ;; Bar 2 (s c2 mf cs2 ff d2 e2 mf) ;; Bar 3 (e f2 p s fs2 ff g2 p a2) ;; Bar 4 (s b2 mf e c3 s cs3 ff eb3) ;; Bar 5 (s e3 mf f3 ff fs3 p a3 mf) ;; Bar 6 (s bb3 ff b3 e c4 p s e4) ;; Bar 7 (e e4 ff s f4 e s b4 p) ;; Bar 8 (e b4 s s mf e fs5 ff) ;; Bar 9 (s fs5 mf f5 p mf e cs6) ;; Bar 10 (s cs6 c6 p e b5 mf s g6 ff) ;; Bar 11 (s g6 p ff e f6 g6 mf) ;; Bar 12 (s g6 g6 p ff e fs6) ;; Bar 13 (s g6 mf p e s fs6) ;; Bar 14 (s fs6 fs6 ff mf ff) ;; Bar 15 (e fs6 p s ff fs6 fs6 mf) ;; Bar 16 (s fs6 fs6 ff p f6) ;; Bar 17 (s fs6 ff mf e e f6) ;; Bar 18 (s f6 e fs6 fs6 p s f6) ;; Bar 19 (s f6 mf fs6 fs6 p f6) ;; Bar 20 (e f6 f6 ff s fs6 p f6 ff) ;; Bar 21 (s f6 p e s s) ;; Bar 22 (s f6 e mf p s ff) ;; Bar 23 (s f6 mf p mf e ff) ;; Bar 24 (s f6 p e s mf p) ;; Bar 25 (s f6 ff e mf s e p) ;; Bar 26 (e f6 s e ff mf) ;; Bar 27 (s f6 p mf e6 ff f6 p) ;; Bar 28 (s f6 ff e6 mf e eb6 p f6 mf) ;; Bar 29 (s f6 e6 d6 f6) ;; Bar 30 (s f6 e6 ff d6 e f6 p) ;; Bar 31 (s f6 mf e6 ff cs6 f6 mf) ;; Bar 32 (s f6 ff f6 cs6 mf f6 ff) ;; Bar 33 (e f6 mf s s cs6 p fs6 mf) ;; Bar 34 (s f6 ff e e6 p s bb5 mf f6) ;; Bar 35 (s e6 p b5 f5 eb6) ;; Bar 36 (s bb5 fs5 ff e cs5 p s a5 mf) ;; Bar 37 (e e5 ff s c5 e gs4 mf s d5) ;; Bar 38 (e bb4 s fs4 d4 e g4) ;; Bar 39 (s e4 ff d4 b3 mf e eb4) ;; Bar 40 (s cs4 p bb3 mf e gs3 p s c4 ff) ;; Bar 41 (s a3 a3 mf e b3 ff gs3) ;; Bar 42 (s bb3 c4 d4 e b3 mf) ;; Bar 43 (s cs4 p eb4 mf e f4 p s eb4 ff) ;; Bar 44 (s e4 fs4 gs4 p fs4 ff) ;; Bar 45 (e g4 p s a4 mf bb4 a4) ;; Bar 46 (s bb4 c5 cs5 p c5 mf) ;; Bar 47 (s cs5 eb5 ff e e5 mf eb5 ff) ;; Bar 48 (s e5 mf e fs5 g5 p s fs5 ff) ;; Bar 49 (s g5 mf gs5 a5 p a5) ;; Bar 50 (e bb5 ff b5 mf s c6 ff c6) )  
I revise only a single part at a time, as I will also re-bar the music. If I later want to update bar number comments, I can just call pprint-part on the result again. BTW: get-time-signature is useful to extract the time signatures for def-score from the part data.
 
The function pprint-part is defined below.
 
Best,
Torsten
 
;; based on https://groups.google.com/forum/#!topic/comp.lang.lisp/_NP7Ub6hLsE (setf *print-pretty* t *print-miser-width* 0 *print-right-margin* 80) (defun pprint-part (part &optional (stream *standard-output*)) "Pretty prints a part one bar a time, adding a bar line comment before each bar. Args: part: nested OMN list. Example: (pprint-part '((q c4 d4 e4) (h f4 q e4) (h. d2)))" (pprint-logical-block (stream nil :prefix "(" :suffix ")") (pprint-logical-block (stream part) (loop for bar-no from 1 to (length part) for bar in part do (progn (pprint-indent :block 1 stream) (pprint-newline :mandatory stream) (format stream ";; Bar ~A" bar-no) (pprint-newline :mandatory stream) (prin1 bar stream)))) (pprint-indent :block -1 stream) (pprint-newline :mandatory stream)))  

I have used omn-replaced like this:
(omn-replace :pitch '((g4) (a4)) '((q f pizz) (h arco))) => ((q g4 f pizz) (h a4 arco))  

I want to manually revise some score, but I would get lost in a very long list of OMN data. So, I automatically added bar number comments to the pretty printout -- helps me a lot :)
 
(pprint-part '((s g1 ff gs1 p a1 ff b1) (s c2 mf cs2 ff d2 e2 mf) (e f2 p s fs2 ff g2 p a2) (s b2 mf e c3 s cs3 ff eb3) (s e3 mf f3 ff fs3 p a3 mf) (s bb3 ff b3 e c4 p s e4) (e e4 ff s f4 e s b4 p) (e b4 s s mf e fs5 ff) (s fs5 mf f5 p mf e cs6) (s cs6 c6 p e b5 mf s g6 ff) (s g6 p ff e f6 g6 mf) (s g6 g6 p ff e fs6) (s g6 mf p e s fs6) (s fs6 fs6 ff mf ff) (e fs6 p s ff fs6 fs6 mf) (s fs6 fs6 ff p f6) (s fs6 ff mf e e f6) (s f6 e fs6 fs6 p s f6) (s f6 mf fs6 fs6 p f6) (e f6 f6 ff s fs6 p f6 ff) (s f6 p e s s) (s f6 e mf p s ff) (s f6 mf p mf e ff) (s f6 p e s mf p) (s f6 ff e mf s e p) (e f6 s e ff mf) (s f6 p mf e6 ff f6 p) (s f6 ff e6 mf e eb6 p f6 mf) (s f6 e6 d6 f6) (s f6 e6 ff d6 e f6 p) (s f6 mf e6 ff cs6 f6 mf) (s f6 ff f6 cs6 mf f6 ff) (e f6 mf s s cs6 p fs6 mf) (s f6 ff e e6 p s bb5 mf f6) (s e6 p b5 f5 eb6) (s bb5 fs5 ff e cs5 p s a5 mf) (e e5 ff s c5 e gs4 mf s d5) (e bb4 s fs4 d4 e g4) (s e4 ff d4 b3 mf e eb4) (s cs4 p bb3 mf e gs3 p s c4 ff) (s a3 a3 mf e b3 ff gs3) (s bb3 c4 d4 e b3 mf) (s cs4 p eb4 mf e f4 p s eb4 ff) (s e4 fs4 gs4 p fs4 ff) (e g4 p s a4 mf bb4 a4) (s bb4 c5 cs5 p c5 mf) (s cs5 eb5 ff e e5 mf eb5 ff) (s e5 mf e fs5 g5 p s fs5 ff) (s g5 mf gs5 a5 p a5) (e bb5 ff b5 mf s c6 ff c6))) => ? ( ;; Bar 1 (s g1 ff gs1 p a1 ff b1) ;; Bar 2 (s c2 mf cs2 ff d2 e2 mf) ;; Bar 3 (e f2 p s fs2 ff g2 p a2) ;; Bar 4 (s b2 mf e c3 s cs3 ff eb3) ;; Bar 5 (s e3 mf f3 ff fs3 p a3 mf) ;; Bar 6 (s bb3 ff b3 e c4 p s e4) ;; Bar 7 (e e4 ff s f4 e s b4 p) ;; Bar 8 (e b4 s s mf e fs5 ff) ;; Bar 9 (s fs5 mf f5 p mf e cs6) ;; Bar 10 (s cs6 c6 p e b5 mf s g6 ff) ;; Bar 11 (s g6 p ff e f6 g6 mf) ;; Bar 12 (s g6 g6 p ff e fs6) ;; Bar 13 (s g6 mf p e s fs6) ;; Bar 14 (s fs6 fs6 ff mf ff) ;; Bar 15 (e fs6 p s ff fs6 fs6 mf) ;; Bar 16 (s fs6 fs6 ff p f6) ;; Bar 17 (s fs6 ff mf e e f6) ;; Bar 18 (s f6 e fs6 fs6 p s f6) ;; Bar 19 (s f6 mf fs6 fs6 p f6) ;; Bar 20 (e f6 f6 ff s fs6 p f6 ff) ;; Bar 21 (s f6 p e s s) ;; Bar 22 (s f6 e mf p s ff) ;; Bar 23 (s f6 mf p mf e ff) ;; Bar 24 (s f6 p e s mf p) ;; Bar 25 (s f6 ff e mf s e p) ;; Bar 26 (e f6 s e ff mf) ;; Bar 27 (s f6 p mf e6 ff f6 p) ;; Bar 28 (s f6 ff e6 mf e eb6 p f6 mf) ;; Bar 29 (s f6 e6 d6 f6) ;; Bar 30 (s f6 e6 ff d6 e f6 p) ;; Bar 31 (s f6 mf e6 ff cs6 f6 mf) ;; Bar 32 (s f6 ff f6 cs6 mf f6 ff) ;; Bar 33 (e f6 mf s s cs6 p fs6 mf) ;; Bar 34 (s f6 ff e e6 p s bb5 mf f6) ;; Bar 35 (s e6 p b5 f5 eb6) ;; Bar 36 (s bb5 fs5 ff e cs5 p s a5 mf) ;; Bar 37 (e e5 ff s c5 e gs4 mf s d5) ;; Bar 38 (e bb4 s fs4 d4 e g4) ;; Bar 39 (s e4 ff d4 b3 mf e eb4) ;; Bar 40 (s cs4 p bb3 mf e gs3 p s c4 ff) ;; Bar 41 (s a3 a3 mf e b3 ff gs3) ;; Bar 42 (s bb3 c4 d4 e b3 mf) ;; Bar 43 (s cs4 p eb4 mf e f4 p s eb4 ff) ;; Bar 44 (s e4 fs4 gs4 p fs4 ff) ;; Bar 45 (e g4 p s a4 mf bb4 a4) ;; Bar 46 (s bb4 c5 cs5 p c5 mf) ;; Bar 47 (s cs5 eb5 ff e e5 mf eb5 ff) ;; Bar 48 (s e5 mf e fs5 g5 p s fs5 ff) ;; Bar 49 (s g5 mf gs5 a5 p a5) ;; Bar 50 (e bb5 ff b5 mf s c6 ff c6) )  
I revise only a single part at a time, as I will also re-bar the music. If I later want to update bar number comments, I can just call pprint-part on the result again. BTW: get-time-signature is useful to extract the time signatures for def-score from the part data.
 
The function pprint-part is defined below.
 
Best,
Torsten
 
;; based on https://groups.google.com/forum/#!topic/comp.lang.lisp/_NP7Ub6hLsE (setf *print-pretty* t *print-miser-width* 0 *print-right-margin* 80) (defun pprint-part (part &optional (stream *standard-output*)) "Pretty prints a part one bar a time, adding a bar line comment before each bar. Args: part: nested OMN list. Example: (pprint-part '((q c4 d4 e4) (h f4 q e4) (h. d2)))" (pprint-logical-block (stream nil :prefix "(" :suffix ")") (pprint-logical-block (stream part) (loop for bar-no from 1 to (length part) for bar in part do (progn (pprint-indent :block 1 stream) (pprint-newline :mandatory stream) (format stream ";; Bar ~A" bar-no) (pprint-newline :mandatory stream) (prin1 bar stream)))) (pprint-indent :block -1 stream) (pprint-newline :mandatory stream)))  

There are many occasions when we would like to add articulations by hand to our generated scores.
The first thing we need to do is to convert (output) the score into omn format.
 
Algorithmically generated score.
(setf size 200) (setf vector (add-triangle-waves 4 size 1 0.6 :modulation (gen-triangle size 1 '(0.5 0.4 0.3 0.6) :modulation (gen-triangle size 1 0.3 :phase 180)))) (setf pitches (gen-divide 4 (vector-to-pitch '(g1 g6) vector))) (setf transpose (pitch-transpose -12 pitches)) (setf variants (pitch-variant transpose :variant '?)) (setf length (rnd-sample 120 '(s e s s))) (setf time (span pitches length)) (setf dynamics '(p mf ff)) (def-score add-triangle (:title "Waves Add-Triangle" :composer "OPMO" :copyright "© 2014 Opusmodus" :key-signature 'chromatic :time-signature (get-time-signature time) :tempo 120 :layout (piano-solo-layout 'rh 'lh :flexible-clef t)) (rh :length time :pitch pitches :velocity (rnd-sample size dynamics) :port 0 :sound 'gm :channel 1 :program 'acoustic-grand-piano) (lh :length time :pitch variants :velocity (rnd-sample size dynamics)))  
The expression below will convert the score into omn score format.
(compile-score 'add-triangle :output :score)  
To get a more readable version of the score add PPRINT (print pretty) at the beginning of the expression.
(pprint (compile-score 'add-triangle :output :score))  
Output in the Listener:
(def-score add-triangle (:title "Waves Add-Triangle" :composer "OPMO" :copyright "© 2014 Opusmodus" :key-signature 'chromatic :layout '(:brace (:flexible-treble rh) (:flexible-bass lh) :name "" :abbr "" :flexible-clef t) :time-signature '((1 4 2) (5 16 2) (1 4 1) (5 16 1) (3 8 2) (5 16 2) (3 8 1) (5 16 2) (1 4 1) (5 16 1) (1 4 1) (3 8 2) (1 4 1) (3 8 1) (5 16 1) (3 8 1) (5 16 2) (3 8 1) (7 16 1) (1 4 1) (3 8 1) (1 4 1) (5 16 1) (1 4 2) (5 16 2) (1 4 1) (5 16 1) (3 8 2) (5 16 2) (3 8 1) (5 16 2) (1 4 1) (5 16 1) (1 4 1) (3 8 2) (1 4 1) (3 8 1)) :tempo '120) (rh :omn '((s g1 ff gs1 p a1 ff b1) (s c2 mf cs2 ff d2 e2 mf) (e f2 p s fs2 ff g2 p a2) (s b2 mf e c3 s cs3 ff eb3) (s e3 mf f3 ff fs3 p a3 mf) (s bb3 ff b3 e c4 p s e4) (e e4 ff s f4 e s b4 p) (e b4 s s mf e fs5 ff) (s fs5 mf f5 p mf e cs6) (s cs6 c6 p e b5 mf s g6 ff) (s g6 p ff e f6 g6 mf) (s g6 g6 p ff e fs6) (s g6 mf p e s fs6) (s fs6 fs6 ff mf ff) (e fs6 p s ff fs6 fs6 mf) (s fs6 fs6 ff p f6) (s fs6 ff mf e e f6) (s f6 e fs6 fs6 p s f6) (s f6 mf fs6 fs6 p f6) (e f6 f6 ff s fs6 p f6 ff) (s f6 p e s s) (s f6 e mf p s ff) (s f6 mf p mf e ff) (s f6 p e s mf p) (s f6 ff e mf s e p) (e f6 s e ff mf) (s f6 p mf e6 ff f6 p) (s f6 ff e6 mf e eb6 p f6 mf) (s f6 e6 d6 f6) (s f6 e6 ff d6 e f6 p) (s f6 mf e6 ff cs6 f6 mf) (s f6 ff f6 cs6 mf f6 ff) (e f6 mf s s cs6 p fs6 mf) (s f6 ff e e6 p s bb5 mf f6) (s e6 p b5 f5 eb6) (s bb5 fs5 ff e cs5 p s a5 mf) (e e5 ff s c5 e gs4 mf s d5) (e bb4 s fs4 d4 e g4) (s e4 ff d4 b3 mf e eb4) (s cs4 p bb3 mf e gs3 p s c4 ff) (s a3 a3 mf e b3 ff gs3) (s bb3 c4 d4 e b3 mf) (s cs4 p eb4 mf e f4 p s eb4 ff) (s e4 fs4 gs4 p fs4 ff) (e g4 p s a4 mf bb4 a4) (s bb4 c5 cs5 p c5 mf) (s cs5 eb5 ff e e5 mf eb5 ff) (s e5 mf e fs5 g5 p s fs5 ff) (s g5 mf gs5 a5 p a5) (e bb5 ff b5 mf s c6 ff c6)) :channel 1 :sound 'gm :program 'acoustic-grand-piano :volume 90 :pan 64) (lh :omn '((s b0 p a0 mf gs1 g1) (s e1 d1 cs1 ff c1) (e a1 mf s g1 p fs1 mf f1) (s eb2 ff e cs2 s c2 mf b1 p) (s e2 mf eb2 d2 b1 p) (s e3 mf c3 p e b2 ff s bb2) (e b3 p s f3 mf e s e3 ff) (e b3 p s s ff e e3 mf) (s cs5 ff a5 p a5 e gs5 mf) (s cs5 ff c5 e b4 mf s g5 ff) (s g5 mf a5 ff e g5 p g5) (s g5 g5 mf g5 e fs5 ff) (s g5 p g5 e ff s gs5 mf) (s fs5 fs5 ff mf fs5) (e fs5 s p mf fs5) (s fs5 p ff p f5 mf) (s f5 p fs5 mf e e) (s f5 p e e5 e5 ff s f5) (s f5 p e5 e5 f5) (e f5 ff fs5 p s f5 ff f5) (s f5 e s p f5) (s f5 ff e e p s ff) (s f5 mf f5 f5 e p) (s f5 e ff s mf ff) (s f5 mf e p s e mf) (e f5 s e p f5) (s e5 f5 mf p f5) (s f5 g5 ff e fs5 p f5 ff) (s f5 fs5 mf gs5 f5 ff) (s f5 d5 e5 e f5 mf) (s cs5 e5 f5 f5 p) (s f5 ff mf p cs5) (e cs5 ff s f5 mf p fs5 mf) (s f5 e fs5 s c6 f5) (s e5 b4 p f4 eb5 mf) (s bb4 p a4 mf e fs4 p s cs4 ff) (e e4 mf s gs4 p e c5 mf s fs4 ff) (e bb3 s fs3 d3 e g3 mf) (s e3 p d3 b2 e eb3 ff) (s c3 mf e3 p e d3 ff s b2 mf) (s b2 ff a2 p e e gs2) (s b2 ff gs2 mf bb2 ff e c3 p) (s cs3 b2 mf e a2 ff s b2 p) (s fs3 e3 mf fs3 p gs3) (e g3 ff s f3 e3 p f3 ff) (s c4 mf cs4 c4 bb3) (s cs4 p eb4 mf e e4 eb4) (s fs4 p e g4 mf fs4 s e4) (s g4 gs4 p a4 a4) (e c5 ff mf s cs5 ff d5 p)) :channel 1 :sound 'gm :program 'acoustic-grand-piano :volume 90 :pan 64))  
Copy the score from the Listener and paste it into the Composer panel.
Now we are ready to add articulations etc... to the score by hand.

This is a simple piano piece by Patrick Mimran . 
 
SimpleSpringPianoPiece - - Output - Stereo Out.mp3
 
 
SimpleSpringPianoPiece.opmo

Dear Janusz,
 
Opusmodus is already flexible enough to notate incomplete OMN forms like the following, even though the pitch is missing.
 
'(h mp pizz)
 
Because this expression is no complete OMN, omn-formp returns nil.
 
(omn-formp '(h mp pizz))
=> nil
 
However, it would be useful to still be able to disassemble this expression. Currently disassemble-omn returns an error, because the pitch is missing. However, if such expression can even be notated, then why not allowing to also disassemble it as follows.
 
(disassemble-omn '(h c4 mp pizz))
; desired output -- currently error is caused
=> (:length (1/2) :velocity (mp) :articulation (pizz)) 
; alternative -- likely default pitch needed for consistency
=> (:length (1/2) :pitch (c4) :velocity (mp) :articulation (pizz)) 
 
I am asking for this, because that would allow to implement functions that can build up OMN forms incrementally (as an alternative to make-omn), increasing flexibility. Here is an example of a not yet existing function demonstrating what I am talking about. It would complement the function edit-omn I was proposing earlier today.
 
(add-omn :pitch '(g4 a4)
         '((q f pizz) (h arco)))
=> ((q g4 f pizz) (h a4 arco)))
 
What do you think?
 
Thanks!
 
Best,
Torsten

It is nice to have velocity transformation functions like velocity-variant and friends, but I would like to go further. How about being able to easily increasing or decreasing the overall volume (basically a dynamics/velocity transposition), or to smoothen dynamics differences in order to create dynamics variations in the composition process? Here are two examples.
 
(velocity-add 0.1 '(mf> > > > > pp))
 => (f> > > > > p)
 
(velocity-smooth 0.7 '((ppp p mf ff p< < <) (fff> > f><p ff mf p ppp)))
  => ((ppp< < < mp< < mp< <) (f< ff> > < ff> > mp))
 
Below is an implementation of these functions. Further functions like this can now easily be implemented with velocity-transform. The principle idea is to transform OMN velocities into a numeric OMN vector (list), and do whatever transformation you want to do on that vector, and finally to transform the result back into OMN velocities. The details are explained in the comment string of the functions below.
 
Note that these definitions depend on my function simplify-dynamics.
 
Best,
Torsten
 
(defun velocity-transform (fun args &key (simplify T)) "Higher-order function for transforming velocities by processing them as an Openmodus vector in the background. Args fun: a function expecting a vector and possibly more arguments. args: the arguments for `fun'. Velocities should be explicitly transformed into numeric values. Example: (get-velocity '(mf> > > > > pp)) simplify (default T): whether or not to simplify cresc. and dim. in the result with simplify-dynamics. Example (velocity-transform #'vector-add (list (get-velocity '(mf> > > > > pp)) '(0.1)))" (let* ((vel-vector (apply fun args)) (result (velocity-to-dynamic (vector-to-velocity (apply #'min vel-vector) (apply #'max vel-vector) vel-vector)))) (if simplify (simplify-dynamics result) result))) (defun velocity-add (offset velocities &key (simplify T)) "Adds an offset to a list of OMN velocities. Quasi the dynamics equivalent of pitch transposition. Args offset: an offset added to `velocities', can be numeric (between 0 and 1) or a velocity symbol (e.g., pp), and also a list of either. velocities: list of velocities, can be nested. Examples (velocity-add 0.1 '(mf> > > > > pp)) => (f> > > > > p) (velocity-add 'pppp '(mf> > > > > pp)) => (f> > > > > p) (velocity-add 0.1 '((mf> > >) (> > pp))) => ((f> > >) (> > p)) (velocity-add '(0.1 0.2 0.3 0.4 0.5 0.6) '(mf> > > > > pp)) => (f< < < < < ffff) " (span velocities (velocity-transform #'vector-add (list (get-velocity (flatten velocities)) (if (listp offset) (mapcar #'get-velocity offset) (list (get-velocity offset)))) :simplify simplify))) (defun velocity-smooth (alfa velocities &key (simplify T)) "Smoothes velocity values. Args alfa: parameter controlling the degree of exponential smoothing (usually 0 < alpha < 1). velocities: list of velocities, can be nested. Example (velocity-smooth 0.7 '((ppp p mf ff p< < <) (fff> > f><p ff mf p ppp))) => ((ppp< < < mp< < mp< <) (f< ff> > < ff> > mp)) (velocity-smooth 0.2 '((ppp p mf ff p< < <) (fff> > f><p ff mf p ppp))) => ((ppp< < < < < < <) (< mf mf mf mf mf mf))" (span velocities (velocity-transform #'vector-smooth (list alfa (get-velocity (flatten velocities))) :simplify simplify)))  

Here is a slightly revised version of simplify-dynamics that can also handle nested lists (bars). See documentation string for details and examples.
 
Best,
Torsten
 
(defun simplify-dynamics (dynamics &key (flat T)) "Removes intermediate textual dynamic indicators from longer hairpins (e.g., generated by velocity-to-dynamic or gen-dynamic). Args flat (default T): whether or not to simplify dynamics across sublists. Examples: (simplify-dynamics '(pppp< < ppp< pp< < p< < mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) => (pppp< < < < < < < < < < < < ff> > > > > > pppp) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp))) => ((pppp< < < < < < <) (< < < < < ff> > > > > > pppp)) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) :flat nil) => ((pppp< < < < < < <) (mp< < < < < ff> > > > > > pppp)) " (if (or flat (not (some #'listp dynamics))) (let ((flat-dynamics (flatten dynamics))) (span dynamics (append (list (first flat-dynamics)) (loop for (d1 d2 d3) on flat-dynamics when (and d2 d3) collect (cond ((or (and (cresc-p d1) (dim-p d3)) (and (dim-p d1) (cresc-p d3))) d2) ((or (and (cresc-p d1) (cresc-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (< (get-velocity d2) (get-velocity d3)))) '<) ((or (and (dim-p d1) (dim-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (> (get-velocity d2) (get-velocity d3)))) '>) (t d2))) (last flat-dynamics)))) (mapcar #'simplify-dynamics dynamics)))  

Here is a slightly revised version of simplify-dynamics that can also handle nested lists (bars). See documentation string for details and examples.
 
Best,
Torsten
 
(defun simplify-dynamics (dynamics &key (flat T)) "Removes intermediate textual dynamic indicators from longer hairpins (e.g., generated by velocity-to-dynamic or gen-dynamic). Args flat (default T): whether or not to simplify dynamics across sublists. Examples: (simplify-dynamics '(pppp< < ppp< pp< < p< < mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) => (pppp< < < < < < < < < < < < ff> > > > > > pppp) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp))) => ((pppp< < < < < < <) (< < < < < ff> > > > > > pppp)) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) :flat nil) => ((pppp< < < < < < <) (mp< < < < < ff> > > > > > pppp)) " (if (or flat (not (some #'listp dynamics))) (let ((flat-dynamics (flatten dynamics))) (span dynamics (append (list (first flat-dynamics)) (loop for (d1 d2 d3) on flat-dynamics when (and d2 d3) collect (cond ((or (and (cresc-p d1) (dim-p d3)) (and (dim-p d1) (cresc-p d3))) d2) ((or (and (cresc-p d1) (cresc-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (< (get-velocity d2) (get-velocity d3)))) '<) ((or (and (dim-p d1) (dim-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (> (get-velocity d2) (get-velocity d3)))) '>) (t d2))) (last flat-dynamics)))) (mapcar #'simplify-dynamics dynamics)))  

Thanks! Should be fixed now.
(defun simplify-dynamics (dynamics) "Removes intermediate textual dynamic indicators from longer hairpins (e.g., generated by velocity-to-dynamic or gen-dynamic). Example: (simplify-dynamics '(pppp< < ppp< pp< < p< < mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) => (pppp< < < < < < < < < < < < ff> > > > > > pppp) " (append (list (first dynamics)) (loop for (d1 d2 d3) on dynamics when (and d2 d3) collect (cond ((or (and (cresc-p d1) (dim-p d3)) (and (dim-p d1) (cresc-p d3))) d2) ((or (and (cresc-p d1) (cresc-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (< (get-velocity d2) (get-velocity d3)))) '<) ((or (and (dim-p d1) (dim-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (> (get-velocity d2) (get-velocity d3)))) '>) (t d2))) (last dynamics)))  

;;; ---------------------------------------------------------------- ;;; modifying proprtions by add/sub of the smallest/largest values ;;; number of elements is constant / sum of the seq also constant ;;; n => number of generations ;;; prop-list => integers ;;; :style => sharpen or flatten ;;; ---------------------------------------------------------------- (defun modify-proportions (n prop-list &key (style 'sharpen)) (let ((rest-pos (loop for i in prop-list for cnt = 0 then (incf cnt) when (< i 0) collect cnt)) (prop-list (abs! prop-list)) (liste)) (progn (setf liste (append (list prop-list) (loop repeat n when (or (= (length (find-above 1 prop-list)) 1) (= (length (find-unique prop-list)) 1)) collect prop-list else collect (setf prop-list (loop for i in prop-list for cnt = 0 then (incf cnt) collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list)) (if (equal style 'sharpen) (1- i) (1+ i))) ((= cnt (position (find-max prop-list) prop-list)) (if (equal style 'sharpen) (1+ i) (1- i))) (t i))))))) (loop for i in liste collect (loop for k in i for cnt = 0 then (incf cnt) when (memberp cnt rest-pos) collect (* -1 k) else collect k))))) ;;; examples (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'sharpen) (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'flatten) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'sharpen) 1/16) '(4 4)) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'flatten) 1/16) '(4 4)) (list-plot (modify-proportions 10 '(5 3 2 -7 1 8 2)) :point-radius 0 :style :fill)  
...works not in all CASES (when :style 'flatten), but okay...