AM

some extensions to the basic function... greetings andré ;;; SUB (defun rnd-pick* (alist) (if (and (listp (first alist)) (floatp (second (first alist)))) (weighted-random alist) (rnd-pick alist))) (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))) ;;; MAIN (defun gen-symmetrical* (n list &key (type 'nil)) (if (equal type 'hierarchic) (progn (let ((alist (butlast list)) (center (last list))) (if (> n (* 2 (length list))) 'list-has-too-few-items (if (evenp n) (progn (setf alist (loop repeat (/ n 2) for i in alist collect (rnd-pick* i))) (append alist (reverse alist))) (progn (setf alist (loop repeat (/ (1- n) 2) for i in alist collect (rnd-pick* i))) (append alist (list (rnd-pick* (flatten center))) (reverse alist))))))) (progn (let ((list (rnd-order list)) (newlist (rest list)) (center (car list))) (if (> n (* 2 (length list))) 'list-has-too-few-items (if (evenp n) (progn (setf list (rnd-unique (/ n 2) newlist)) (append list (reverse list))) (progn (setf list (rnd-unique (/ (1- n) 2) (rest newlist))) (append list (list center) (reverse list))))))))) ;;ordinario (gen-symmetrical* 5 '(1 2 3 4 5 6 7 8)) ;;unmittelbare wiederholungen möglich (gen-symmetrical* 9 '(1 2 3 4 5 6 7 8) :repeat t) ;;werte kommen nur doppelt vor durch die symmetrie- ;;bildung, aber nicht auf einer der symmetrieseiten. (gen-symmetrical* 9 '(1 2 3 4 5 6 7 8) :style 'unique) (gen-symmetrical* 30 '(1 2 3 4 5 6 7 8) :style 'unique) ;;=> list-has-too-few-items ;;bei ":type 'hierarchic" wird immer zuerst aus der ;;ersten sublist ausgewählt, dann aus der zweiten etc... (gen-symmetrical* 6 '((a b c) (6 7) (8 9) (10 11)) :style 'unique :type 'hierarchic) ;;auch mit weight möglich (gen-symmetrical* 5 '(((1 0.2) (2 0.8)) ((4 0.1) (5 0.9)) (6 7) (8 9) (10 11)) :style 'unique :type 'hierarchic)

could be interesting for you... an really extend gen-stacc-function greetings andré ;;; SUB (defun center-position-in-list (list &key (get-value 'nil)) (let ((pos)) (progn (setf pos (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (if (equal get-value 'nil) (append pos) (nth (1- pos) list))))) ;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value nil) ;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value t) (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/2) '(3 4 5 3 2 1) :stacc-chance 0.5) ;(gen-stacc3 '(1/32 3/32) '(3/32 5/32 14/8) :stacc-chance 0.5) ;;; MAIN (defun gen-stacc* (liste &key (symmetrical 'nil) (stacc-chance 1) (possible-stacc-lengths 'nil) (no-center-stacc 'nil)) (let ((alist liste) (blist) (val) (n (/ 1 (find-max (mapcar 'denominator liste))))) (if (equal symmetrical 'nil) ;;bei unsymmetrischen strukturen (gen-stacc3 (if (equal possible-stacc-lengths 'nil) (list n) possible-stacc-lengths) liste :stacc-chance stacc-chance) ;;bei symmetrischen strukturen (if (evenp (length liste)) (progn (setf alist (gen-stacc3 (if (equal possible-stacc-lengths 'nil) (list n) possible-stacc-lengths) (filter-first (/ (length liste) 2) liste) :stacc-chance stacc-chance)) (setf blist (flatten (loop for i in (reverse (gen-divide 2 alist)) collect (reverse i)))) (append alist blist)) (progn (setf alist (gen-stacc3 (if (equal possible-stacc-lengths 'nil) (list n) possible-stacc-lengths) (filter-first (/ (1- (length liste)) 2) liste) :stacc-chance stacc-chance)) (setf blist (flatten (loop for i in (reverse (gen-divide 2 alist)) collect (reverse i)))) (append alist (if (equal no-center-stacc 't) (list (center-position-in-list liste :get-value t)) (progn (setf val (/ (center-position-in-list liste :get-value t) 3)) (list (* -1 val) val (* -1 val)))) blist)))))) ;; ordinario (gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/20)) ;; vorgebener stacc-wert (gen-stacc* '(4 5 6 3 6 5 4) :possible-stacc-lengths '(1/4)) ;; wählt rnd die längen der stacc-values (gen-stacc* '(4 5 6 3 6 5 4) :possible-stacc-lengths '(2/32 1/32 5/32 1/4)) ;; rnd-stacc (gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/32) :stacc-chance 0.4) ;; rnd-stacc mit verschiedenen möglichen stacc-lengths (gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/32) :stacc-chance 0.7 :possible-stacc-lengths '(2/32 1/32)) ;; symm-strukturen werden berücksichtigt (gen-stacc* (gen-length '(4 5 6 7 6 5 4) 1/32) :symmetrical t :no-center-stacc t) ;; ohne stacc bei center-value (gen-stacc* (gen-length '(4 5 6 7 6 5 4) 1/32) :symmetrical t :no-center-stacc t)

;;; alternative function for GEN-SYMMETRICAL: in combination ;;; with FIND-UNIQUE => symmetries with unique items (except ;;; what is generated by symmetry) (defun gen-symmetrical* (n list) (let ((list (rnd-order list)) (newlist (rest list)) (center (car list))) (if (> n (* 2 (length list))) 'list-has-too-few-items (if (evenp n) (progn (setf list (rnd-unique (/ n 2) newlist)) (append list (reverse list))) (progn (setf list (rnd-unique (/ (1- n) 2) (rest newlist))) (append list (list center) (reverse list))))))) (gen-symmetrical* 5 '(1 2 3 4 5 6 7 8)) (gen-symmetrical* 9 '(1 2 3 4 5 6 7 8)) (gen-symmetrical* 30 '(1 2 3 4 5 6 7 8)) => list-has-too-few-items ; error-message

you are right, but it is okay for my use - if someone wants to make it smarter, it is very welcome - but I have to do some other things :-)

;;; CODE (defun shift-proportions (integer-seq shift &key (type 'primes)) (let ((number-seq)) (progn (setf number-seq (cond ((equal type 'primes) (primes 30)) ((equal type 'fibonacci) (fibonacci 1 20)) ((equal type 'decimal) (gen-integer-step 1 200 1)))) (setf number-seq (append (reverse (neg! number-seq)) number-seq)) (loop for i in integer-seq when (> i 0) collect (nth (+ (car (position-item i number-seq)) shift) number-seq) else collect (nth (- (car (position-item i number-seq)) shift) number-seq))))) ;;; EXAMPLE => the integer-seq must include only values from ":type"-system (shift-proportions '(1 2 3 4 5 -3 2 -1 3 -8) 1 :type 'decimal) => (2 3 4 5 6 -4 3 -2 4 -9) (shift-proportions '(1 2 -13 4 5 -3 2 -1 3 -8) 8 :type 'decimal) => (9 10 -21 12 13 -11 10 -9 11 -16) (shift-proportions '(3 5 -17 -11 23) 1 :type 'primes) => (5 7 -19 -13 29) (shift-proportions '(3 5 -17 -11 23) 5 :type 'primes) => (17 19 -37 -29 43) (shift-proportions '(-5 55 -34 233 -89) 1 :type 'fibonacci) => (-8 89 -55 377 -144) (shift-proportions '(-5 55 -34 233 -89) 3 :type 'fibonacci) => (-21 233 -144 987 -377)

THANX!!! andré

perhaps something like that? only a sketch... modify it... don't work in all cases... ;;; SUBFUNCTIONS ;;; TAKES A GIVEN TONAILTY AND EXPAND IT FOR X OCTAVES (defun multiple-expand-tonality (&key startpitch octaves tonality) (remove-duplicates (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))))))) ;;; EXPAND A TONALITY BY STEPS -> in a sense of schillinger? (defun tonality-with-scale-expansion (tonality expansion-nr) (let ((expansion (nth expansion-nr '(0 1 2 3 4 5 6)))) (reading-list-by-steps :steps (gen-repeat 53 expansion) :values (multiple-expand-tonality :startpitch 'c0 :octaves 8 :tonality (list tonality)) :start 'c0))) ;;; READS THE PITCHSEQUQNZ IN A TONALITY NOT AS INTERVALS , READS IT AS STEPS (IN A GIVEN PITCHFIELD) (defun get-steps (tonality pitches) (let ((tonality-space (multiple-expand-tonality :startpitch 'c0 :octaves 8 :tonality (list tonality)))) (difference (loop for i in pitches append (position-item i tonality-space))))) ;;; READS A LIST NY STEPS AND NOT BY INTERVALS -> USEFULL WHEN WORKING WITH PITCHFIELDS ;;; ALSO AVAILABLE IN TONALITY-MAP!!! (defun reading-list-by-steps (&key steps values start) (let ((pos (car (position-item start values)))) (append (list (nth pos values)) (loop for i in steps do (setf pos (+ pos i)) when (>= pos (length values)) do (setf pos (+ 0 i)) collect (nth pos values))))) ;;; filter-pitches-octave-independent (defun filter-pitches-octave-independent (pitches filter-pitch &key (bandwith 10)) (let ((search-field (loop for j in filter-pitch append (append (reverse (loop repeat (/ bandwith 2) with p1 = (pitch-to-midi j) collect (setq p1 (- p1 12)))) (list (pitch-to-midi j)) (loop repeat (/ bandwith 2) with p2 = (pitch-to-midi j) collect (setq p2 (+ p2 12))))))) (loop for i in (pitch-to-midi pitches) when (not (null (member i search-field))) collect (midi-to-pitch i)))) ;;; MAIN_FUNCTION --------------------------------------------------------------------------------------------------------------------- (defun expand-melody (expansion-nr tonality melody) (let ((start-pitch (nth expansion-nr (expand-tonality (list 'c4 (car (list tonality)))))) (new-tonality (tonality-with-scale-expansion tonality expansion-nr))) (pitch-transpose-start start-pitch (reading-list-by-steps :steps (get-steps 'major melody) :values new-tonality :start (car (filter-pitches-octave-independent new-tonality (list start-pitch))))))) (expand-melody 1 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 2 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 3 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 4 'major '(c4 f4 e4 f4 g4 a4))

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)