Jump to content

AM

Members
  • Posts

    792
  • Joined

  • Last visited

Everything posted by AM

  1. perhaps you could expand the function when we could not only have "start->end-process/linear", also with a seq-curve (two) for LOW and HIGH values... would be very smart. so it's a kind of ambitus-modulation (with perhaps white-noise)
  2. (defun vector-range-drift (start end input &key (spread 8)) (let ((values (gen-divide (rnd-sum (length input) (primes spread)) input)) (n-values) (a-step) (b-step)) (progn (setf n-values (1- (length values))) (setf a-step (/ (car (difference (list (car start) (car end)))) n-values)) (setf b-step (/ (car (difference (list (cadr start) (cadr end)))) n-values)) (loop for i in values for a = (car start) then (incf a a-step) for b = (cadr start) then (incf b b-step) append (vector-range a b i))))) ;;;;; EXAMPLES -> MODULATE/DRIFT white-noise - with different spreads (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 10)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 6)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 5.6) (gen-white-noise 517))) (list-plot (vector-range-drift '(-1.1 1) '(-3.1 5.6) (gen-white-noise 317)))
  3. short question to GEN-SORT.... the original/start-sequence is not shown with GEN-SORT? i think it should... you see it when using 'min-max... so, i think the AXIOM must be shown greetings andré
  4. function edited - some small changes... extended: :intervals '(1 2 3) -> all these interval-combinations are shown or :intervals 2 (like before) new: :reduced-interval T or NIL (default NIL) -> when T only basic-intervals search (not 1 = 1 & 13 & 25, only in ONE octave) small example ;;; SIEVE with SYMM_STRUCTURE (setf sieve1 (pitch-transpose -6 (integer-to-pitch (gen-sieve '((0 39) (0 40)) '((5) (7)))))) (pitch-to-interval sieve1) ;;; search/permutate interval-combinations (setf pitchlist (find-intervals* sieve1 :intervals '(1 2 3) :reduced-interval t :chord nil)) (setf pitchlist (rnd-unique (length pitchlist) pitchlist)) ;;; change direction of the interval-pairs (setf pitchlist (loop for i in pitchlist when (prob? 0.4) collect (reverse i) else collect i)) ;;; remove immediate repetitions (setf pitchlist (filter-repeat 1 (flatten pitchlist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-score sieve-scan (:title "sieve-scan" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :velocity '(p) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. is there a possibility to filter some "combinations"? when i have a seq like that: (a4 gs4 a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) i want to filter all immediate repetitions with pattern-length = 2 the result would be: (a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) because a4-gs4 is the pair that repeats
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; rnd-walk in a pitchfield - with interval-control ;;; ;;; this is a little function which does an rnd-walk in a special way ;;; the function is checking all possible interval-pairs first inside the pitchfield ;;; so that is on one hand all the time "inside" the pitchfield/sieve, but also only ;;; uses the :POSSIBLE-INTERVALS, so you could control the "interval-color" of the walk ;;; in an non-chromatic-pitchfield/sieve ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun enlarge-intervals (possible-intervals &key (octaves 2)) (let ((possible-intervals (append possible-intervals (loop repeat octaves for i = 12 then (incf i 12) append (x+b possible-intervals i))))) (append possible-intervals (neg! possible-intervals)))) ;(enlarge-intervals '(2 3 4)) ;;;;;;;;;;; (defun special-rnd-walk (n &key pitchfield startpitch possible-intervals (interval-octaves 2)) (let ((int-list (loop for i in pitchfield collect (list (pitch-to-midi i) (loop for x in pitchfield with int do (setf int (car (pitch-to-interval (list i x)))) when (/= int 0) collect int)))) (possible-intervals (enlarge-intervals possible-intervals :octaves interval-octaves))) (append (list startpitch) (midi-to-pitch (loop repeat n with int with pitch = (pitch-to-midi startpitch) do (setf int (rnd-pick (filter-preserve possible-intervals (cadr (assoc pitch int-list))))) when (null int) do (setf int (rnd-pick (cadr (assoc pitch int-list)))) collect (setf pitch (pitch-to-midi (cadr (interval-to-pitch (list int) :start (midi-to-pitch pitch)))))))))) ;;;;;;;;;;; EXAMPLES ;;; rnd-walk in a "chromatic-field" - as the most easiest example/way ;;; => so all possible-intervals could be used -> THE ORDINARY WAY... (special-rnd-walk 20 :startpitch 'cs4 :pitchfield '(gs3 a3 bb3 b3 c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4) :possible-intervals '(1 2 3)) ;;; BUT have a look to the next examples!!! ;;; rnd-walk in a PITCHFIELD -> the function is checking all possible interval-pairs inside the pitchfield ;;; so that the rnd-walk INSIDE the PITCHFIELD could be done with specific intervals (if they are inside the field) ;;; COMPARE THE RESULT with the PITCHFIELD!!! ;;; (setf pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) ;;; "interval-color" of the walk is made with :possible-intervals (special-rnd-walk 5 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(1 2 3)) ; + octaves of this intervals (special-rnd-walk 10 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(1 3 4 5) :interval-octaves 0) ;;; reduced interval-span (special-rnd-walk 10 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(5 6 7)) ; + octaves of this intervals more examples -> SOUND ;;; rnd-versions so you will here the different interval-colors inside the pitchfield (setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch)) ;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch)) ;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) (setf pitchlist (special-rnd-walk (rnd-pick '(3 5 7 11)) :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals (rnd-pick '((1 2) (3 4) (5 6 7))) :interval-octaves 3)) (def-score intervals (:title "walk" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; rnd-walk in SIEVE only with intervals '(5 6 8) (setf seq (gen-sieve '((c4 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch)) (setf pitchlist (special-rnd-walk 30 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(5 6 8))) (def-score intervals (:title "intervals" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) (setf seq (gen-sieve '((c2 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch)) ;;; EXAMPLE with changes -> all inside the same SIEVE (setf pitchlist (append (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(1)) ; minor second (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(2)) ; major second (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(3 4)) ;thirds (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(5 7)))) ; fourth-fifth (def-score intervals (:title "intervals" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano))
  7. i coded it to analyze a pitchfield ;;; a function witch filters/shows you all pitch-combinations by INTERVAL-SIZE ;;; from 1 to 11 ("octave-independent") ;;; for example you are interested to see all FIFTH-combinations in a SIEVE ;;; or to LIST all resulting/ordered intervals (defun equal/or (n alist) (car (loop for i in alist when (equal i n) collect 't))) ;;; FUNCTION (defun find-intervals* (pitch-seq &key (intervals 'all) (chord nil) (reduced-interval nil)) (let ((combs (combination 2 pitch-seq)) (ints) (int) (all-comb-pitches-intervals)) (progn (setf ints (loop for i in combs do (setf int (car (pitch-to-interval i))) when (>= int 0) collect (cond ((and (>= int 12) (<= int 24) (equal reduced-interval nil)) (- int 12)) ((and (>= int 24) (equal reduced-interval nil)) (- int 24)) (t int)))) (setf all-comb-pitches-intervals (loop for i from 1 upto 11 append (loop for j in (loop for x in combs for y in ints collect (cons y x)) when (= (car j) i) collect j))) (if (equal intervals 'all+int) all-comb-pitches-intervals (if (equal intervals 'all) (loop for i in all-comb-pitches-intervals when (equal chord t) collect (chordize (rest i)) else collect (rest i)) (loop for i in all-comb-pitches-intervals when (if (listp intervals) (equal/or (car i) intervals) (= (car i) intervals)); when (= (car i) intervals) collect (if (equal chord t) (chordize (rest i)) (rest i)))))))) ;;; EXAMPLES (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals '(1 5 7) ;; as list :reduced-interval t ;; -> only on/in the same octave :chord nil) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals '(1 3 7) :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 'all :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 2 :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 3) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 5) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 7) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 'all) other example -> cmd3 (setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch)) ;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch)) ;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) (append (find-intervals* seq :intervals 1 :chord t) (find-intervals* seq :intervals 2 :chord t) (find-intervals* seq :intervals 5 :chord t) (find-intervals* seq :intervals 6 :chord t) (find-intervals* seq :intervals 8 :chord t)) (find-intervals* seq :intervals 'all :chord t) ;;; with interval-sizes in output-format (find-intervals* seq :intervals 'all+int) => ((1 a3 bb5) (1 b3 c4) (1 b3 c6) (1 c4 cs4) (1 cs4 d4) (1 cs4 d6) (1 d4 eb5) (1 gs4 a5) (1 a5 bb5) (1 bb5 b5) (1 b5 c6) (2 f3 g5) (2 a3 b3) (2 a3 b5) (2 b3 cs4) (2 c4 d4) (2 c4 d6) (2 cs4 eb5) (2 d4 e4) (2 e4 fs6) (2 gs4 bb5) (2 g5 a5) (2 a5 b5) (2 bb5 c6) (2 c6 d6) (3 f3 gs4) (3 a3 c4) (3 a3 c6) (3 b3 d4) (3 b3 d6) (3 c4 eb5) (3 cs4 e4) (3 e4 g5) (3 gs4 b5) (3 eb5 fs6) (3 g5 bb5) (3 a5 c6) (3 b5 d6) (4 f3 a3) (4 f3 a5) (4 a3 cs4) (4 b3 eb5) (4 c4 e4) (4 d4 fs6) (4 e4 gs4) (4 gs4 c6) (4 eb5 g5) (4 g5 b5) (4 bb5 d6) (4 d6 fs6) (5 f3 bb5) (5 a3 d4) (5 a3 d6) (5 b3 e4) (5 cs4 fs6) (5 d4 g5) (5 e4 a5) (5 g5 c6) (5 a5 d6) (6 f3 b3) (6 f3 b5) (6 a3 eb5) (6 c4 fs6) (6 cs4 g5) (6 d4 gs4) (6 e4 bb5) (6 gs4 d6) (6 eb5 a5) (6 c6 fs6) (7 f3 c4) (7 f3 c6) (7 a3 e4) (7 b3 fs6) (7 c4 g5) (7 cs4 gs4) (7 d4 a5) (7 e4 b5) (7 gs4 eb5) (7 eb5 bb5) (7 g5 d6) (7 b5 fs6) (8 f3 cs4) (8 b3 g5) (8 c4 gs4) (8 cs4 a5) (8 d4 bb5) (8 e4 c6) (8 eb5 b5) (8 bb5 fs6) (9 f3 d4) (9 f3 d6) (9 a3 fs6) (9 b3 gs4) (9 c4 a5) (9 cs4 bb5) (9 d4 b5) (9 eb5 c6) (9 a5 fs6) (10 f3 eb5) (10 a3 g5) (10 b3 a5) (10 c4 bb5) (10 cs4 b5) (10 d4 c6) (10 e4 d6) (10 gs4 fs6) (11 f3 e4) (11 a3 gs4) (11 b3 bb5) (11 c4 b5) (11 cs4 c6) (11 e4 eb5) (11 gs4 g5) (11 eb5 d6) (11 g5 fs6)) perhaps OPMO could extend it to an omn-format-FILTER - so that all other pitches (not matched pitches/sets) would be repaced by rests? would be interesting to work like that with pitchfields/sieves. so you could choose ...for example: "want to have all FIFTHS including a pitch like C or Eb or Gs (octave independent)...?
  8. something new... greetings andré ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; BROWNIAN BRIDGE -> could be use as a rnd-process from A to B (integers or pitches) ;;; if you have a look to example with ":all-gen t", you will see the process with all generations, how it works ;;; or take a look to: ;;; https://de.wikipedia.org/wiki/Wiener-Prozess#/media/File:BrownscheBewegung.png ;;; https://de.wikipedia.org/wiki/Brownsche_Brücke ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUB (defun pick (a b &key (span 5)) (let ((rnd1 (car (rnd-number 1 (+ a span) (- a span)))) (rnd2 (car (rnd-number 1 (+ b span) (- b span)))) (n)) (progn (setf n (car (rnd-number 1 rnd1 rnd2))) (if (or (= n a) (= n b)) (+ (rnd-pick '(1 -1)) n) n)))) ;;; MAIN ;;; MAIN (defun gen-brownian-bridge (n startend &key (all-gen nil) (output 'integer) (span 5)) (let ((seq)) (progn (setf seq (append (list startend) (loop repeat n with liste = startend do (setf liste (filter-repeat 1 (loop repeat (1- (length liste)) for cnt = 0 then (incf cnt) append (append (list (nth cnt liste) (pick (nth cnt liste) (nth (1+ cnt) liste) :span span) (nth (1+ cnt) liste)))))) collect liste))) (setf seq (if (equal all-gen t) seq (car (last seq)))) (if (equal output 'pitch) (integer-to-pitch seq) seq)))) ;;; EXAMPLES ;; SPAN influence -> span 2 (list-plot (gen-brownian-bridge 5 '(50 23) :span 2 :all-gen t) :zero-based t :point-radius 3 :join-points t) ;; SPAN influence -> span 10 (list-plot (gen-brownian-bridge 5 '(50 23) :span 20 :all-gen t) :zero-based t :point-radius 3 :join-points t) ;;; SPAN default (5) (list-plot (gen-brownian-bridge 5 '(50 23) :all-gen t) :zero-based t :point-radius 3 :join-points t) (list-plot (gen-brownian-bridge 5 '(50 23)) :zero-based t :point-radius 3 :join-points t) (gen-brownian-bridge 5 '(50 23) :all-gen t :output 'pitch) (gen-brownian-bridge 5 '(50 23) :output 'pitch) some sound-examples ;;; EXAMPLE with ALL GENS / seperated by rests (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 72) (instrument :omn (make-omn :pitch (setf n (gen-brownian-bridge 5 '(30 10) :all-gen t :output 'pitch)) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; EXAMPLE with LAST GEN -> rnd-evaluations => rnd-ways from a to b (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 72) (instrument :omn (make-omn :pitch (gen-brownian-bridge (car (rnd-number 1 2 7)) '(30 10) :output 'pitch) :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) two examples with different SPAN on MESSIEAN's mode5 mapped with <tonality-map> ;;; on MESSIAENS- mode5 - > 8 cycles + SPAN 10 => bigger intervals/steps (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch (setf n (tonality-map '(messiaen-mode5 :map step :root 'fs3) (integer-to-pitch (gen-brownian-bridge 8 '(10 27) :span 10 :all-gen t)))) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; on MESSIAENS- mode5 - > 8 cycles + SPAN 3 => smaller intervals/steps (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch (setf n (tonality-map '(messiaen-mode5 :map step :root 'fs3) (integer-to-pitch (gen-brownian-bridge 8 '(10 27) :span 3 :all-gen t)))) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano))
  9. a very simple, but useful little function... (defun gen-puls* (n tuplet period &key (stacc nil)) (gen-length (loop repeat n with period = (if (equal stacc t) (list 1 (neg! (1- period))) period) collect period) tuplet)) ;;; option: stacc or ord (gen-puls* 10 1/32 13) => (13/32 13/32 13/32 13/32 13/32 13/32 13/32 13/32 13/32 13/32) (gen-puls* 10 1/32 13 :stacc t) => (1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8 1/32 -3/8) (gen-puls* 10 1/28 9) => (9/28 9/28 9/28 9/28 9/28 9/28 9/28 9/28 9/28 9/28) (gen-puls* 10 1/28 9 :stacc t) => (1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14 1/28 -3/14) (gen-puls* 10 1/20 13 :stacc t) => (1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5 1/20 -3/5)
  10. like this (?)... ;;; mapping to MAJOR (setf sort-seq (integer-to-pitch (flatten (gen-sort (rnd-order (gen-integer 24)) :type 'selection)))) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (treble-layout 'seq)) (seq :omn (make-omn :pitch (setf n (tonality-map '(major :map step :root 'c4) sort-seq)) :length (gen-repeat (length (flatten n)) '(t))))) ;;; mapping to MESSIAEN-mode (setf sort-seq (integer-to-pitch (flatten (gen-sort (rnd-order (gen-integer 24)) :type 'insertion)))) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (treble-layout 'seq)) (seq :omn (make-omn :pitch (setf n (tonality-map '(messiaen-mode5 :map step :root 'c4) sort-seq)) :length (gen-repeat (length (flatten n)) '(t))))) ;;; mapping to a XENAKIS-SIEVE -> how can i do that with TONALITY-MAP? (but not necessary) (setf sieve (gen-sieve '((c4 g7) (c1 g7)) '((2 1 12) (3 5)) :type :pitch)) (setf sort-seq (flatten (gen-sort (rnd-order (gen-integer (length sieve))) :type 'insertion :sort '?))) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (treble-layout 'seq)) (seq :omn (make-omn :pitch (setf n (loop for i in sort-seq collect (nth i sieve))) :length (gen-repeat (length (flatten n)) '(t)))))
  11. thanks stephane! it seems that's the function i was looking for ... but not exaxtly... seems not to work "with integers larger then highest scale-pitch" (only in 1 octave?) (vector-map (expand-tonality '(c4 messiaen-mode5)) '(0 12 13 14 1 2 3 4 2 1 5 3 1)) => (c4 g4 b4 b4 c4 cs4 cs4 cs4 cs4 c4 f4 cs4 c4) with my function - the whole range possible, also with "mixed" toanlities (setf seq (flatten (gen-sort (rnd-order (gen-integer 24) :seed 49) :type 'selection))) (integer-to-tonality seq '(messiaen-mode4 messiaen-mode5 messiaen-mode6) :startpitch 'c4) => (fs5 c7 cs5 fs4 f4 cs4 f5 b6 cs7 as6 c5 c4 b5 gs4 d7 e6 b4 c6 f6 gs6 d4 fs6 d6 g4 g5 c4 c7 cs5 fs4 f4 cs4 f5 b6 cs7 as6 c5 fs5 b5 gs4 d7 e6 b4 c6 f6 gs6 d4 fs6 d6 g4 g5 c4 cs4 cs5 fs4 f4 c7 f5 b6 cs7 as6 c5 fs5 b5 gs4 d7 e6 b4 c6 f6 gs6 d4 fs6 d6 g4 g5 c4 cs4 d4 fs4 f4 c7 f5 b6 cs7 as6 c5 fs5 b5 gs4 d7 e6 b4 c6 f6 gs6 cs5 fs6 d6 g4 g5 c4 cs4 d4 f4 fs4 c7 f5 b6 cs7 as6 c5 fs5 b5 gs4 d7 e6 b4 c6 f6 gs6 cs5 fs6 d6 g4 g5 c4 cs4 d4 f4 fs4 g4 f5 b6 cs7 as6 c5 fs5 b5 gs4 d7 e6 b4 c6 f6 gs6 cs5 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b6 cs7 as6 c5 fs5 b5 f5 d7 e6 b4 c6 f6 gs6 cs5 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b4 cs7 as6 c5 fs5 b5 f5 d7 e6 b6 c6 f6 gs6 cs5 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 as6 cs7 fs5 b5 f5 d7 e6 b6 c6 f6 gs6 cs5 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 cs7 fs5 b5 f5 d7 e6 b6 c6 f6 gs6 as6 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 b5 cs7 d7 e6 b6 c6 f6 gs6 as6 fs6 d6 c7 g5 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 cs7 d7 e6 b6 c6 f6 gs6 as6 fs6 d6 c7 b5 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 d7 e6 b6 c6 f6 gs6 as6 fs6 d6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 e6 b6 d7 f6 gs6 as6 fs6 d6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 b6 d7 f6 gs6 as6 fs6 e6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 d7 f6 gs6 as6 fs6 b6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 f6 d7 gs6 as6 fs6 b6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 f6 fs6 gs6 as6 d7 b6 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 f6 fs6 gs6 as6 b6 d7 c7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 f6 fs6 gs6 as6 b6 c7 d7 cs7 c4 cs4 d4 f4 fs4 g4 gs4 b4 c5 cs5 f5 fs5 g5 b5 c6 d6 e6 f6 fs6 gs6 as6 b6 c7 cs7 d7)
  12. i coded a function now, that maps all integers to all TONALITIES, like i want it... SORTING OLIVIER's MODI and going crazy ;;; SUB (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))))))) ;;; MAIN (defun integer-to-tonality (seq tonality &key (startpitch 'c4)) (progn (if (not (pitchp (car tonality))) (setf tonality (multiple-expand-tonality :startpitch startpitch :octaves 8 :tonality tonality)) tonality) (loop for i in seq collect (nth i tonality)))) ;;;;;;;;;;;;; (setf seq (flatten (gen-sort (rnd-order (gen-integer 24) :seed 49) :type 'selection))) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (piano-solo-layout 'rhand 'lhand)) (rhand :omn (make-omn :pitch (integer-to-tonality seq '(messiaen-mode4 messiaen-mode5 messiaen-mode6) :startpitch 'c4) :length (gen-repeat (length seq) 't))) (lhand :omn (make-omn :pitch (integer-to-tonality (x+b seq 3) ; transp integer-seq '(messiaen-mode3 messiaen-mode1 messiaen-mode2) :startpitch 'c2) :length (gen-repeat (length seq) 't))))
  13. in LISP (loop for i in '(0 1 2 3 4 2 1 5 3 1) collect (nth i (expand-tonality '(c4 messiaen-mode5))))
  14. hi all, what is the OPMO-function to map an integer-seq like (11 22 9 4 3 1 10 21 23 20 8 0 13 6 24 16 7 14 17 19 2 18 15 5 12) to a scale -> 0 has to be lowest pitch of the scale etc... no problem to solve it via LISP-code, but what is the correct OPMO-function to map it on TONALITIES? thanx andré
  15. greetings andré p.s. it's the PITCH-version of "shift-length-proportions", i've worked with these things a long time ago... in COMMON MUSIC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; a function which transforms a pattern (each pitch linearly and independent) to another pattern ;;;; by interval "STEP" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUBFUNCTION (defun compare (start end &key (step 1)) (list (loop for i in start for j in end when (/= i j) collect (if (> i 0) (if (< i j) (+ i step) (- i step)) (if (> i j) (- i step) (+ i step))) else collect i) end)) ;;; MAIN (defun morph* (start end &key (step 1)) (progn (setf start (pitch-to-midi start) end (pitch-to-midi end)) (midi-to-pitch (append (list start) (loop until (equal start end) collect (setf start (car (compare start end :step step)))))))) (morph* (rnd-order '(c7 cs2)) '(e5 eb5)) => ((cs2 c7) (d2 b6) (eb2 bb6) (e2 a6) (f2 gs6) (fs2 g6) (g2 fs6) (gs2 f6) (a2 e6) (bb2 eb6) (b2 d6) (c3 cs6) (cs3 c6) (d3 b5) (eb3 bb5) (e3 a5) (f3 gs5) (fs3 g5) (g3 fs5) (gs3 f5) (a3 e5) (bb3 eb5) (b3 eb5) (c4 eb5) (cs4 eb5) (d4 eb5) (eb4 eb5) (e4 eb5) (f4 eb5) (fs4 eb5) (g4 eb5) (gs4 eb5) (a4 eb5) (bb4 eb5) (b4 eb5) (c5 eb5) (cs5 eb5) (d5 eb5) (eb5 eb5) (e5 eb5)) (morph* (rnd-order '(c4 cs4 d4 ds4)) '(e5 eb5 d5 cs5)) => ((c4 eb4 cs4 d4) (cs4 e4 d4 eb4) (d4 f4 eb4 e4) (eb4 fs4 e4 f4) (e4 g4 f4 fs4) (f4 gs4 fs4 g4) (fs4 a4 g4 gs4) (g4 bb4 gs4 a4) (gs4 b4 a4 bb4) (a4 c5 bb4 b4) (bb4 cs5 b4 c5) (b4 d5 c5 cs5) (c5 eb5 cs5 cs5) (cs5 eb5 d5 cs5) (d5 eb5 d5 cs5) (eb5 eb5 d5 cs5) (e5 eb5 d5 cs5)) (morph* (rnd-order '(c7 cs2 d4 ds6)) '(e5 eb5 d5 cs5)) => ((eb6 cs2 d4 c7) (d6 d2 eb4 b6) (cs6 eb2 e4 bb6) (c6 e2 f4 a6) (b5 f2 fs4 gs6) (bb5 fs2 g4 g6) (a5 g2 gs4 fs6) (gs5 gs2 a4 f6) (g5 a2 bb4 e6) (fs5 bb2 b4 eb6) (f5 b2 c5 d6) (e5 c3 cs5 cs6) (e5 cs3 d5 c6) (e5 d3 d5 b5) (e5 eb3 d5 bb5) (e5 e3 d5 a5) (e5 f3 d5 gs5) (e5 fs3 d5 g5) (e5 g3 d5 fs5) (e5 gs3 d5 f5) (e5 a3 d5 e5) (e5 bb3 d5 eb5) (e5 b3 d5 d5) (e5 c4 d5 cs5) (e5 cs4 d5 cs5) (e5 d4 d5 cs5) (e5 eb4 d5 cs5) (e5 e4 d5 cs5) (e5 f4 d5 cs5) (e5 fs4 d5 cs5) (e5 g4 d5 cs5) (e5 gs4 d5 cs5) (e5 a4 d5 cs5) (e5 bb4 d5 cs5) (e5 b4 d5 cs5) (e5 c5 d5 cs5) (e5 cs5 d5 cs5) (e5 d5 d5 cs5) (e5 eb5 d5 cs5)) added 2 minutes later think about: could be interesting when we could map it on a SCALE... so we should /could extract the STEPS between ... and map it on whatever!! this would make sense, beause it has not to be chromatic then, could be used on all "tonalities" or systems...
  16. okay, i see... and waht is the default? i think whole process (all steps) would be good
  17. shift-length-proportions a bit like gen-morph for LENGTHS. every item of a length-list will change linear till the endpattern is reached. ;;; subfunction (defun compare (start end &key (step 1/32)) (list (loop for i in start for j in end when (/= i j) collect (if (> i 0) (if (< i j) (+ i step) (- i step)) (if (> i j) (- i step) (+ i step))) else collect i) end)) ;;; mainfunction (defun shift-length-proportions (start end &key (step 1/32) (rnd-pick nil)) (let ((seq)) (progn (setf seq (progn (setf start (omn :length start) end (omn :length end)) (append (list start) (loop until (equal start end) collect (setf start (car (compare start end :step step))))))) (if (or (null rnd-pick) (equal rnd-pick 'all)) seq (rnd-sample rnd-pick seq))))) ;;; EXAMPLES (shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32) (shift-length-proportions '(1/16 1/16 1/16 1/16 1/16 -1/2) '(1/16 7/32 1/16 3/16 1/4 -1/2) :step 1/32) (shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32 :rnd-pick 3) (shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32 :rnd-pick 4) (shift-length-proportions '(e q h e.. s -h) '(q q q q q -h) :step 1/32 :rnd-pick 3)
  18. MIN/MAX-SORT a new function: min/max -> 1. max-pitch, 2. min-pitch, 3.rest of the seq .... starting next gen.... have a look at the list-plot. minmax-sort.opmo functions.opmo ;;; ordinary examples (make-omn :pitch (setf n (sorting (vector-to-pitch'(g4 eb5) (gen-white-noise 40)) :algorithm 'min/max)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (vector-to-pitch'(g4 eb5) (gen-white-noise 40)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (rnd-order '(g4 gs4 a4 bb4 b4 c5 cs5 d5 eb5 e5 f5 fs5)) :algorithm 'min/max)) :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (rnd-order '(g4 gs4 a4 bb4 b4 c5 cs5 d5 eb5 e5 f5 fs5)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e)))) ;;; combined with filter-tie -> ties all pitch repetitions!! (filter-tie (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))) (filter-tie (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))) ;;; THREE SCORES with min/max (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 120 :layout (piano-solo-layout 'rhand 'lhand)) (rhand :omn (make-omn :pitch (setf n (sorting (rnd-order '(g6 gs6 a6 bb6 b6 c7 cs7 d7 eb7 e7 f7 fs7)) :algorithm 'min/max :n '<)) :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e)))) :channel 1 :sound 'gm :program 0) (lhand :omn (make-omn :pitch (setf n (sorting (rnd-order '(g1 gs1 a1 bb1 b1 c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e)))) :channel 2)) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 120 :layout (piano-solo-layout 'rhand 'lhand)) (rhand :omn (filter-tie (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g6 gs6 a6 bb6 b6 c7 cs7 d7 eb7 e7 f7 fs7)) :algorithm 'min/max :n '<)) :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e))))) :channel 1 :sound 'gm :program 0) (lhand :omn (filter-tie (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g1 gs1 a1 bb1 b1 c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e))))) :channel 2)) (def-score example-score (:key-signature 'atonal :time-signature '(4 4) :tempo 120 :layout (piano-solo-layout 'rhand 'lhand)) (rhand :omn (filter-tie (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g6 gs6 a6 bb6 b6 c7 cs7)) :algorithm 'min/max :n '<)) :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e))))) :channel 1 :sound 'gm :program 0) (lhand :omn (filter-tie (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>)) :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e))))) :channel 2))
  19. you're welcome my favorites are: (make-omn :pitch (setf n (sorting (vector-to-pitch'(g3 bb5) (gen-white-noise 40)) :algorithm 'selection)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))) (make-omn :pitch (setf n (sorting (vector-to-pitch'(g3 bb5) (gen-white-noise 40)) :algorithm 'insertion)) :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))
  20. you could add if you like, but perhaps... CODE it better! and, perhaps it's possible for you to make it working with CHORDS? this sorting-thing could be also used (if you pick single generations) for producing "variants" of a motif - with more or less difference from/to an original. - i have some more plans - based on musical ideas - for SORTING functions. when it's coded i'll send it to you at "SOURCE CODE" - so you can have a look what is interesting for you. i'd like to work also a bit on MORPH-things (how to "morph" a gestalt into another).
  21. i solved the problems. here is a workspace/files to experiment with SORTING ALGORITHMS thanx to torsten and philippe! greetings andré functions.opmo abstract examples.opmo sound examples.opmo sorting algorithms.opmows
  22. for a musical research project where i work with the sorting processes of different sorting algorithms (bubble-sort, heap-sort ...), i have to program such algorithms myself. the ide is that not only the end result of the algorithm is visible but also the constant changes (the mechansim). here the first: bubble-sort. very simple and inelegant programmed - but the thing i need to have :-) bubble-sort: https://en.wikipedia.org/wiki/Bubble_sort have a look to different sorting algorithms: greetings andré ;;; bubble-sort -> with all GEN's to see the process of sorting ;;; end-test "until (equal (sort-asc alist) list)" very uncommon (and strange), ;;; but most simple-stupid test to check the end, only okay for this kind of idea ("watching the process not the endresult") (defun bubble-sort (seq) (let ((alist)) (progn (setf alist (cond ((pitchp (car seq)) (pitch-to-midi seq)) ((lengthp (car seq)) (omn :length seq)) (t seq))) (setf alist (loop until (equal (sort-asc alist) list) with list = alist append (loop for i from 0 to (- (length list) 2) for j from 1 to (- (length list) 1) when (> (nth i list) (nth j list)) collect (setf list (position-swap (list j i) list)) else do (setf list list)))) (cond ((pitchp (car seq)) (midi-to-pitch alist)) (t alist))))) (bubble-sort (rnd-order '(c5 e4 g3 b7))) (bubble-sort (rnd-order '(t s e q h w))) (bubble-sort '(1 6 334 2 6 4 111))
  23. great... but unfortunately, i'm looking for a whole range of different sorting algorithms - which are working by steps...
  24. thanks janusz, what kind of SORTING ALGORITHM is GEN-MORPH using? greetings andré p.s. here some different algorithms in LISP but without "generation-output" https://gist.github.com/llibra/2948765
  25. hm, but isn't it replacing (rnd), and not sorting? would like to code exactly something like this this: 15 Sorting Algorithms in 6 Minutes ...to SHOW the process of sorting algorithms....
×
×
  • Create New...

Important Information

Terms of Use Privacy Policy