move-set

Move-set is a function inspired by Mikael Kuhn's move-set function in PGen for Csound.

https://mikelkuehn.com/index.php/ng

It allows you to make random choices by moving progressively in a morphing from one set to another
linearly or by following a convex or concave curve controlled by the
parameter: curve. <1 = concave, 1 = linear,> 1 = convex.
The norep option allows you to remove direct repeats in random choices.
 

;;;======================================
;;;      MOVE-SET
;;; SB. 01.11.2020
;;;======================================
;;; Move-set est une fonction inspirée de la fonction move-set de Mikael Kuhn dans PGen pour Csound.
;;; Elle permet de faire des choix aléatoire en passant progressivement d'un ensemble à un autre
;;; de manière linéaire ou alors en suivant une courbe convexe ou concave controlée par le
;;; parametre :curve.  <1 = concave, 1 = lineaire,  >1 = convexe.
;;; l'option norep permet d'éviter les répétitions directes dans les choix aléatoires.
;;; Parametres: 
;;; set1 liste
;;; set2 liste
;;; nbsteps entier
;;; nbval entier ou liste d'entiers
;;; curve <1 = concave, 1 = lineaire,  >1 = convexe. Par défaut 1
;;; norep nil ou t. par défaut nil.
;;; seed un entier. Par défaut nil.


;;; Definition de la fonction MOVE-SET
(defun move-set (set1 set2 nbsteps nbval &key (curve 1) (norep nil) seed)
"Move-set est une fonction inspirée de la fonction move-set de Mikael Kuhn dans PGen pour Csound.
Elle permet de faire des choix aléatoires  en passant progressivement dans un morphing d'un ensemble à un autre
de manière linéaire ou alors en suivant une courbe convexe ou concave controlée par le
parametre :curve.  <1 = concave, 1 = lineaire,  >1 = convexe.
L'option norep permet d'éviter les répétitions directes dans les choix aléatoires.
Parametres: 
set1 liste
set2 liste
nbsteps entier
nbval entier ou liste d'entiers
curve <1 = concave, 1 = lineaire,  >1 = convexe. Par défaut 1
norep nil ou t. par défaut nil.
seed un entier."
 (setf seed (rnd-seed seed))
  (do-verbose ("move-set :seed ~s" seed)
   (init-seed seed)
  (let ((idx (gen-transition 0 (- nbsteps 1) nbsteps curve :rounded t))
        (bmat (gen-morph nbsteps set1 set2 :seed (seed)))
        )
    (loop 
      for i in idx
      for v  in (gen-trim nbsteps (list! nbval))
      collect (rnd-sample v (nth i bmat) :norep norep)) 
        )))


;;; Exemples  d'utilisation:
#|  
(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 8)
(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 8 :norep t)
(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 8 :curve 0.2 :seed 4)
(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 8 :curve 0.2 :seed 4 :norep t)
(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 8 :curve 1.5 :seed 4 :norep t)

(move-set '(c4 d4 e4) '(fs4 as4 cs5) 12 '(8 4 12 5) :curve 1.5 :seed 4 :norep t)

(move-set '(e e e e) '(s s s s) 12 8 :seed 7)
             

(setf melo (filter-tie
            (make-omn
             :pitch (setf pch (move-set '(c4 d4 fs4 gs4 b4) '(e4 g4 a4 bb4 cs5) 12 (rnd-number 6 2 16)))
             :length (gen-tuplet 1 1 'm '? 'w (mapcar 'length pch))
             )))
|#

SB.

move-set.lisp