Jump to content
Sign in to follow this  
AM

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

 

Share this post


Link to post
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))

 

Share this post


Link to post
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)

 

Share this post


Link to post
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. 

Share this post


Link to post
Share on other sites

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!

Share this post


Link to post
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.

Sign in to follow this  

×
×
  • Create New...