code add-rnd-dust to lengths

[AM]

;;; ADD-RND-DUST TO LENGTHS
;;; this function adding RANDOMLY some "dust" to the LENGTHS, so it will be like a little rubato,
;;; or "humanizing"-effect. the ADD-SPAN is in percent (0.1 = 10%) on each length-value. 

(defun add-rnd-dust (omnseq &key (span '(0.1)) (seed nil) (quantize '(1 2 3 4 5 6 7 8 9)))
  (let ((rhy (omn :length omnseq))
        (sp))
    (progn 
      (setf rhy (loop 
                  with cnt = 0
                  for i in rhy

                  do (setf sp (nth cnt span))

                  when (not (null seed))
                  do (incf seed)
                  
                  when (> i 0) 
                  collect   (+ i (car (rnd-number 1 0.0 (* i sp) :seed seed)))
                  else collect (- i (car (rnd-number 1 0.0 (* i sp) :seed seed)))
                  
                  when (< cnt (1- (length span)))
                  do (incf cnt)))

      (make-omn :length (quantize (float-to-ratio  rhy :ratio 1/1) quantize)
                :pitch (omn :pitch omnseq)
                :velocity (omn :velocity omnseq)
                :articulation (omn :articulation omnseq)))))



;;; EXAMPLE

(add-rnd-dust '(h c3 h. d3 -h q. f3 q g3) 
              :span '(0.5 0.3 0.2 0.1) 
              :quantize '(1 2 3 4 8) 
              :seed 123)

=> (ht c3 h.s. d3 -e -q -t e.._3h f3 3q_q g3)
    
(add-rnd-dust '(q c3 q d3 q e3 q f3 q g3) 
              ;;possible add-span per value (1 = 100% of the value, 0.5 = 50% etc.) 
              ;;if it's a list, it will stay on the last value of the span-list
              :span '(0.4 0.3 0 0 2) 
              ;;how to quantize new lengths
              :quantize '(1 2 4 8) 
              :seed 123)

=> (q c3 qt d3 q e3 f3 hs. g3)


(add-rnd-dust '(h c3 h. d3 h e3 q. f3 q g3) 
              :span '(0.5) ;; = every value max-add 50%
              :quantize '(1 2 3 4 8) 
              :seed 2999)

=> (hs. c3 wt d3 3w.e e3 3wq. f3 q g3)


(add-rnd-dust '(q c3 q d3 q e3 q f3 q g3) 
              :span '(0.4 0.3 0 0 2) 
              :quantize '(1 2 4 8) 
              :seed 1111)

=> (qt c3 qs d3 q e3 f3 q... g3)


(add-rnd-dust '(h c3 h d3 h e3 h f3 h g3) 
              :span '(0.3 0.2 0.1 0 0.2) 
              :quantize '(1 2 4 3 5) 
              :seed 2999)

=> (5dh. c3 5dhq. d3 h e3 f3 he g3)

 

Edited April 26, 2019 by AM
bug by omn-replace (wrong rests), new solution with make-omn, works now

[AM]

@janusz: if you try the function a few times (without seed) , you will see (by cmd1), that sometimes the last TIE isn't there. i think QUANTIZE is doing this little bug... (but perhaps only a xml-display-thing?)

 

 

 

[AM]

an example: 

 

this is the BASIC-version (without "dust"):

all mapped in 1/32 - retrograde sorting processes (with GEN-SORT):

pitch-process from chromatic to 12tone-row (by sort) and from sorted length-values (all 1/32,

then all 1/16 etc... to more complex/mixed pattern (by sort))

 

 

 

with this setup:

 

 

 

the result with some "dust":

if you you have a look to the span-list above (compare with the new score) you will see:

no change at the beginning, then more and more randomized (or made flexible).

 

 

[opmo]

18 hours ago, AM said:

@janusz: if you try the function a few times (without seed) , you will see (by cmd1), that sometimes the last TIE isn't there. i think QUANTIZE is doing this little bug... (but perhaps only a xml-display-thing?)

 

Maybe tolerance in quantize function will fix the problem:

(defun add-rnd-dust (omnseq &key (span '(0.1)) (seed nil) (quantize '(1 2 3 4 5 6 7 8 9)) (tolerance 0.05))
...)

(add-rnd-dust '(h c3 h. d3 -h q. f3 q g3) 
              :span '(0.5 0.3 0.2 0.1) 
              :quantize '(1 2 3 4 8) 
              :seed nil
              :tolerance 0.03)

 

No quantiser can take care of all the small nuances  this is why we have the tolerance option in the function.

 

I like the function.

[AM]

i already did that

(defun add-rnd-dust (omnseq &key (span '(0.1)) (seed nil) (quantize '(1 2 3 4 5 6 7 8 9)) (scale 1.0) (tolerance 0.05))
  (let ((rhy (omn :length omnseq))
        (sp))
    (progn 
      (setf rhy (loop 
                  with cnt = 0
                  for i in rhy

                  do (setf sp (nth cnt span))

                  when (not (null seed))
                  do (incf seed)
                  
                  when (> i 0) 
                  collect   (+ i (car (rnd-number 1 0.0 (* i sp) :seed seed)))
                  else collect (- i (car (rnd-number 1 0.0 (* i sp) :seed seed)))
                  
                  when (< cnt (1- (length span)))
                  do (incf cnt)))

      (make-omn :length (quantize (float-to-ratio  rhy :ratio 1/1) quantize :scale scale :tolerance tolerance)
                :pitch (omn :pitch omnseq)
                :velocity (omn :velocity omnseq)
                :articulation (omn :articulation omnseq)))))

 

[opmo]

Better

[opmo]

 

(defun gen-rnd-dust (sequence &key (span '(0.1)) (quantize '(1 2 3 4 5 6 7 8)) (scale 1.0) (tolerance 0.05) seed)
  (let (state)
    (setf state *init-seed*)
    (setf seed (rnd-seed seed))
    (do-verbose ("gen-rnd-dust, span: ~s quantize: ~s scale: ~s tolerance: ~s seed: ~s"
                 span quantize scale tolerance seed)
      (disassembling-omn ((sequence plist) sequence :length)
        (let* ((length sequence)
               (sp)
               (out (float-to-ratio
                     (loop 
                       with cnt = 0
                       for i in length
                       do (setf sp (nth cnt span))
                       when (> i 0) 
                       collect (+ i (car (rnd-number 1 0.0 (* i sp) :seed (seed))))
                       else collect (- i (car (rnd-number 1 0.0 (* i sp) :seed (seed))))
                       when (< cnt (1- (length span)))
                       do (incf cnt))
                     :ratio 1)))
          (init-state state)
          (quantize out quantize :scale scale :tolerance tolerance))))))

or (with sublists):

(defun gen-rnd-dust (sequence &key (span '(0.1)) (quantize '(1 2 3 4 5 6 7 8)) (scale 1.0) (tolerance 0.05) seed)
  (let (state)
    (setf state *init-seed*)
    (setf seed (rnd-seed seed))
    (do-verbose ("gen-rnd-dust, span: ~s quantize: ~s scale: ~s tolerance: ~s seed: ~s"
                 span quantize scale tolerance seed)
      (let ((ts (get-time-signature sequence))
            (seq (flatten-omn sequence)))
        (omn-to-time-signature
         (disassembling-omn ((seq plist) seq :length)
           (let* ((length seq)
                  (sp)
                  (out (float-to-ratio
                        (loop 
                          with cnt = 0
                          for i in length
                          do (setf sp (nth cnt span))
                          when (> i 0) 
                          collect (+ i (car (rnd-number 1 0.0 (* i sp) :seed (seed))))
                          else collect (- i (car (rnd-number 1 0.0 (* i sp) :seed (seed))))
                          when (< cnt (1- (length span)))
                          do (incf cnt))
                        :ratio 1)))
             (init-state state)
             (quantize out quantize :scale scale :tolerance tolerance)))
         ts)))))

 

Best,

Janusz

[AM]

you could add it!

[RST]

Very interesting opportunities here.