;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; a little function to compensate special-rhy-changes
;;; to 1/4-note structure... (or all :compensating-to -values)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; best format-solution was 1/32 => '(1 32) etc... otherwise
;;; i get in trouble with 1/8 = 4/32 - what is mathematicclay 
;;; correct - but bringing BUGS to the output

;;; if anybody could transform things '(2/32) to '(2 32) or
;;; '(3/12) to '(3 12) would be nice, i coudn't code it. this
;;; things are necessary because the function makes decicions
;;; bewtween the denominators, so there sould be constant!!!!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun length-compensate2 (liste &key (compensating-to '(1 4)))
  (butlast 
   (loop for event in (loop for i in (append liste (list (list (* -1 (first compensating-to)) (/ 1 (second compensating-to)))))
                        collect (list (first i) (/ 1 (second i))))
     with nenner
     with modulo
     with event_stack 
     with add_duration = 0
     with corr_event 
     
     when (or (null event_stack)
              (= (second event_stack) (second event)))
     do (setq add_duration (+ add_duration (abs (first event)))
              event_stack event
              corr_event nil)
     else do (progn 
               (setq nenner (/ (/ 1 (second event_stack)) (second compensating-to))
                     modulo (mod add_duration nenner))
               (if (/= modulo 0)
                 (setq corr_event (* (* -1 (- nenner modulo)) (second event_stack))))
               (setq add_duration (abs (first event))))
     
     when (not (equal corr_event 'nil))
     collect corr_event
     and do (setq corr_event nil)
     
     collect (* (first event) (second event))
     do (setq event_stack event))))



;example-1
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16)))))
;exampl-2
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16))))
                    :compensating-to '(1 8))

 

Here is my solution:

;; -----------------------------------------------------------------------
;; length-round
;; -----------------------------------------------------------------------

(defun find-length-base (length base)
  (prog (out i)
    (setf out nil)
    (setf i base)
    loop
    (cond ((not (null out)) (return out)))
    (setf out (if (<= length base) base))
    (setf base (+ i base))
    (go loop)))

(defun length-round (sequence &key (round 1/4) section exclude)
  (do-verbose ("length-round")
    (labels ((length-round-1 (length round)
               (let ((out (- (find-length-base length round) length)))
                 (list length (if (minusp length) (abs out) (neg! out)))))
             
             (length-round-l (list round)
               (flatten
                (loop for i in list
                  collect (length-round-1 i round))))
             
             (length-round-ls (list round)
               (let* ((len (length list))
                      (round (gen-trim* len (list! round))))
                 (loop for i in list for x in round
                   collect (length-round-l i x))))
             
             (length-round* (list round)
               (if (listsp list) (length-round-ls list round)
                 (length-round-l list round))))
      
      (let ((len (length sequence)))
        (if exclude
          (maybe-section (lambda (x) (length-round* x round)) sequence (num-exclude len exclude))
          (maybe-section (lambda (x) (length-round* x round)) sequence section))))))

(length-round '(1/16 -1/16 2/32 5/7 4/20 6/20 3/20 5/16))
=> (1/16 -3/16 -1/16 5/16 1/16 -3/16 5/7 -1/28 1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16)
      
(length-round '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round 1/8)
=> ((1/16 -1/16 -1/16 3/16 1/16 -1/16 5/7 -1/28) (1/5 -1/20 3/10 -3/40 3/20 -1/10 5/16 -1/16))
      
(length-round '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8 1/4))
=> ((1/16 -1/16 -1/16 3/16 1/16 -1/16 5/7 -1/28) (1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16))
      
(length-round '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8) :section 0)
=> ((1/16 -1/16 -1/16 3/16 1/16 -1/16 5/7 -1/28) (1/5 3/10 3/20 5/16))
      
(length-round '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8) :exclude 0)
=> ((1/16 -1/16 1/16 5/7) (1/5 -1/20 3/10 -3/40 3/20 -1/10 5/16 -1/16))

 

VERY NICE CODE... but your function does not do the same as mine 

...perhaps a misunderstanding / a different idea!

...you compensate EVERY value, my code only compensates when "rhy" is changing

 

(length-round '(1/16 3/16 2/32 5/7 4/20 6/20 3/20 5/16))

=> (1/16 -3/16 3/16 -1/16 1/16 -3/16 5/7 -1/28 1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16)

..after the 1/16 it's not necessary to "round" with -3/16, because -> also with teh other values

 

here with my code -> i only want to compensate when "denominators" are changing => have a look at markings (bold)

(length-compensate2  '((1 16) (3 16) (2 32) (5 7) (4 20) (6 20) (3 20) (5 16)))

=> (1/16 3/16       1/16 -3/16      5/7 -1/28    1/5    3/10      3/20 -1/10     5/16 -3/16)

 

Final name and function:

(length-rational-quantize '(1/4 -1/16 2/32 5/7 4/20 6/20 3/20 5/16))
=> (1/4 -1/16 1/16 -1/8 5/7 -1/28 1/5 3/10 3/20 -1/10 5/16 -3/16)
      
(length-rational-quantize '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round 1/8)
=> ((1/16 -1/16 1/16 -1/16 5/7 -1/28) (1/5 3/10 3/20 -1/10 5/16 -1/16))
      
(length-rational-quantize '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8 1/4))
=> ((1/16 -1/16 1/16 -1/16 5/7 -1/28) (1/5 3/10 3/20 -1/10 5/16 -3/16))
      
(length-rational-quantize '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8) :section 0)
=> ((1/16 -1/16 1/16 -1/16 5/7 -1/28) (1/5 3/10 3/20 5/16))
      
(length-rational-quantize '((1/16 -1/16 2/32 5/7) (4/20 6/20 3/20 5/16)) :round '(1/8) :exclude 0)
=> ((1/16 -1/16 1/16 5/7) (1/5 3/10 3/20 -1/10 5/16 -1/16))

 

I see the difference of your output naturally. 

it's allready in my USER LIBRARY...

just say when you are not interested in such things - i know you have a lot of work without these extra-stuff... :-) 

i'm very happy with OPUSMODUS!