# 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 corr_event

when (or (null event_stack)
(= (second event_stack) (second event)))
event_stack event
corr_event nil)
else do (progn
(setq nenner (/ (/ 1 (second event_stack)) (second compensating-to))
(if (/= modulo 0)
(setq corr_event (* (* -1 (- nenner modulo)) (second event_stack))))

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

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

×   Pasted as rich text.   Paste as plain text instead

Only 75 emoji are allowed.

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×

• Lessons