AM

a short - and perhaps stupid - question... what's the idea for this function, useful for ...? practical purpose? thanx for a short hint!

thank you, i just like it :-) know everythings seems complete...

;;;;; ;;;;; gen-stacc2 and gen-stacc3 => usefull tools to build little variants ;;;; subfunctions => also possible with prob? (defun weighted-random (list) (loop for item in list with rand-num = (random (loop for x in list sum (second x))) for add = (second item) then (+ add (second item)) when (< rand-num add) return (first item))) (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) ;;;; mainfunctions (defun gen-stacc (liste) (if (numberp liste) (if (> (numerator liste) 1) (list (/ 1 (denominator liste)) (/ (* -1 (- (numerator liste) 1)) (denominator liste))) (list liste)) (loop for i in liste append (if (> (numerator i) 1) (list (/ 1 (denominator i)) (/ (* -1 (- (numerator i) 1)) (denominator i))) (list i))))) (gen-stacc '(1/32 7/32 9/32 17/32)) (gen-stacc '(3/8)) ;; (defun gen-stacc2 (n liste &key (stacc-chance 1)) (loop for i in liste when (and (> i n) (equal (weighted-t/nil stacc-chance) 't)) append (list n (* -1 (- (abs i) n))) else collect i)) (gen-stacc2 1/32 '(1/32 7/32 9/32 17/32) :stacc-chance 0.5) ;; (defun gen-stacc3 (n-liste liste &key (stacc-chance 1)) (loop for i in liste with n do (setq n (rnd-pick n-liste)) when (and (> i n) (equal (weighted-t/nil stacc-chance) 't)) append (list n (* -1 (- (abs i) n))) else collect i)) (gen-stacc3 '(1/32 5/32) '(1/32 7/32 5/32 9/32 17/32 3/8 9/32 17/32) :stacc-chance 0.5) ;;;;;;

a concrete example (but musical-nonsense)... of a TRANSITION produced by a special markov-program 1) functions/subfuctions ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun add-transition-weight (transition-list value add-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)) (+ add-weight (second (nth cnt j)))) else collect (nth cnt j))))) ;;;;;;;;;;;;;;;;;;;;;;;;;; (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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun eliminate-repetitions (liste) (let ((liste (append liste (list 'nil)))) (loop repeat (1- (length liste)) with cnt = 0 when (not (equal (nth cnt liste) (nth (+ 1 cnt) liste))) collect (nth cnt liste) do (incf cnt)))) (eliminate-repetitions '(1 1 2 3 4 4 4 1 1 2)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-markov-from-transitions-with-tendency (transitions size generations value &key (add-weight 1) (start (first (first transitions)))) (loop repeat generations with list = (gen-markov-from-transitions transitions :size size :start start ) with weight = add-weight with weight-growth = 0 do (setq transitions (add-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-growth)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2) example and possible implementation => create a TRANSITION to value 3 (=> to pitch eb4) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;evaluate a few times, to check it;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (list-plot ;;non-neutral-table (setq integers (gen-markov-from-transitions-with-tendency '((1 (1 1) (2 4) (3 1)) (2 (1 1) (4 1) (3 3)) (3 (1 4) (3 5) (4 3)) (4 (1 1) (3 2) (4 3))) 10 20 3 :add-weight 3)) :point-radius 0 :style :fill) #| ;;another example with different mapping (list-plot ;;non-neutral-table (setq integers (gen-markov-from-transitions-with-tendency '((1 (1 1) (2 4) (3 1)) (2 (1 1) (4 1) (3 3) (6 1)) (3 (1 4) (3 5) (4 3) (6 1) (5 1)) (4 (1 1) (3 2) (4 3) (5 2) (6 1)) (5 (1 1) (3 1) (4 1)) (6 (2 3) (1 2) (3 1) (5 1))) 10 20 3 :add-weight 3)) :point-radius 0 :style :fill) (setq integers (replace-map '((5 -5) (1 0) (2 6) (3 14) (4 20) (6 25)) integers)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;gen an example-score;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-score example (:key-signature 'chromatic :time-signature '(4 8) :tempo '(e 176) :layout (bracket-group (piano-grand-layout 'piano))) (piano :omn (make-omn :pitch (eliminate-repetitions (integer-to-pitch integers)) :length (gen-length (count-repetitions integers) 1/32)) :sound 'gm-piano))

https://en.wikipedia.org/wiki/Collatz_conjecture ;;experiment with COLLATZ-conjecture ;;https://en.wikipedia.org/wiki/Collatz_conjecture (defun collatz (start-value number-of-value) (loop repeat number-of-value with value = start-value when (evenp value) do (setq value (/ value 2)) else do (setq value (+ (* 3 value) 1)) collect value)) (list-plot (collatz 15 20) :zero-based t :point-radius 2 :join-points t) ;;;;;;;;;;;; ;;same function like fibonacci-transition but now with COLLATZ. ;;don't know if that makes sense - just a bit code :-) (defun transition-with-collatz (number-of-values start-val value-a value-b) (let ((coll-length) (coll-seq) (all-seq)) (setq coll-length (loop for cnt = 1 then (incf cnt) collect (sum (collatz start-val cnt)) into bag when (> (car (last bag)) number-of-values) do (return (1- (length bag)))) coll-seq (collatz start-val coll-length) all-seq (append (reverse coll-seq) (loop repeat (- number-of-values (sum coll-seq)) collect 1))) (loop for i in all-seq append (loop repeat i for cnt = 0 then (incf cnt) when (= cnt 0) collect value-b else collect value-a)))) ;;example-1 => only the process => makes sense when using a lot of values... (list-plot (transition-with-collatz 500 56 1 2) :zero-based t :point-radius 2 :join-points t)

;;little function to make a transition by FIBONACCI-seq ;;i have seen this idea in "slippery chicken" (by michael edwards), ;;so here is a - "not so smart" but working - basic-function. (defun transition-with-fibonacci (number-of-values value-a value-b) (let ((fib-length) (fib-seq) (all-seq)) (setq fib-length (loop for cnt = 1 then (incf cnt) collect (sum (fibonacci 2 cnt)) into bag when (> (car (last bag)) number-of-values) do (return (1- (length bag)))) fib-seq (fibonacci 2 fib-length) all-seq (append (reverse fib-seq) (loop repeat (- number-of-values (sum fib-seq)) collect 1))) (loop for i in all-seq append (loop repeat i for cnt = 0 then (incf cnt) when (= cnt 0) collect value-b else collect value-a)))) ;;example-1 => only the process (transition-with-fibonacci 70 1 2) ;;example-2 => with context = sequence with 1 or 2 (before/after transition) (list-plot (append (gen-repeat 10 1) (transition-with-fibonacci 32 1 2) (gen-repeat 10 2)) :zero-based t :point-radius 2 :join-points t)

now edited!

you are right, sorry. no computer with me... think you could replace filter-first-last by: (car (last list))

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 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)

;;; 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é

looking forward to next release!

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)

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

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))

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

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 ..................................................

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.

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))))

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))

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)

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é

;; 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)

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 ?