modify-proportions

[AM]

[another old function]

-----------------------------

 

modify-proportions   n prop-list &key (style 'sharpen) (last 'nil)

 

[Function]

 

Arguments and Values:

 

n generations

prop-list  a list with integers (pos/neg)

&key

style 'sharpen / 'flatten

last if t => only last gens

 

"Modifies the integer list by changing the smallest/largest value in every generation by 1-/1+.

The sum of the list always remains constant, as is the number of values. Sharpen leads to great differences

Flatten paves everything at the same values."

 

 

;;; SUB
(defun memberp (n liste)
  (not (equal 'nil (member n liste))))


;;; MAIN
(defun modify-proportions (n prop-list &key (style 'sharpen) (last 'nil))
  (let ((rest-pos (loop for i in prop-list
                    for cnt = 0 then (incf cnt)
                    when (< i 0) collect cnt))
        (prop-list (abs! prop-list))
        (liste))
    (progn 
      (setf liste (append (list prop-list)
                          (loop repeat n
                            when (or (= (length (find-above 1 prop-list)) 1)
                                     (= (length (find-unique prop-list)) 1))
                            collect prop-list
                            else collect (setf prop-list (loop 
                                                           for i in prop-list
                                                           for cnt = 0 then (incf cnt)
                                                           collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list))
                                                                          (if (equal style 'sharpen) 
                                                                            (1- i)
                                                                            (1+ i)))
                                                                         ((= cnt (position (find-max prop-list) prop-list))
                                                                          (if (equal style 'sharpen) 
                                                              (1+ i)
                                                                            (1- i)))
                                                           (t i)))))))
      (setf liste (loop 
                    for i in liste
                    collect (loop for k in i
                              for cnt = 0 then (incf cnt)
                              when (memberp cnt rest-pos)
                              collect (* -1 k) else collect k)))
      (if (equal last 'nil)
        liste
        (car (last liste))))))


;;;EXAMPLES

(omn-to-time-signature
 (gen-length (modify-proportions 8 '(4 3 2 7) :style 'sharpen) 1/16)
 '(4 4))

(omn-to-time-signature
 (gen-length (modify-proportions 8 '(4 3 2 7) :style 'flatten) 1/16)
 '(4 4))

(list-plot 
 (modify-proportions 10 '(5 3 2 -7 1 8 2))
:point-radius 0 :style :fill)

(list-plot 
 (modify-proportions 10 (rnd-order '(5 3 2 -7 1 8 2)) :style 'flatten)
:point-radius 0 :style :fill)

(pitch-list-plot 
 (flatten (integer-to-pitch
 (modify-proportions 15 (rnd-order '(13 3 2 -7 1 -13 8 2)) :style 'flatten)))
:point-radius 0 :style :fill)

(pitch-list-plot 
 (flatten (integer-to-pitch
 (modify-proportions 10 (rnd-order '(1 3 2 -4 1 -2 5 2)) :style 'sharpen)))
:point-radius 0 :style :fill)