modify-proportions

[AM]

;;; ----------------------------------------------------------------
;;; modifying proprtions by add/sub of the smallest/largest values
;;; number of elements is constant / sum of the seq also constant
;;; n => number of generations
;;; prop-list => integers
;;; :style => sharpen or flatten
;;; ----------------------------------------------------------------

(defun modify-proportions (n prop-list &key (style 'sharpen))
  (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)))))))
      (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)))))

;;; examples

(modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'sharpen)
(modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'flatten)


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

 

...works not in all CASES (when :style 'flatten), but okay...