AM

is it possible to do such a (nonsense-function) with mapcar (then with loop)? -> how should i handle the &key (y 1) with mapcar? possible? a function without &key is clear but with &key ....??? thanx for a note (defun testfu (value &key (y 1)) (* (random 10) value y)) (loop for i in '(1 2 3 4 5) for j in '(1 2 3 4 5) collect (testfu i :y j))

i'm interested to see YOUR code :-) greetings

you could work with omn-replace (from OM-library)? ...or some other code... have a look... greetings andré ;;; THREE SIMILAR FUNCTIONS FROM MY USER LIBRARY ;;; recognizes the parameter who has to be replaced (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 (or (pitchp (car replace-component)) (chordp (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)))) ;;; the same with multiple inputs at once (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)))))))) ;;; replaces a single element (defun omn-single-element-replace (omn-list old new) (let ((new-list (loop for i in (cond ((lengthp old) (omn :length (flatten omn-list))) ((pitchp old) (omn :pitch (flatten omn-list))) ((velocityp old) (omn :velocity (flatten omn-list))) ((articulationp old) (omn :articulation (flatten omn-list)))) when (equal i old) collect new else collect i))) (omn-component-replace (flatten omn-list) new-list))) ;;;;;;;;;;;;;;;;;; ;;; 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)) => (qs gs3 ppp tasto q.. cs4 pppp tasto s. f4 ppp tasto) (omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p) (ponte) (e2 b2 d2))) => (S E2 P PONTE Q.T B2 PONTE S D2 PONTE) (omn-single-element-replace '(t gs4 pppp tasto a4 tasto bb4 tasto -t) 'bb4 'c4) => (t gs4 pppp tasto a4 tasto c4 tasto -) (omn-single-element-replace '(t gs4 pppp tasto a4 tasto bb4 tasto -t) 'pppp 'ff) => (t gs4 ff tasto a4 tasto bb4 tasto -)

great... that's a smart solution :-) simpler then mine ...i didn't know how to set "-1" outside the FUNCTION without DEFSTRUCT thanx!! i like it when the program tells me that it has done the job... so i coded a little extension: (let ((i -1)) (defun next (liste &key (stop 'nil) (one-cycle 'nil)) (if (equal stop 't) (if (< i (1- (length liste))) (nth (mod (incf i) (length liste)) liste) (if (equal one-cycle 'nil) (progn (setf i -1) 'nil) 'nil)) (nth (mod (incf i) (length liste)) liste)))) (next '(a b c d e f)) (next '(a b c d e f) :stop t :one-cycle nil) ;; shows a NIL after last value, then starts again (next '(a b c d e f) :stop t :one-cycle t) ;; shwows only NILs after the last value

is there another way to code such a function/idea? this is (at the moment) a "theoretically function"... no concret use - l'art pour l'art :-) thanx for smarter LISP-code-IDEAS! andré ;;; evaluate PROGN (as a reset) (progn (defstruct counter n) (defvar cnt) (setf cnt (make-counter :n -1)) (defun read-list-in-steps (alist) (nth (setf (counter-n cnt) (1+ (counter-n cnt))) alist))) ;;; evaluate a view times, so one value after the other will be in the output ;;; you have to evaluate the progn-seq before every new start!!! (read-list-in-steps '(1 2 3 4 5 6)) (read-list-in-steps '(c4 f4 e4 f4 g5))

a "rnd-pick" that works with different "input-formats"... so it's flexible to use... for many (not all) input-cases ;;; subfunction (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))) ;;; mainfunction (defun rnd-pick* (alist) (if (and (listp (first alist)) (floatp (second (first alist)))) (weighted-random alist) (rnd-pick alist))) ;;; examples ;;; without weight (rnd-pick* '(1 2 3 4 5)) (rnd-pick* '((1 2 3 4) (3 4 5 7 3) (75 392 2))) ;;; with weight (rnd-pick* '((2 0.2) (3 0.4) (4 0.2))) (rnd-pick* '(((2 3 4 5) 0.2) ((8 796 5) 0.4))) (rnd-pick* '(((1 3) 0.2) (3 0.3)))

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