Jump to content

length-compensate


Recommended Posts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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))

 

Link to comment
Share on other sites

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))

 

Link to comment
Share on other sites

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)

 

Link to comment
Share on other sites

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. 

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