modify-lengths-to-rests

[AM]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; i needed a function who changes randomly lengths to rests
;;; step by step, and modify (enlarge) its rest-values over x-generations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun modify-lengths-to-rests (liste &key (items 1) (step -1) (factor 2) (enlarge-type 'add))
  (let ((liste (loop for j in liste
                   when (< j 0) collect (cond ((equal enlarge-type 'add)
                                               (+ step j))
                                              ((equal enlarge-type 'augmented)
                                               (* factor j)))
                   else collect j)))
    (loop 
      for i in liste
      
      with repl = (rnd-pick (remove 0 liste :test #'>))
      with cnt = 0
      when (and (equal i repl)
                (< cnt items)) 
      collect (* -1 (abs repl)) and do (incf cnt)
      else collect i)))
       

;;;; examples-1 -> ONE generation
;;;; evaluate a few times to see how it works

(modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                         :items 1
                         :enlarge-type 'add) ;enlarge only values < 0

(modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                         :items 2
                         :enlarge-type 'add) ;enlarge only values < 0

(modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                         :items 3
                         :enlarge-type 'add) ;enlarge only values < 0

;;;; examples-2 
;;;; recursiv - with x-generations

(loop repeat 10
  with seq = '(1 2 3 4 4 4 5 6 7)
  collect (setf seq (modify-lengths-to-rests seq 
                                             :items 1
                                             :enlarge-type 'augmented)))

(loop repeat 10
  with seq = '(1 2 3 4 4 4 5 6 7)
  collect (setf seq (modify-lengths-to-rests seq 
                                             :items 1
                                             :enlarge-type 'add)))