Everything posted by AM
-
another markov game
you are right, sorry. no computer with me... think you could replace filter-first-last by: (car (last list))
-
count-repetitions
don't konw if something like this exists in ONE function... could be useful!! andré (defun count-repetitions (value-list) (let ((seq (append value-list (list 'nil)))) (loop repeat (1- (length seq)) with count = 1 for cnt1 = 0 then (incf cnt1) for cnt2 = 1 then (incf cnt2) when (equal (nth cnt1 seq) (nth cnt2 seq)) do (incf count) when (not (equal (nth cnt1 seq) (nth cnt2 seq))) collect count and do (setq count 1)))) (count-repetitions '(1 1 2 2 2 3 4 4 1)) (count-repetitions '(abc bc a a a a bc))
-
another markov game
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;another little markov-game => markov with "global-tendency" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;a "neutral table with 4 values" (setq transitions '((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)))) ;;;subfunctions (defun filter-first-last (n sequence) (car (filter-last n sequence))) (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))))) ;;;mainfuction (defun markov-with-tendency (transitions size generations value) (loop repeat generations with list = (gen-markov-from-transitions transitions :size size :start 1) with weight = 1 with weight-add = 0 do (setq transitions (substitute-transition-weight transitions value weight)) append (setq list (gen-markov-from-transitions transitions :size size :start (filter-first-last 1 list))) do (incf weight (incf weight-add)))) ;;;some simulations => evaluate!!! (list-plot (markov-with-tendency transitions 10 20 1) :point-radius 0 :style :fill) (list-plot (list (markov-with-tendency transitions 10 20 1) (markov-with-tendency transitions 10 20 2) (markov-with-tendency transitions 10 20 4)) :point-radius 0 :style :fill) (list-plot ;;non-neutral-table (markov-with-tendency '((1 (1 1) (2 4)) (2 (1 1) (4 1)) (3 (1 4) (3 5) (4 3)) (3 (1 1) (2 4) (3 2)) (4 (1 1) (3 2) (4 3))) 10 20 1) :point-radius 0 :style :fill)
-
a little markov game
;;; 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)
-
substitute markov transition-weight
;;; 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é
- gen-sieves
-
pick-sample-from-center
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)
-
L-SYSTEMS / Hanspeter Kyburz
here's a link to a small article (in german) about HANSPETER KYBURZ's kind of L-SYSTEM-implementation... http://www.eresholz.de/de/text/Eres Holz_Ausschnitt aus der Masterarbeit.pdf
-
adjust-pitch-sequence
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))
- gen-sieves
- gen-sieves
- gen-sieves
-
gen-sieves
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))))
-
interval-mapping
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))
-
interval-mapping
dear stephane thanx to you! volià, here is a simple short code for this "problem"... regards andré ;;;FUNCTION (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 append (expand-tonality (list pitch tonality)) do (setq pitch (car (pitch-transpose 12 (list pitch))))))) ;;;EXAMPLE (multiple-expand-tonality :startpitch 'c2 :octaves 3 :tonality 'messiaen-mode1)
-
interval-mapping
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é
-
ambitus-swallow -> excluded pitches
;; little function. don't know if something like this already exits ;; in OMN: i wanted to READ the swallowed pitches after ambitus-swallow ;; i hope it works fine... ;;function (defun read-ambitus-swallowed (min/max omn-sequence) (let ((up (ambitus-swallow (list (second min/max) 'g9) omn-sequence)) (down (ambitus-swallow (list 'c0 (first min/max)) omn-sequence))) (merge-voices up down))) ;;nonsense-sequence (setq omn-sequence '(e f4 t a0 q g0 d9 s. eb6 t. f3 cs9 t ab0 q c0)) ;;ord ambitus-swallow (ambitus-swallow '(a0 g8) omn-sequence) ;;the excluded pitches (read-ambitus-swallowed '(a0 g8) omn-sequence)
-
change rhythm-value into acciaccatura?
that's the reason beacuse ein wanted to do replace BEFORE ambitus-swallow. when i have such problems i'm mostly starting to change the DATA-structure. then i'm generating (so called) EVENTS - every event has the same structure - when no data then its slot is 'nil -> this was also necessary/or the best way for my HOQUETUS-code... in that case you can avoid such "data-phase-delays" but i don't know if this is the best solution ?
-
change rhythm-value into acciaccatura?
okay i see, thanx! after AMBITUS-SWALLOW (for splitting voices), i have to REPLACE the value by ACC in one voice and delete the VALUE/the REST in the other voices... but - after short coding - it seems, that it's not so easy - looks like the grammar get some error and after that you have some phase-delays in the seperat omn-stream (between the voices)...
-
substitute markov-transition-rules
a version for 2+LEVEL-markov-tables all the best andré ;;example-mat (setq pitch-seq (append '(c4 cs4 fs4 g4) '(a4 gs4 eb4 d4) '(c4 d4 eb4 ab4 bb4 b4) '(c5 bb4 e4 d4 db4 b3 f3 eb3) '(d3 g3 c4 cs4 fs4 b4) '(c5 bb4 f4 e4 b3 a3) '(g3 c4 b3 bb3 f3) '(g3 c4 b3 bb3 f3) '(g3 c4 b3 bb3 f3) '(e3 eb3 a2 bb2))) ;; different levels of transition-tables > LEVEL 2, 3, & 4 (setf transition2 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 2)) (setf transition3 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 3)) (setf transition4 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 4)) ;; the substitution-function for LEVELS 2+ (!!!) (defun substitute-transition-value2 (transition-list value-old value-new) (loop for j in transition-list with cnt = 0 collect (loop for i in j when (and (listp i) (= cnt 0)) collect (substitute value-new value-old i) and do (incf cnt) else collect (append (substitute value-new value-old (list (first i))) (list (second i)))) do (setq cnt 0))) ;; examples (gen-markov-from-transitions (substitute-transition-value2 transition2 -1 11) :size 100 :start 2) (gen-markov-from-transitions (substitute-transition-value2 transition3 -1 11) :size 100 :start 2) (gen-markov-from-transitions (substitute-transition-value2 transition4 -1 11) :size 100 :start 2)
-
change rhythm-value into acciaccatura?
i coded my own algorithm... so the ouput is like that, but a problem with ambitus-swallow... (setq omn-list '(s. c4 pp ponte (acc t b3 ppp flaut t f3 ppp flaut) s. e3 pp ponte -t (acc t c4 pp flaut) s. fs3 ppp tasto s. b3 ppp tasto (acc t f3 pp flaut) -t (acc t c4 pppp ord) s. cs4 pp ponte s g4 ppp ord s f4 ppp ord s. b4 pp ponte (acc t c5 pppp ord) -t s c4 pp flaut e_t b3 p tasto s f3 ppp tasto s bb3 ppp tasto e_t e3 p tasto s eb3 pp flaut -w s. c4 ppp tasto (acc t b3 pppp ord t f3 p tasto t d3 p tasto t gs2 pppp ord) s. g2 ppp tasto -w (acc t c4 ppp ord) e_t fs3 pppp tasto (acc t g3 pppp flaut t cs3 pppp flaut) e_t d3 pppp tasto (acc t gs2 ppp ord) -t s c4 pppp ponte (acc t eb4 p tasto) s e4 pp tasto s g4 pp tasto (acc t gs4 p tasto) s b4 pppp ponte -t (acc t c4 p flaut) s. g3 ppp tasto s. gs3 ppp tasto (acc t eb3 p flaut) -t e_t c4 pppp ponte s fs4 pp ord)) ;;; it works well with cmd2, but the function: ambitus-swallow ...has a problem... why? (ambitus-swallow '(cs3 fs5) omn-list) > Error: Duration must be positive when duration-add is false. > While executing: normalize-duration, in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options.
- change rhythm-value into acciaccatura?
- context-markov?
-
multiple-markov - changing context-size/level
hi all, i coded a little markov-program who changes the LEVEL-size if necessary to generate the number of values you want exactly. it would be nice if someone could check/test the IDEA, and if it's correct and makes sense :-) the markov starts on LEVEL 3 and tries to generate a number of output-levels with its TRANSITION-rules (level-3-rules), if it's possible (=generating the size) everything's fine. but if it's not possible, then the programm changes on LEVEL-2-rules ... if this is also not possible (to generate the size) then it changes to LEVEL 1... here is the code... ;;;FUNCTION (defun gen-multiple-markov (sequence &key size) (let ((transitions-level-1 (gen-markov-transitions sequence :level 1)) ;; gen transition-table level-1 (transitions-level-2 (gen-markov-transitions sequence :level 2)) ;; gen transition-table level-2 (seq (gen-markov-from-transitions (gen-markov-transitions sequence :level 3) :size size))) ;; gen markov-seq on level-3 (if (< (length seq) size) ;; test if seq is too short (/= (length seq) size) (progn ;; if too short -> combine the last seq with a new one (level 2) (setq seq (append seq (gen-markov-from-transitions transitions-level-2 :size (- size (length seq)) :start (last seq)))) (if (< (length seq) size) ;; same test as above (append (append seq (gen-markov-from-transitions transitions-level-1 :size (- size (length seq)) :start (last seq)))) (append seq))) (append seq)))) ;;;TEST (gen-multiple-markov '(1 2 3 2 1 2 3 2 1 2 2 2 2 1 1 1 1 2 2 3 2 1 1 2) :size 36) best wishes and THANX andré
- context-markov?