AM

code from another project, but should work in a similar way. take it, modify it, or code it properly :-) regards andré ;; gen-hoquetus.4 https://en.wikipedia.org/wiki/Hocket ;;; andré meier / 27-4-2016 ;;; write a instrumentation-list (instrument + techniques + velocity), pitch-list ;;; and length-list. the gen-hoquetus-function will split the melody ;;; off... in any possibilities, techniques/articulations/velocities will be added ;;; this is only a function i coded for my actual work... perhaps you could use ;;; it or code it properly :-) ;;; HAVE FUN! regards, andré (setq instrumentation '(((pno ponte ppp)) ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))) ;; subfunctions (defun generate-events.4 (durations pitches &key (velocity '(mf)) (articulation '(-)) (optional_data 'nil)) (loop repeat (length durations) with cnt-d = 0 with cnt-rest = 0 when (> (nth cnt-d durations) 0) collect (list (nth cnt-d durations) (nth cnt-rest pitches) (nth cnt-rest velocity) (nth cnt-rest articulation) (nth cnt-rest optional_data)) and do (incf cnt-rest) and do (incf cnt-d) else collect (list (nth cnt-d durations) 'nil 'nil 'nil 'nil) and do (incf cnt-d))) (generate-events.4 '(1 2 -3 4) '(60 61 62) :optional_data instrumentation) ;; (defun filtering-color.4 (selected-color event-stream) (loop for i in event-stream with match = 0 append (loop for x in (fifth i) when (equal (first x) selected-color) do (setq articulation (second x) velocity (third x)) and do (setq match 1)) when (and (= match 1) (> (first i) 0)) append (list (first i) (second i) velocity articulation) else collect (* -1 (abs (first i))) do (setq match 0))) (filtering-color.4 'vn (generate-events.4 (gen-length '(1 -100 2 3 4 5) 1/32) '(c4 d4 e4 e5) :optional_data instrumentation)) ;; mainfuction: (defun gen-hoquetus.4 (filtered-instrument &key pitch length instrument-list) (let ((events (generate-events.4 length pitch :optional_data instrument-list))) (filtering-color.4 filtered-instrument events))) (gen-hoquetus.4 'vn :pitch '(c4 d4 e5 f6) :length '(1/32 2/32 3/32 4/32) :instrument-list instrumentation) ;; OMN_EXAMPLE: (setq pitches (midi-to-pitch '(60 61 62 63 64 65 66 67 68 69 70))) ; only an example (setq lengths (gen-length '(1 2 3 -4 5 6 5 -4 3 -2 1) 1/16)) ; only an example (setq instrumentation (loop repeat 10 collect (rnd-pick '(((pno ponte ppp)) ; only an example ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))))) (def-score hoquetus.4 (:key-signature '(c maj) :time-signature '(4 4) :tempo '(120) :layout (bracket-group (trumpet-layout 'trumpet) (piano-grand-layout 'piano) (violin-layout 'violin) (viola-layout 'viola) (violoncello-layout 'violoncello))) (trumpet :omn (gen-hoquetus.4 'trp :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (piano :omn (gen-hoquetus.4 'pno :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violin :omn (gen-hoquetus.4 'vn :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (viola :omn (gen-hoquetus.4 'va :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violoncello :omn (gen-hoquetus.4 'vc :pitch pitches :length lengths :instrument-list instrumentation) :channel 1))

should work... (defun get-root-intervals (pitches) (integer-to-interval (sort-asc (pitch-to-integer (ambitus-octaves 'c4 1 pitches))))) (get-root-intervals '(g1 c9 e6)) (get-root-intervals '(f3 d4 a4)) interested to see your work :-) greetings andré

here is a version with MULTIPLE replacements... you have to write replacements different... a list in a list... have a look to the examples: (defun omn-component-replace2 (omn-sequence replace-component) (car (last (loop for i in replace-component collect (setf omn-sequence (make-omn :length (if (lengthp (car i)) (append i) (omn :length omn-sequence)) :pitch (if (pitchp (car i)) (append i) (omn :pitch omn-sequence)) :velocity (if (velocityp (car i)) (append i) (omn :velocity omn-sequence)) :articulation (if (articulationp (car i)) (append i) (omn :articulation omn-sequence)))))))) (omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p))) (omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p) (ponte) (e2 b2 d2)))

hi stephane i think it works fine, feel free to use & optimize it ( perhaps to replace more then ONE parameter in ONE function-call?)... for me the function is very useful... greetings andré (defun omn-component-replace (omn-sequence replace-component) (make-omn :length (if (lengthp (car replace-component)) (append replace-component) (omn :length omn-sequence)) :pitch (if (pitchp (car replace-component)) (append replace-component) (omn :pitch omn-sequence)) :velocity (if (velocityp (car replace-component)) (append replace-component) (omn :velocity omn-sequence)) :articulation (if (articulationp (car replace-component)) (append replace-component) (omn :articulation omn-sequence)))) examples: (setf seq1 '(s gs3 ppp tasto q.t cs4 pppp tasto s f4 ppp tasto)) (omn-component-replace seq1 '(5/16 7/16 3/32)) (omn-component-replace seq1 '(ponte)) (omn-component-replace seq1 '(c4 d4 e4 f4))

version in (almost) pure lisp (only "midi-to-pitch" is OM) (defun gen-sieve-userdefined (ambitus.midi intervals) (midi-to-pitch (loop 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-userdefined '(12 72) '(4 2 3))

(gen-sieve '(c0 c9) (pitch-to-interval '(c4 e4 g4 bb4 c5)) :type :pitch) (gen-sieve (midi-to-pitch '(12 127)) (pitch-to-interval '(c4 e4 g4 bb4 c5)) :type :pitch) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; putted in a little function ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-sequence (pitch-sequence midi-ambitus) (gen-sieve (midi-to-pitch midi-ambitus) (pitch-to-interval pitch-sequence) :type :pitch)) ;; eval (gen-sequence '(c4 e4 g4 bb4 c5) '(12 127)) ;; => (c0 e0 g0 bb0 c1 e1 g1 bb1 c2 e2 g2 bb2 c3 e3 g3 bb3 c4 e4 g4 bb4 c5 e5 g5 bb5 c6 e6 g6 bb6 c7 e7 g7 bb7 c8 e8 g8 bb8 c9 e9 g9)

most of the time i'm working with pure LISP (pitches in midi-note-numbers -> then (midi-to-pitch ...) to create omn-pitches) after LISP-coding (generating lists for pitches/lengths/...) i'm converting to OMN-format by (make-omn :pitches :length etc...)...

ALL-VARIANTS2 ********************** "extended version" -> if you want to have pairs of rest/length or if EVERY value could be changed (defun all-variants2 (seq &key (length/rest 'nil)) (let ((all-basic-binary-combinations) (binary-seq-completed)) ;;;decides if should work with pairs of length/rests (if (equal length/rest 't) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) (progn (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0))))) ;;;EVERY val will be switched (setf binary-seq-completed (loop for i from 0 to (binary-to-decimal (loop repeat (length seq) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (length seq) (length val)) collect 0) val)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value)))) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 't) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 'nil)

(progn ;; your list with EVEN-length!!! (necessary for length/rest-structure) -> starting with all values as rests (setf seq '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8)) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => the number of your ON/OFF-vals (switching values, not the rests!) (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) ;; necessary "to fill" the seq-length val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value))) ...is perhaps a way to get the output? ...evaluate... ...or press CMD2 -> so you see the rhythm-structure... ...in this version the gen-structure is based on the "BINARY-incf", if you want a RND-version, just "RND-ORDER" the list... packed in a function: (defun all-variants (seq) (let ((all-basic-binary-combinations) (binary-seq-completed)) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value)))) (all-variants '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8))

sorry, but i don't understand what you are looking for... you want to pick all elements > 0? or change rests into lengths and lengths into rests? like a kind of a filter?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; LENGTH-REST-RATIO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; to TEST in a OMN- or LENGTH-sequence (defun length-rest-ratio (seq) (let ((liste (omn :length seq))) (loop for i in liste when (< i 0) sum (abs i) into -bag when (> i 0) sum i into +bag finally (return (ratio-to-float (* +bag (/ 1 (+ +bag -bag)))))))) (length-rest-ratio '(e. q. -q)) (length-rest-ratio '(-2 3 4 -1 -1)) (length-rest-ratio '(e. c4 ppp -q. q d3 e3 f3)) ;;; evaluate this test a few times (if (> (length-rest-ratio (rnd-repeat 10 '(1 2 3 4 -1 -2 -3 -4))) 0.5) (append 'more-lengths) (append 'more-rests))

i'll send it to you

when i import/open a XML (produced by OM) in SIBELIUS, i am missing the "SNAP-symbol" (bartok-pizz) -> where is it gone? thanx for help andré

does "seed" works also on the basic LISP random-function? or on OM only? thanx

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; i needed a function who changes randomly lengths to rests ;;; step by step, and modify (enlarge) its rest-values over x-generations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun modify-lengths-to-rests (liste &key (items 1) (step -1) (factor 2) (enlarge-type 'add)) (let ((liste (loop for j in liste when (< j 0) collect (cond ((equal enlarge-type 'add) (+ step j)) ((equal enlarge-type 'augmented) (* factor j))) else collect j))) (loop for i in liste with repl = (rnd-pick (remove 0 liste :test #'>)) with cnt = 0 when (and (equal i repl) (< cnt items)) collect (* -1 (abs repl)) and do (incf cnt) else collect i))) ;;;; examples-1 -> ONE generation ;;;; evaluate a few times to see how it works (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) :items 1 :enlarge-type 'add) ;enlarge only values < 0 (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) :items 2 :enlarge-type 'add) ;enlarge only values < 0 (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) :items 3 :enlarge-type 'add) ;enlarge only values < 0 ;;;; examples-2 ;;;; recursiv - with x-generations (loop repeat 10 with seq = '(1 2 3 4 4 4 5 6 7) collect (setf seq (modify-lengths-to-rests seq :items 1 :enlarge-type 'augmented))) (loop repeat 10 with seq = '(1 2 3 4 4 4 5 6 7) collect (setf seq (modify-lengths-to-rests seq :items 1 :enlarge-type 'add)))

i needed something like that.. regards andré (defun rnd-replace/user (item sequence &key (exclude 'nil)) (loop for i in sequence with val with pos = (position (car (loop do (setf val (nth (random (length sequence)) sequence)) when (null (member val exclude)) collect val into bag when (= (length bag) 1) do (return bag))) sequence) for cnt = 0 then (incf cnt) when (= cnt pos) collect (rnd-pick item) else collect i)) (rnd-replace/user '(123 987) '(1 2 3 4 5) :exclude '(1 5))

okay, i see... i will modify it for myself thanx!

works fine: (rnd-replace '(123) '(1 2 3 4)) => (1 2 3 123) don't work ... why? (rnd-replace '(123) '(1 2 3 4) :exclude '(2 3)) => > Error: The value 1 is not of the expected type list. > While executing: pos-rep, in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options.

don't know if this already exists in the library ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; chord-multiplication like boulez ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun chord-multiplication (chord1 chord2 &key (chord 'nil)) (let ((liste (sort-asc (remove-duplicates (loop for i in chord1 append (pitch-transpose-start i chord2)))))) (if (equal chord 't) (chordize liste) (append liste)))) (defun all-chord-multiplications (liste &key (chord 'nil)) (let ((liste (loop for i in (combination 2 liste) collect (chord-multiplication (first i) (second i))))) (if (equal chord 't) (chordize liste) (append liste)))) ;;; EXAMPLES ;;; with 2 chords (chord-multiplication '(eb4 a4 d5) '(ab4 g5) :chord 't) ;;; all possible multiplications (combinations of 2) in a diveded list (setf divided-list '((eb4 a4 d5) (ab4 g5) (e4 gs4 db4) (b3 f4 bb4 c5))) (all-chord-multiplications divided-list :chord 't) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; A WAY TO MUTATE/MODIFY A PROPORTION-LIST FOR "gen-length-constant" ;;;; the SUM in all generations is CONSTANT ;;;; FUNCTION (defun modify-prop-seq (generations values &key (value-step 1) (chance 1.0)) (append (list values) (loop repeat (- generations 1) with rnd-seq with new-seq do (if (prob? chance) (setq rnd-seq (rnd-sample-seq 2 values) new-seq (list (+ (car rnd-seq) value-step) (- (car (rest rnd-seq)) value-step)) values (loop for i in (pattern-map (list (append (list rnd-seq) (list new-seq))) values) when (> i 0) collect i)) (append values)) collect values))) ;;;; tests (modify-prop-seq 5 '(1 2 3 4 5 6 7 8 9)) (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.9) (modify-prop-seq 5 '(4 4 4 4 4) :value-step 1 :chance 0.5) ;;;; practical-use -> every generation in 1 bar (loop for i in (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.8) collect (gen-length-constant i '4/4)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; function (-> don't know if this is already existing in opusmodus) (defun expand-intervals/integers (seq &key (type 'add) (value 1)) (cond ((equal type 'add) (loop for i in seq when (> i 0) collect (+ i value) when (< i 0) collect (- i value) when (= i 0) collect i)) ((equal type 'multiply) (loop for i in seq collect (* i value))) ((equal type 'expt) (loop for i in seq when (>= i 0) collect (expt i value) else collect (* (expt i value) -1))) ((equal type 'fibonacci) (loop for i in seq when (>= i 0) collect (+ i (fibonacci i)) else collect (- i (fibonacci (abs i))))))) ;;; examples (expand-intervals/integers '(0 -1 1 -2 2 -3 3) :type 'add :value 2) (expand-intervals/integers '(0 -1 1 -2 2 -3 3) :type 'multiply :value 2) (expand-intervals/integers '(0 -1 1 -2 2 -3 3) :type 'expt :value 2) (expand-intervals/integers '(0 -1 1 -2 2 -3 3 -4 4 -5 5) :type 'fibonacci)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;PERMUTE-SYMMETRCIAL -> seq of any lengths;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUB (defun divide-seq-length (seq) (if (evenp (length seq)) (/ (length seq) 2) (/ (1- (length seq)) 2))) ;;; MAIN (defun permute-symmetrical (row &key (chance 0.5)) (let ((1st (loop repeat (divide-seq-length row) for cnt = 0 then (incf cnt) collect (nth cnt row))) (2nd (loop repeat (divide-seq-length row) for cnt = (- (length row) 1) then (decf cnt) collect (nth cnt row)))) (loop for i in 1st for j in 2nd when (prob? chance) collect j into 1st-bag and collect i into 2nd-bag else collect i into 1st-bag and collect j into 2nd-bag when (= (length 1st-bag) (divide-seq-length row)) do (return (if (evenp (length row)) (append 1st-bag (reverse 2nd-bag)) (append 1st-bag (list (nth (length 1st) row)) (reverse 2nd-bag))))))) ;;; EXAMPLE (pitch-list-plot (permute-symmetrical '(a4 bb4 ab4 b4 g4 c5 fs4 cs4 f4 d4 e4 eb4) ;zimmermann-row :chance 0.3))

thanx! ... i searched for something like "chord-..." :-) a.

short question. i'm looking for the function who splits 'c4d4e4 into '(c4 d4 e4)... don't find that thanks for a quick help :-) a.

for further ideas: i think it's a good solution to work with "structures" = "datasets" and a "machine" who generates output based on these datas. ... your "machine" will pick its rules/datas... from there, so you have good possibilties to work with more then one dataset, and give also a feedback on this sets (such a dataset is like a "GENOM", and the machine produces its outputs based on this "GENOM" but also influences it = feeback)... an dataset-example from my current project... ;;; defines a structure called CHORDSET (defstruct chordset name interval-seq interval-direction startpitch durations rhy velocity cresc-dim seq-length rotate-dynmics sampling-types form-types data1) ;;; VARIABLE CHORD1 will be "filled" with datas in this structure -> see "make-chordset" (setf chord1 (make-chordset :name 'chord1 :interval-seq '(3 5 3 3 5 3 3 5 3 3) :interval-direction '((up 0.5) (down 0.5)) :startpitch '(c4 gs4) :durations '1 :rhy '((1/32 0.4) (1/20 0.4) (1/12 0.2)) :velocity (weighted-random '(((pppp ppp pp p mp mf mp p pp ppp pppp) 0.5) ((p p p mp mp mf mp mp p p p) 0.5))) :cresc-dim '(pppp p) :seq-length '((3 0.3) (5 0.3) (7 0.1) (11 0.3)) :form-types '(crippled asymmetric symmetric broken) :sampling-types '(rnd from-center))) ;;; every data could be read by (for example) (chordset-startpitch chord1) => (c4 gs4) ;;; or could be rewritten by (setf (chordset-startpitch chord1) 'c3) ;;; then: (chordset-startpitch chord1) => c3 => the machine reads this self-definied datas and generating output (like YOUR program) => an perhaps when some patterns are recognized (in the production-process) there could be an influence on the dataset -> rewrite the dataset => that's a way to control and design such recursiv-production-systems, but there are also many other ways... i hope that helps you - and i hope i did not misunderstand your ideas/code... regards andré