code rnd-complete-seq

[AM]

;; a function which fills up a sequence randomly - max-length = length sequence
;; (regardless of the number of cycles)


(defun rnd-complete-seq (n &key sequence (step 1) seed (sort '<) (exclude nil) (append-excluded nil))
  (let* ((testseq)
         (sequence (if (null exclude)
                    sequence 
                    (filter-remove exclude sequence)))
         (sequence (loop repeat (length sequence)
                     with sequence = (loop repeat n
                                       with seq = '()
                                       do (setf seq (append (rnd-unique step sequence :seed seed) seq))
                                       do (setf sequence (filter-remove seq sequence))
                                       collect seq)
                     for i in (if (equal sort '<)
                                (sort-asc sequence)
                                (sort-desc sequence))
                     collect i)))

    (if (null append-excluded)
      sequence 
      (progn 
        (cond ((pitchp (first (car (last sequence))))
               (setf testseq (pitch-to-midi sequence)))
              ((velocityp (first (car (last sequence))))
               (setf testseq (get-velocity sequence)))
              (t (setf testseq sequence)))

        (if (< (first (car (last testseq))) (second (car (last testseq))))
          (list sequence (sort-asc (append exclude (car (last sequence)))))
          (list sequence (sort-desc (append exclude (car (last sequence))))))))))


;;; EXAMPLES

(rnd-complete-seq 8 :sequence (expand-tonality '(b3 messiaen-mode6)))
=> ((b3) (b3 a4) (b3 a4 as4) (b3 f4 a4 as4) (b3 e4 f4 a4 as4) (b3 cs4 e4 f4 a4 as4) (b3 cs4 ds4 e4 f4 a4 as4) (b3 cs4 ds4 e4 f4 g4 a4 as4))
;or
=> ((as4) (e4 as4) (e4 f4 as4) (cs4 e4 f4 as4) (cs4 e4 f4 g4 as4) (b3 cs4 e4 f4 g4 as4) (b3 cs4 ds4 e4 f4 g4 as4) (b3 cs4 ds4 e4 f4 g4 a4 as4))
;or .... 


(rnd-complete-seq 5 :sequence '(0 1 2 3 4 5 6 7 8 9 10 11 12))
=> ((1) (1 7) (0 1 7) (0 1 7 9) (0 1 7 9 11))
;or 
=> ((0) (0 1) (0 1 11) (0 1 6 11) (0 1 6 11 12))
;or .... 


(rnd-complete-seq 5 :step 2 :sequence '(0 1 2 3 4 5 6 7 8 9 10 11 12))
=> ((1 7) (0 1 7 8) (0 1 5 7 8 12) (0 1 5 7 8 9 10 12) (0 1 2 5 7 8 9 10 11 12))

(rnd-complete-seq 5 :step 2 :sequence '(0 1 2 3 4 5 6 7 8 9 10 11 12) :seed 234)
=> ((4 12) (3 4 11 12) (2 3 4 10 11 12) (2 3 4 5 9 10 11 12) (1 2 3 4 5 8 9 10 11 12))


(rnd-complete-seq 5 :step 2 :sequence '(0 1 2 3 4 5 6 7 8 9 10 11 12) :sort '> :seed 234)
=> ((12 4) (12 11 4 3) (12 11 10 4 3 2) (12 11 10 9 5 4 3 2) (12 11 10 9 8 5 4 3 2 1))


(rnd-complete-seq 5 :step 2 :sequence '(pppp ppp pp p mp mf f ff fff ffff) :sort '> :seed 234)
=> ((ffff p) (ffff fff p pp) (ffff fff ff p pp ppp) (ffff fff ff f mp p pp ppp) (ffff fff ff f mf mp p pp ppp pppp))


;;; examples with EXCLUDE

(rnd-complete-seq 4 :sequence '(1 2 3 4 5 6 7 8) :exclude '(1 8))
=> ((5) (4 5) (2 4 5) (2 4 5 6))

(rnd-complete-seq 4 :sequence '(1 2 3 4 5 6 7 8) :exclude '(1 8) :append-excluded t)
=> (((7) (4 7) (4 5 7) (4 5 6 7)) (1 4 5 6 7 8))

(rnd-complete-seq 4 :sequence '(pppp ppp pp p mp mf f ff fff ffff) :exclude '(pppp ffff) :append-excluded t)
=> (((mf) (p mf) (ppp p mf) (ppp p mf f)) (pppp ppp p mf f ffff))

 

Edited August 31, 2018 by AM
extended version!