AM

You may like this:
(encode-consecutive '(a a a a b c c a a d e e e e)) => ((4 a) (1 b) (2 c) (2 a) (1 d) (4 e)) (group-consecutive '(a a a a b c c a a d e e e e)) => ((a a a a) (b) (c c) (a a) (d) (e e e e))  

;;; little markov-game: ;;; gen-markov => analyze the output => produce new rules => gen-markov ;;; make x-times the list-plot and you will see how the system most of the times ;;; comes to a "constant STATE" (defun self-analyzing/generating-markov (transitions size generations) (loop repeat generations with list = (gen-markov-from-transitions transitions :size size :start 1) append (setq list (gen-markov-from-transitions (gen-markov-transitions list) :size size :start (car (last list)))))) ;;; a "neutral table with 4 values" (setf transition-table '((1 (1 1) (2 1) (3 1) (4 1)) (2 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (4 (1 1) (2 1) (3 1) (4 1)))) ;;; evaluate a few times and have a look on the output (list-plot (self-analyzing/generating-markov transition-table 20 20) :point-radius 0 :style :fill)  

;;; little markov-game: ;;; gen-markov => analyze the output => produce new rules => gen-markov ;;; make x-times the list-plot and you will see how the system most of the times ;;; comes to a "constant STATE" (defun self-analyzing/generating-markov (transitions size generations) (loop repeat generations with list = (gen-markov-from-transitions transitions :size size :start 1) append (setq list (gen-markov-from-transitions (gen-markov-transitions list) :size size :start (car (last list)))))) ;;; a "neutral table with 4 values" (setf transition-table '((1 (1 1) (2 1) (3 1) (4 1)) (2 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (4 (1 1) (2 1) (3 1) (4 1)))) ;;; evaluate a few times and have a look on the output (list-plot (self-analyzing/generating-markov transition-table 20 20) :point-radius 0 :style :fill)  

;;; little markov-game: ;;; gen-markov => analyze the output => produce new rules => gen-markov ;;; make x-times the list-plot and you will see how the system most of the times ;;; comes to a "constant STATE" (defun self-analyzing/generating-markov (transitions size generations) (loop repeat generations with list = (gen-markov-from-transitions transitions :size size :start 1) append (setq list (gen-markov-from-transitions (gen-markov-transitions list) :size size :start (car (last list)))))) ;;; a "neutral table with 4 values" (setf transition-table '((1 (1 1) (2 1) (3 1) (4 1)) (2 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (3 (1 1) (2 1) (3 1) (4 1)) (4 (1 1) (2 1) (3 1) (4 1)))) ;;; evaluate a few times and have a look on the output (list-plot (self-analyzing/generating-markov transition-table 20 20) :point-radius 0 :style :fill)  

;;; little program to change markov-weight for a specific value ;;; to give markov a "rule-tendency" (setq transitions '((a (b 1) (c 3) (d 2) (e 1)) (b (a 2) (d 3)) (c (a 2) (e 1) (b 3)) (d (c 2) (b 1) (a 3)) (e (a 2) (b 2) (d 1)))) (defun substitute-transition-weight (transition-list value new-weight) (loop for j in transition-list collect (append (list (first j)) (loop repeat (1- (length j)) for cnt = 1 then (incf cnt) when (equal (first (nth cnt j)) value) collect (list (first (nth cnt j)) new-weight) else collect (nth cnt j))))) (substitute-transition-weight transitions 'a 100) ;;; example for "concrete use" (loop repeat 20 with transitions = '((a (b 3) (c 3) (a 2)) (b (a 2) (b 3) (c 5)) (c (a 2) (c 1))) with weight = 1 do (setq transitions (substitute-transition-weight transitions 'a weight)) do (incf weight 2) collect (gen-markov-from-transitions transitions :size 20 :start 'a)) best wishes 
andré

;;; little program to change markov-weight for a specific value ;;; to give markov a "rule-tendency" (setq transitions '((a (b 1) (c 3) (d 2) (e 1)) (b (a 2) (d 3)) (c (a 2) (e 1) (b 3)) (d (c 2) (b 1) (a 3)) (e (a 2) (b 2) (d 1)))) (defun substitute-transition-weight (transition-list value new-weight) (loop for j in transition-list collect (append (list (first j)) (loop repeat (1- (length j)) for cnt = 1 then (incf cnt) when (equal (first (nth cnt j)) value) collect (list (first (nth cnt j)) new-weight) else collect (nth cnt j))))) (substitute-transition-weight transitions 'a 100) ;;; example for "concrete use" (loop repeat 20 with transitions = '((a (b 3) (c 3) (a 2)) (b (a 2) (b 3) (c 5)) (c (a 2) (c 1))) with weight = 1 do (setq transitions (substitute-transition-weight transitions 'a weight)) do (incf weight 2) collect (gen-markov-from-transitions transitions :size 20 :start 'a)) best wishes 
andré

;;; little program to change markov-weight for a specific value ;;; to give markov a "rule-tendency" (setq transitions '((a (b 1) (c 3) (d 2) (e 1)) (b (a 2) (d 3)) (c (a 2) (e 1) (b 3)) (d (c 2) (b 1) (a 3)) (e (a 2) (b 2) (d 1)))) (defun substitute-transition-weight (transition-list value new-weight) (loop for j in transition-list collect (append (list (first j)) (loop repeat (1- (length j)) for cnt = 1 then (incf cnt) when (equal (first (nth cnt j)) value) collect (list (first (nth cnt j)) new-weight) else collect (nth cnt j))))) (substitute-transition-weight transitions 'a 100) ;;; example for "concrete use" (loop repeat 20 with transitions = '((a (b 3) (c 3) (a 2)) (b (a 2) (b 3) (c 5)) (c (a 2) (c 1))) with weight = 1 do (setq transitions (substitute-transition-weight transitions 'a weight)) do (incf weight 2) collect (gen-markov-from-transitions transitions :size 20 :start 'a)) best wishes 
andré

of course...i knew that... but:
yours is not with AMBITUS and not with complex-sieves, and not in ONE function.  
and, as all the time, i wanted to do it for myself.
 

if you want to pick a sample from approx.center (depends on odd/even)  of a list... 
 
(defun pick-sample-from-center (list span) (let ((center (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (span (if (> span (length list)) (length list) (append span)))) (loop repeat span with startpoint = (if (evenp span) (- center (/ span 2)) (- center (/ (1+ span) 2))) for i = startpoint then (incf startpoint) collect (nth i list)))) ;;;EXAMPLES: (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 7) => (2 3 4 5 4 3 2) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 3) => (4 5 4) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 6) => (3 4 5 4 3 2) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 20) ; (if (> span length) => input-list as output => (1 2 3 4 5 4 3 2 1)  

violà, i think this is what you are looking for...
(defun multiple-expand-tonality (&key startpitch octaves tonality) (remove-duplicates ;remove is for "cutting" if there are too much pitches (OMN loops last octave!) (loop repeat octaves with pitch = startpitch with cnt = 0 when (= cnt (length tonality)) do (setq cnt 0) append (expand-tonality (list pitch (nth cnt tonality))) do (incf cnt) do (setq pitch (car (pitch-transpose 12 (list pitch))))))) (multiple-expand-tonality :startpitch 'c2 :octaves 6 :tonality '(messiaen-mode1 messiaen-mode2 messiaen-mode3))  

(1/12 1/20 1/4 1/4 1/5 1/6)  

(5/32 1/32 1/4 1/32 5/32 1/4 3/32 1/32 5/32 1/16 1/16)  

 
(1/20 1/10 3/20 1/5 1/4 3/10 7/20 2/5 9/20 1/2 11/20)  

 
((1/20 1/20 1/20) (1/10 1/20) (2/20 2/20 -1/20) (1/20 1/20) (1/12 1/2))  

Part of the next release, thanks to Andre:
(gen-sieve '(c4 g7) '(2 1)) => (0 2 3 5 6 8 9 11 12 14 15 17 18 20 21 23 24 26 27 29 30 32 33 35 36 38 39 41 42) (gen-sieve '(c4 g7) '(2 1) :type :pitch) => (c4 d4 eb4 f4 fs4 gs4 a4 b4 c5 d5 eb5 f5 fs5 gs5 a5 b5 c6 d6 eb6 f6 fs6 gs6 a6 b6 c7 d7 eb7 f7 fs7) (gen-sieve '((c4 g7) (c1 g7)) '((2 1 12) (3 5))) => (-36 -33 -28 -25 -20 -17 -12 -9 -4 -1 0 2 3 4 7 12 15 17 18 20 23 28 30 31 32 33 36 39) (gen-sieve '((c4 g7) (c1 g7)) '((2 1 12) (3 5)) :type :pitch) => (c1 eb1 gs1 b1 e2 g2 c3 eb3 gs3 b3 c4 d4 eb4 e4 g4 c5 eb5 f5 fs5 gs5 b5 e6 fs6 g6 gs6 a6 c7 eb7) (gen-sieve '(violin (c1 g6) piccolo) '((2 1 12) (3 5) (3 6)) :type :interval) => (3 5 3 5 3 5 3 4 1 1 1 1 5 3 3 2 1 2 5 1 2 1 1 2 1 2 1 2 6 1 2 1 5)  

if you want to pick a sample from approx.center (depends on odd/even)  of a list... 
 
(defun pick-sample-from-center (list span) (let ((center (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (span (if (> span (length list)) (length list) (append span)))) (loop repeat span with startpoint = (if (evenp span) (- center (/ span 2)) (- center (/ (1+ span) 2))) for i = startpoint then (incf startpoint) collect (nth i list)))) ;;;EXAMPLES: (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 7) => (2 3 4 5 4 3 2) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 3) => (4 5 4) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 6) => (3 4 5 4 3 2) (pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 20) ; (if (> span length) => input-list as output => (1 2 3 4 5 4 3 2 1)  

kind of transposing.... in ONE function...
 
(defun adjust-pitch-sequence (pitch-sequence pitch1 pitch2) (pitch-transpose (car (pitch-to-interval (list pitch1 pitch2))) pitch-sequence)) ;;;'b3 (and all around) will be transposed to 'a6 (adjust-pitch-sequence '(c3 b3 a4 g1) 'b3 'a6) => (bb5 a6 g7 f4)  
here a simple self-similarity-example - but it's not for what i coded it..
 
(setq seq '(c3 b3 a4 g2)) (loop for i in seq collect (adjust-pitch-sequence seq 'c3 i))  

kind of transposing.... in ONE function...
 
(defun adjust-pitch-sequence (pitch-sequence pitch1 pitch2) (pitch-transpose (car (pitch-to-interval (list pitch1 pitch2))) pitch-sequence)) ;;;'b3 (and all around) will be transposed to 'a6 (adjust-pitch-sequence '(c3 b3 a4 g1) 'b3 'a6) => (bb5 a6 g7 f4)  
here a simple self-similarity-example - but it's not for what i coded it..
 
(setq seq '(c3 b3 a4 g2)) (loop for i in seq collect (adjust-pitch-sequence seq 'c3 i))  

Here's a minimalist style soundtrack made as one of the tests for my new orchestral template.
 
 

SB.

further XENAKIS-sieve-functions could be with the AND/OR/NOT inside... see: "formalized-music" or:
https://www.youtube.com/watch?v=mHUkSf4aZ3E
 
 
 
 

One function with few changes:
 
(defun gen-sieve (ambitus interval) (do-verbose ("gen-sieve") (flet ((gen-sieve* (ambitus interval) (integer-to-pitch (loop with integer = (pitch-to-integer ambitus) with cnt = -1 for int = (first integer) then (setf int (+ (nth cnt interval) int)) when (<= int (second integer)) collect int into bag else return bag do (incf cnt) when (= cnt (length interval)) do (setf cnt 0))))) (if (listsp ambitus) (sort-asc (find-unique (loop for a in ambitus for i in interval append (gen-sieve* a i)))) (gen-sieve* ambitus interval))))) (gen-sieve '(c4 g7) '(2 1)) => (c4 d4 eb4 f4 fs4 gs4 a4 b4 c5 d5 eb5 f5 fs5 gs5 a5 b5 c6 d6 eb6 f6 fs6 gs6 a6 b6 c7 d7 eb7 f7 fs7) (gen-sieve '((c4 g7) (c1 g7)) '((2 1 12) (3 5))) => (c1 eb1 gs1 b1 e2 g2 c3 eb3 gs3 b3 c4 d4 eb4 e4 g4 c5 eb5 f5 fs5 gs5 b5 e6 fs6 g6 gs6 a6 c7 eb7)  

nice :-) i have a lot of extra function on SYMMETRIES in my USER-library, it's a part of my momentary project
 
- chained-symmetries
- symmetries based on markov
- shifted symmetries
..................................................
 
 

nice :-) i have a lot of extra function on SYMMETRIES in my USER-library, it's a part of my momentary project
 
- chained-symmetries
- symmetries based on markov
- shifted symmetries
..................................................
 
 

have fun!
andré
 
;;; TWO SIEVE-generators ;;; simple and multiple (the simple-function is part of multiple) ;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-sieve (ambitus.omn intervals) (midi-to-pitch (loop with ambitus.midi = (pitch-to-midi ambitus.omn) with interval.cnt = -1 for pitch = (first ambitus.midi) then (setq pitch (+ (nth interval.cnt intervals) pitch)) when (<= pitch (second ambitus.midi)) collect pitch into bag else return bag do (incf interval.cnt) when (= interval.cnt (length intervals)) do (setq interval.cnt 0)))) (gen-sieve '(c4 g7) '(2 1)) ;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-multiple-sieve (sieve-rules) ;sieve-rules => '((ambitus.omn intervals) (ambitus.omn intervals) (ambitus.omn intervals)) (midi-to-pitch (sort (remove-duplicates (loop for i in sieve-rules append (pitch-to-midi (gen-sieve (first i) (second i))))) #'<))) (gen-multiple-sieve '(((c4 g7) (2 1 12)) ((c1 g7) (3 5))))  

Examples with newly added keyword :sort (the default is t):
;;; TEST (setf mat '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4 c5 cs5 d5)) (mapcar 'pitch-to-integer (list (tonality-map '((3 0 1 4 6 11 13) :root 3 :sort nil) mat) (tonality-map '((3 0 1 4 6 11 13) :root 3 :sort nil :shift t) mat) (tonality-map '((3 0 1 4 6 11 13) :root 3 :sort t :shift t) mat) (tonality-map '((3 0 1 4 6 11 13) :root 3 :sort nil :fixed t) mat) (tonality-map '((3 0 1 4 6 11 13) :root 3 :sort t :fixed t) mat) )) => ((3 4 4 6 6 6 11 11 11 12 13 13 15 16 16) (3 0 1 4 6 11 13 15 12 13 16 18 23 25 27) (3 4 6 7 9 14 16 15 16 18 19 21 26 28 27) (3 4 4 6 6 6 11 11 11 13 13 13 13 13 13) (3 4 4 6 7 7 9 9 9 14 14 14 16 16 16))  

violà, i think this is what you are looking for...
(defun multiple-expand-tonality (&key startpitch octaves tonality) (remove-duplicates ;remove is for "cutting" if there are too much pitches (OMN loops last octave!) (loop repeat octaves with pitch = startpitch with cnt = 0 when (= cnt (length tonality)) do (setq cnt 0) append (expand-tonality (list pitch (nth cnt tonality))) do (incf cnt) do (setq pitch (car (pitch-transpose 12 (list pitch))))))) (multiple-expand-tonality :startpitch 'c2 :octaves 6 :tonality '(messiaen-mode1 messiaen-mode2 messiaen-mode3))  

i'm sure that it would also work with tonality-map,
but i was interested to code a simple version for my own to understand all the things :-)
 
;;; i wanted to map every interval-sequence to every possible pitchfield... ;;; all the sequences are "centered" (i needed that for my project) ;;; with :base you could move up and down the center ;;; :pitchfield has to be a OMN-pitch-sequence ;;; FUNCTION (defun interval-projection-on-pitchfield (&key pitchfield intervals (base 0)) (let ((integers (pitch-to-integer (interval-to-pitch intervals))) (base-0-integers) (centering) (pos)) (setq base-0-integers (loop for i in integers collect (+ (abs (find-min integers)) i))) (setq centering (if (evenp (find-max base-0-integers)) ;; finds the center of the seq (/ (find-max base-0-integers) 2) (/ (1+ (find-max base-0-integers)) 2))) (loop for i in base-0-integers do (setq pos (+ i (* -1 centering) base)) ;; compensating center & base when (< pos 0) do (setq pos 0) ;; corr if intervals to big (+/-) when (> pos (1- (length pitchfield))) do (setq pos (1- (length pitchfield))) collect (nth pos pitchfield)))) ;;; EXAMPLE (interval-projection-on-pitchfield :pitchfield (append (expand-tonality '(c4 messiaen-mode5)) (expand-tonality '(c5 messiaen-mode5)) (expand-tonality '(c6 messiaen-mode5))) :intervals '(1 2 3 1 2 -4 -3 -2 3 5 7 -2) :base 12)  
short question: is there a possibilty to build this
(append (expand-tonality '(c4 messiaen-mode5)) (expand-tonality '(c5 messiaen-mode5)) (expand-tonality '(c6 messiaen-mode5))) with ONE function (i need more ambitus then 1 octave)...
 
thanx, andré
 
 
 

i'm sure that it would also work with tonality-map,
but i was interested to code a simple version for my own to understand all the things :-)
 
;;; i wanted to map every interval-sequence to every possible pitchfield... ;;; all the sequences are "centered" (i needed that for my project) ;;; with :base you could move up and down the center ;;; :pitchfield has to be a OMN-pitch-sequence ;;; FUNCTION (defun interval-projection-on-pitchfield (&key pitchfield intervals (base 0)) (let ((integers (pitch-to-integer (interval-to-pitch intervals))) (base-0-integers) (centering) (pos)) (setq base-0-integers (loop for i in integers collect (+ (abs (find-min integers)) i))) (setq centering (if (evenp (find-max base-0-integers)) ;; finds the center of the seq (/ (find-max base-0-integers) 2) (/ (1+ (find-max base-0-integers)) 2))) (loop for i in base-0-integers do (setq pos (+ i (* -1 centering) base)) ;; compensating center & base when (< pos 0) do (setq pos 0) ;; corr if intervals to big (+/-) when (> pos (1- (length pitchfield))) do (setq pos (1- (length pitchfield))) collect (nth pos pitchfield)))) ;;; EXAMPLE (interval-projection-on-pitchfield :pitchfield (append (expand-tonality '(c4 messiaen-mode5)) (expand-tonality '(c5 messiaen-mode5)) (expand-tonality '(c6 messiaen-mode5))) :intervals '(1 2 3 1 2 -4 -3 -2 3 5 7 -2) :base 12)  
short question: is there a possibilty to build this
(append (expand-tonality '(c4 messiaen-mode5)) (expand-tonality '(c5 messiaen-mode5)) (expand-tonality '(c6 messiaen-mode5))) with ONE function (i need more ambitus then 1 octave)...
 
thanx, andré