AM

not the same number of pitches/rhythms, like phase-shifted

;;; SWAPS THE POSITIONS SYMMETRICALLY AND RANDOMIZED ;;; n => number of generations, output: last gen or all gens... ;;; new-version works also for symmetrical-sequences! (special cas) (defun rnd-symmetrical-position-swap (n liste &key (out 'all)) (let ((n1) (n2)) (progn (setf liste (loop repeat n do (setf n1 (random (1- (list-length-divide liste))) n2 (random (1- (list-length-divide liste)))) collect (progn (setf liste (position-swap (list (list n1 n2) (list (- (1- (length liste)) n1) (- (1- (length liste)) n2))) liste))))) (cond ((equal out 'last) (car (last liste))) ((equal out 'all) (append liste)))))) (rnd-symmetrical-position-swap 2 '(1 2 3 4 3 2 1) :out 'last) (rnd-symmetrical-position-swap 5 '(1 2 3 4 5 6) :out 'last) (rnd-symmetrical-position-swap 2 '(a b c d e f g h) :out 'all)

;;; ----------------------------------------------------------------------------------------------- ;;; A QUASI-UNISONO by proportional length-differences ;;; SAME PITCHES IN ALL VOICES INCLUDING START/END-PITCH ;;; ----------------------------------------------------------------------------------------------- ;;; a random-pitch-seq (rnd-walk) ;;; ;;; immediate-pitch-repetitions are building the rhythm ;;; ;;; with MODIFY-PROPORTIONS i'm generating "proportional variants" of this rhythm, in this example ;;; by 16 generations -> then i take the generations 1, 8, and 15 for each voice ;;; ;;; by "(filter-repeat 1 sequence)" i swallow the immediate-pitch-repetitions for correct ;;; of PITCH- and RHYTHM-phases ;;; ;;; ----------------------------------------------------------------------------------------------- ;;; FUNCTION (defun modify-proportions (n prop-list &key (style 'sharpen)) (let ((rest-pos (loop for i in prop-list for cnt = 0 then (incf cnt) when (< i 0) collect cnt)) (prop-list (abs! prop-list)) (liste)) (progn (setf liste (append (list prop-list) (loop repeat n when (or (= (length (find-above 1 prop-list)) 1) (= (length (find-unique prop-list)) 1)) collect prop-list else collect (setf prop-list (loop for i in prop-list for cnt = 0 then (incf cnt) collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list)) (if (equal style 'sharpen) (1- i) (1+ i))) ((= cnt (position (find-max prop-list) prop-list)) (if (equal style 'sharpen) (1+ i) (1- i))) (t i))))))) (loop for i in liste collect (loop for k in i for cnt = 0 then (incf cnt) when (memberp cnt rest-pos) collect (* -1 k) else collect k))))) ;;; ----------------------------------------------------------------------------------------------- ;;; GENERATING SCORE (setf sequence (gen-walk 100 :step '(0 0 0 0 0 0 0 1 2) :start 'c5)) (setf rhy 1/32) ;;; ----------------------------------------------------------------------------------------------- (def-score quasi-unisono (:title "quasi-unisono" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instr1 :omn (make-omn :length (gen-length (nth 1 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 1 :port 0 :sound 'gm) (instr2 :omn (make-omn :length (gen-length (nth 8 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 2 :port 0 :sound 'gm) (instr3 :omn (make-omn :length (gen-length (nth 15 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 3 :port 0 :sound 'gm)) there is no BUG when i work without "omn-to-time-signature", but is also not necessary!

... in the future... do exist such a function in OM...? greetings andré

thanx! you are fast :-)

perfect! i thought it was something like that - it seems that it's strange with "every TIE" in such a combination... also with: (5q 5q 5h._3q -3q 3q_5h. 5q 5q) (t t e._5q -5h. 5q_e. t t) etc... thanks! a.

when i put these lists into MAKE-OMN, i get strange rhy-values, because MAKE-OMN "organizes" the TIED-values different... why? (make-omn :length '(3q 3q 3q_t -e. t_3q 3q 3q) :pitch '(a5 f5 b4 ds5 a4 f4)) have a look how the rhythm-notation changed (3q a5 f5 s_t_3s b4 -e. s_t_3s ds5 3q a4 f4) thanks a.

;;; ---------------------------------------------------------------- ;;; modifying proprtions by add/sub of the smallest/largest values ;;; number of elements is constant / sum of the seq also constant ;;; n => number of generations ;;; prop-list => integers ;;; :style => sharpen or flatten ;;; ---------------------------------------------------------------- (defun modify-proportions (n prop-list &key (style 'sharpen)) (let ((rest-pos (loop for i in prop-list for cnt = 0 then (incf cnt) when (< i 0) collect cnt)) (prop-list (abs! prop-list)) (liste)) (progn (setf liste (append (list prop-list) (loop repeat n when (or (= (length (find-above 1 prop-list)) 1) (= (length (find-unique prop-list)) 1)) collect prop-list else collect (setf prop-list (loop for i in prop-list for cnt = 0 then (incf cnt) collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list)) (if (equal style 'sharpen) (1- i) (1+ i))) ((= cnt (position (find-max prop-list) prop-list)) (if (equal style 'sharpen) (1+ i) (1- i))) (t i))))))) (loop for i in liste collect (loop for k in i for cnt = 0 then (incf cnt) when (memberp cnt rest-pos) collect (* -1 k) else collect k))))) ;;; examples (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'sharpen) (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'flatten) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'sharpen) 1/16) '(4 4)) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'flatten) 1/16) '(4 4)) (list-plot (modify-proportions 10 '(5 3 2 -7 1 8 2)) :point-radius 0 :style :fill) ...works not in all CASES (when :style 'flatten), but okay...

;;; GETTING THE LENGTH-PROPORTIONS AS INTEGERS (defun get-proportions (omn_seq &key (abs 'nil)) (let ((denoms)) (progn (setf denoms (remove-duplicates (loop for i in (omn :length omn_seq) collect (denominator (abs i))))) (loop for i in (omn :length omn_seq) collect (if (equal abs 't) (* (abs i) (apply 'lcm denoms)) (* i (apply 'lcm denoms))))))) ;; examples (get-proportions '(-3q 3h_h. d3 mf)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q) :abs t) (get-proportions '(-e -t t t t t t t t t -s. -q)) ;;; HOW TO USE (setf rhy '(-3h 3q_5h. 5q 5q c4)) (setf props (get-proportions rhy :abs nil)) ;;; you can use that for GEN-LENGTH-CONSTANT ;; ordinary (gen-length-constant props 'w.) ;; a bit advanced (gen-length-constant props 'h.) ;; crazy (gen-length-constant props 'h._e)

i see 4 possibilities... 1) you could work in generations => only 1 match per gen => but it could end in a stack overflow (when it's recursiv, when match is also inside the insert) 2) could overwrite in generations from last to first match -> means right to left in the list (but not with matches inside the insert) => so when it's more then one match it will be overlapping 3) could generate overlaying voices by few matches 4) you could limited it by &key :nooverlapping 't added 4 minutes later if it will work, i wll code a nice example for OM to present it

sorry but with this code - evaluating all i have... only for THIS input-seq ... you input-seq seems different (setf seq '(e c4 -e -q q d4 -q s c4 -e. -h. q)) (setf insert '(3q c4 d4 e4 c4 d4 e4 c4 d4 -3q)) (setf insert-span (loop for i in (omn :length insert) sum (abs i))) (progn (setf new-list (loop for i in (single-events seq) with match = 0 when (pattern-matchp i '(q d4 ?)) do (setf match 1) when (= match 1) collect (abs (car (omn :length i))) into bag when (and (= match 1) (<= (sum bag) insert-span)) collect (* -1 (abs (car (omn :length i)))) else collect i )) (flatten (loop for x in new-list with match = 0 when (and (atom x) (= match 0)) collect insert and do (setf match 1) when (listp x) collect x))) => (e c4 mf -e -q 3q c4 d4 e4 c4 d4 e4 c4 d4 -3q -h. q c4 mf)

i think it has to works in GENERATIONS added 2 minutes later my result is.... with my code is... (no sublists) (e c4 mf -e -q 3q c4 d4 e4 c4 d4 e4 c4 d4 -3q -h. q c4 mf)

last list is THE END of the original seq! last quarternote (which is not overwrited by the insert)

an example:

sorry, but this would be easy (for beginners ) ...but that's not correct because it is INSERTRED and not OVERWRITED... there is NO function in OM that's doing this. greetings from "helmut" ...because if you want work with "strukturnetze" you have to keep the NET correct and not to shift the time values (how it is with pattern-map)... so you have to overwrite

dear all i'll try to code a function that overwrites the SEQ with an insert after a pattern-match... not so simple, because to calculate all the length-values in the SEQ so that there ist no "shifting" ist very.... here an easy sketch... but with a simple, so that i haven't got to calculate (beacuse all is mapped on quaternotes)... i hope anyone could CODE that... would be an interesting FUNCTION!!! using things as a NET!! compare -> seq with the function output... the you see the idea (setf seq '(e c4 -e -q q d4 -q s c4 -e. -h. q)) (setf insert '(3q c4 d4 e4 c4 d4 e4 c4 d4 -3q)) (setf insert-span (loop for i in (omn :length insert) sum (abs i))) (progn (setf new-list (loop for i in (single-events seq) with match = 0 when (pattern-matchp i '(q d4 ?)) do (setf match 1) when (= match 1) collect (abs (car (omn :length i))) into bag when (and (= match 1) (<= (sum bag) insert-span)) collect (* -1 (abs (car (omn :length i)))) else collect i )) (flatten (loop for x in new-list with match = 0 when (and (atom x) (= match 0)) collect insert and do (setf match 1) when (listp x) collect x)))

thanx... but seems to be more complicated... i'll try to code/sketch a solution

a question: in a pattern match i would like to overwrite the existing OMN sequence. that means that for the duration of the insert the original OMN-sequence is not pushed backwards. As I see it now, the OMN-values are only inserted and do not overwrite the sequence, (and not rhythmically "compensating") ... ? would be very nice! ...or i have to code it for myself an example: ;; basic omn-seq '(e c4 -e -q q c4 -q s c4 -e. q) ;; insert '(3q c4 d4 e4 c4 d4 e4 c4 d4) ;; pattern-match on (q c4) ;; result should be '(e c4 -e -q 3q c4 d4 e4 c4 d4 e4 c4 d4 -3q q c4)

i work in another way... the tools has to follow the ideas and not my ideas are "what the tools can do" ;-)

release? - would be important for next projects, and many other users :-)

... i think sometimes i'm faster when i code it for myself then to search in the library :-)

edited now :-)

...an idea to manipulate lists of pitches/rhythms by "sampling" ;;; subfunction (defun sampling-list (liste start-position seq-length) (loop repeat seq-length for cnt = start-position then (incf cnt) when (= cnt (length liste)) do (setf cnt 0) collect (nth cnt liste))) ;;; MAIN: ;;; an value-list will be sampled by start-pos-list in the length of seq-length-list (defun structural-interferences (n value-list start-pos-list seq-length-list) (let ((start-pos-list (remove (length value-list) start-pos-list :test #'<))) (loop repeat n for start-pos = 0 then (incf start-pos) for seq-length = 0 then (incf seq-length) when (= start-pos (length start-pos-list)) do (setf start-pos 1) when (= seq-length (length seq-length-list)) do (setf seq-length 0) append (sampling-list value-list (nth start-pos start-pos-list) (nth seq-length seq-length-list))))) ;;something (list-plot (structural-interferences 21 '(1 2 3 4 5) '(0 1 2 3 4 5 6 7 8 9) '(1 3 2 4 1 2 2 3 1 1 1 1)) :point-radius 1 :style :fill) ;;"self-similar" (list-plot (structural-interferences 21 '(3 2 1 5 4 2) '(2 1 0 4 3 1) '(3 2 1 5 4 2)) :point-radius 1 :style :fill)

how is it currently with the support of microtonality (omn & xml-display)? thanks for some informations andré

if you want to change VELOCITY of a technique... (defun replace-velocity-of-a-technique (omn-list &key technique velocity) (flatten (loop for i in (single-events omn-list) when (equal (car (omn :articulation i)) technique) collect (pattern-map (list (list (list '? technique) (list velocity technique))) i) else collect i))) (replace-velocity-of-a-technique '(e. c4 p tasto d4 ponte e4) :technique 'tasto :velocity 'f)