AM

i coded my own algorithm... so the ouput is like that, but a problem with ambitus-swallow...
(setq omn-list '(s. c4 pp ponte (acc t b3 ppp flaut t f3 ppp flaut) s. e3 pp ponte -t (acc t c4 pp flaut) s. fs3 ppp tasto s. b3 ppp tasto (acc t f3 pp flaut) -t (acc t c4 pppp ord) s. cs4 pp ponte s g4 ppp ord s f4 ppp ord s. b4 pp ponte (acc t c5 pppp ord) -t s c4 pp flaut e_t b3 p tasto s f3 ppp tasto s bb3 ppp tasto e_t e3 p tasto s eb3 pp flaut -w s. c4 ppp tasto (acc t b3 pppp ord t f3 p tasto t d3 p tasto t gs2 pppp ord) s. g2 ppp tasto -w (acc t c4 ppp ord) e_t fs3 pppp tasto (acc t g3 pppp flaut t cs3 pppp flaut) e_t d3 pppp tasto (acc t gs2 ppp ord) -t s c4 pppp ponte (acc t eb4 p tasto) s e4 pp tasto s g4 pp tasto (acc t gs4 p tasto) s b4 pppp ponte -t (acc t c4 p flaut) s. g3 ppp tasto s. gs3 ppp tasto (acc t eb3 p flaut) -t e_t c4 pppp ponte s fs4 pp ord)) ;;; it works well with cmd2, but the function: ambitus-swallow ...has a problem... why? (ambitus-swallow '(cs3 fs5) omn-list) > Error: Duration must be positive when duration-add is false. > While executing: normalize-duration, in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options.  

hi all,
i coded a little markov-program who changes the LEVEL-size if necessary to generate the number of values you want exactly.
 
it would be nice if someone could check/test the IDEA, and if it's correct and makes sense :-)
 
the markov starts on LEVEL 3 and tries to generate a number of output-levels with its TRANSITION-rules (level-3-rules), if it's possible (=generating the size) everything's fine. but if it's not possible, then the programm changes on LEVEL-2-rules ... if this is also not possible (to generate the size) then it changes to LEVEL 1... 
 
here is the code...
 
;;;FUNCTION (defun gen-multiple-markov (sequence &key size) (let ((transitions-level-1 (gen-markov-transitions sequence :level 1)) ;; gen transition-table level-1 (transitions-level-2 (gen-markov-transitions sequence :level 2)) ;; gen transition-table level-2 (seq (gen-markov-from-transitions (gen-markov-transitions sequence :level 3) :size size))) ;; gen markov-seq on level-3 (if (< (length seq) size) ;; test if seq is too short (/= (length seq) size) (progn ;; if too short -> combine the last seq with a new one (level 2) (setq seq (append seq (gen-markov-from-transitions transitions-level-2 :size (- size (length seq)) :start (last seq)))) (if (< (length seq) size) ;; same test as above (append (append seq (gen-markov-from-transitions transitions-level-1 :size (- size (length seq)) :start (last seq)))) (append seq))) (append seq)))) ;;;TEST (gen-multiple-markov '(1 2 3 2 1 2 3 2 1 2 2 2 2 1 1 1 1 2 2 3 2 1 1 2) :size 36)  
best wishes and THANX
andré
 
 

i'm working on a program including "markov"...
so i coded this small FUNCTION to SUBSTITUTE markov-rules-values (because in my "project" i'm generating a feedback on the markov-rules (after a pattern-match)). i know it could be coded a lot smarter but it works.
have fun! andré
 
;;;;FUNCTION (defun substitute-transition-value (transition-list value-old value-new) (loop for j in transition-list collect (loop for i in j when (numberp i) append (substitute value-new value-old (list i)) when (listp i) collect (append (substitute value-new value-old (list (first i))) (list (second i)))))) ;;;;;EXAMPLE (setq transitions '((1 (2 1) (3 3) (5 2) (8 1)) (2 (1 2) (5 3)) (3 (1 2) (8 1) (2 3)) (5 (3 2) (2 1) (1 3)) (8 (1 2) (2 2) (3 1)))) (substitute-transition-value transitions 1 -1) => ((-1 (2 1) (3 3) (5 2) (8 1)) (2 (-1 2) (5 3)) (3 (-1 2) (8 1) (2 3)) (5 (3 2) (2 1) (-1 3)) (8 (-1 2) (2 2) (3 1)))  

New length rewrite in OM update (coming soon):
 
(7/20 7/20 3/10 3/10)  

Hi,
Picat is a Prolog-derived language with good support for Constraint Programming. In today's blog, I have shown how to implement a simple CP-based function in Picat for chord/non-chord tone generation, and more interestingly, how we can interact with Picat from Opusmodus to get the results of the computation.
 
To me, this opens up new possibilities for expanding what you can do from Opusmodus!
 
Regards,
Rangarajan

"hysterical" with a value-list = multiple states :-)
 
;;;; SUBFUNCTIONS (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))) (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) (weighted-t/nil 0.5) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; MAINFUNCTION (defun binary-hysteresis-1.2 (&key number-of-values (value-list '((0 1) (4 0) (0 1) (4 7))) (start-weight 0.1) (sensitivity 0.02) (static 1.0)) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 with cnt-v = 0 when (equal (weighted-t/nil weight) 'nil) collect (first (nth cnt-v value-list)) else collect (second (nth cnt-v value-list)) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0) when (> weight static) do (incf cnt-v) and do (setq weight start-weight) when (= cnt-v (length value-list)) do (setq cnt-v 0))) ;;example (length-list-plot (binary-hysteresis-1.2 :number-of-values 600 :start-weight 0.1 :sensitivity 0.05 :value-list '((0 1) (10 2) (7 3)) :static 2.0))  

"hysterical" with a value-list = multiple states :-)
 
;;;; SUBFUNCTIONS (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))) (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) (weighted-t/nil 0.5) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; MAINFUNCTION (defun binary-hysteresis-1.2 (&key number-of-values (value-list '((0 1) (4 0) (0 1) (4 7))) (start-weight 0.1) (sensitivity 0.02) (static 1.0)) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 with cnt-v = 0 when (equal (weighted-t/nil weight) 'nil) collect (first (nth cnt-v value-list)) else collect (second (nth cnt-v value-list)) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0) when (> weight static) do (incf cnt-v) and do (setq weight start-weight) when (= cnt-v (length value-list)) do (setq cnt-v 0))) ;;example (length-list-plot (binary-hysteresis-1.2 :number-of-values 600 :start-weight 0.1 :sensitivity 0.05 :value-list '((0 1) (10 2) (7 3)) :static 2.0))  

"hysterical" with a value-list = multiple states :-)
 
;;;; SUBFUNCTIONS (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))) (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) (weighted-t/nil 0.5) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; MAINFUNCTION (defun binary-hysteresis-1.2 (&key number-of-values (value-list '((0 1) (4 0) (0 1) (4 7))) (start-weight 0.1) (sensitivity 0.02) (static 1.0)) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 with cnt-v = 0 when (equal (weighted-t/nil weight) 'nil) collect (first (nth cnt-v value-list)) else collect (second (nth cnt-v value-list)) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0) when (> weight static) do (incf cnt-v) and do (setq weight start-weight) when (= cnt-v (length value-list)) do (setq cnt-v 0))) ;;example (length-list-plot (binary-hysteresis-1.2 :number-of-values 600 :start-weight 0.1 :sensitivity 0.05 :value-list '((0 1) (10 2) (7 3)) :static 2.0))  

;;; ------------------------------------------------------------------------------ ;;; GEN-PITCH-LINE ;;; Pitch generation function based on noise vectors conversion with a large choice of ;;; types of noises, compress ratio for the vector, filtering repetitions and ambitus. (defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white)) (do-verbose ("gen-pitch-line") (rnd-seed seed) (labels ((white (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type) (if filter-repeat (gen-trim nb-pitch (filter-repeat filter-repeat (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type))))) (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type))))) (pink (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat) (if filter-repeat (gen-trim nb-pitch (filter-repeat filter-repeat (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed))))) (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed))))) ) (cond ((equal type ':white) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :normal)) ((equal type ':binary) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :binary)) ((equal type ':cauchy) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :cauchy)) ((equal type ':chi-square-2) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :chi-square-2)) ((equal type ':double-exponential) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :double-exponential)) ((equal type ':exponential) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :exponential)) ((equal type ':extreme) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :extreme)) ((equal type ':gaussian) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :gaussian)) ((equal type ':logistic) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :logistic)) ((equal type ':lognormal) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :lognormal)) ((equal type ':triangular) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :triangular)) ((equal type ':low-pass) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :low-pass)) ((equal type ':high-pass) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :high-pass)) ((equal type ':pink) (pink nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed))))))) #| USAGE (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1) (gen-pitch-line 24 :compress 0.42 :type :pink :filter-repeat 1) (gen-pitch-line 24 :compress 0.42 :type :extreme :filter-repeat 1) (gen-eval 8 '(make-omn :pitch (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1) :length (euclidean-rhythm 16 1 16 's :type 2) ) :seed 33) |# ;;; ------------------------------------------------------------------------------ SB.

BINARY-HYSTERESIS-1.1
 
version with :start-point (default is ( /  numbers-of-values 2))
it's interesting to play with :tendency and :start-weight
for example -> start-weight = high (ca. 0.5) -> oscillation is beginning quickly (at start-point) but when tendency is low it needs time to switch definitly... etc...
 
(defun binary-hysteresis-1.1 (&key number-of-values (values '(0 1)) (start-weight 0.1) (sensitivity 0.02) (start-point (if (evenp number-of-values) (/ number-of-values 2) (/ (1- number-of-values) 2)))) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 for cnt2 = 0 then (incf cnt2) when (or (equal (weighted-t/nil weight) 'nil) (< cnt2 start-point)) collect (first values) else collect (second values) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0))) ;;;; example with 0/1 (length-list-plot (binary-hysteresis-1.1 :number-of-values 200 :values '(0 1) :start-weight 0.4 :sensitivity 0.05 :start-point 80))  

BINARY-HYSTERESIS-1.1
 
version with :start-point (default is ( /  numbers-of-values 2))
it's interesting to play with :tendency and :start-weight
for example -> start-weight = high (ca. 0.5) -> oscillation is beginning quickly (at start-point) but when tendency is low it needs time to switch definitly... etc...
 
(defun binary-hysteresis-1.1 (&key number-of-values (values '(0 1)) (start-weight 0.1) (sensitivity 0.02) (start-point (if (evenp number-of-values) (/ number-of-values 2) (/ (1- number-of-values) 2)))) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 for cnt2 = 0 then (incf cnt2) when (or (equal (weighted-t/nil weight) 'nil) (< cnt2 start-point)) collect (first values) else collect (second values) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0))) ;;;; example with 0/1 (length-list-plot (binary-hysteresis-1.1 :number-of-values 200 :values '(0 1) :start-weight 0.4 :sensitivity 0.05 :start-point 80))  

Hi,
In today's blog post, I have shared some basic ideas about the Screamer Lisp library, with examples of how to start using it for constraint programming. The inspiration came from some earlier posts in OM forum on this topic. It was an exciting exercise and learnt a few interesting things!
 
Regards,
Rangarajan

OPUSMODUS is nearly perfect for me and my work! thanks for your great work, janusz and ?!!!

a critical statement...
i think by working with opusmodus (or PWGL or CM or whatever) there come up some "asthetical traps"...
 
#1 -> using the predefined "tools" (and not programming/thinking it for youself) could be like "cooking convenience food" (nice to produce fast and smart, but im my view not for ...)
 
#2 -> confound (?) the complexity of the algorithm with the "complexity of the musical structure" (inherent and historically) ... for example you can realize that in BOULEZ "répons"
 
#3 -> perhaps... you will only do, what the predefined "tools" can do
 
#4 ?
...
 
 
...whatelse could you imagine?
regards,
andré
 
 
 

SB,
Please look at the attached source file. I guess this will meet your requirements (to the extent I have understood). Let me know if you need to make some changes or if you encounter any problem running it.
 
Regards,
Rangarajan
 
Midi to score serialization.opmo

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

liitle example:
here a little extra-function -> splittering am melody... + hoquetus.4 (take the function from last post)
regards
andré
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;gen-hoquetus.4 + time-splittered-melody;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;andré meier / 27-4-2016 ;;;hoquetus.4 with a extra-funny-melody-splittered-function ;;;good night and good luck! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;extra-functions;;;;;;;;;splittering-melody;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) (defun splittering-length-seq (lengths &key (possible-lengths '(1 2 3 4)) (rest-weight 0.5) (rhy-factor 1/32)) (loop for i in lengths when (> i 0) collect (loop for j in (rnd-sum i possible-lengths) collect (if (equal (weighted-t/nil rest-weight) 't) (* j -1 rhy-factor) (* j rhy-factor))) else collect (list (* i rhy-factor)))) (defun add-pitch-seq-to-splittered-length-seq (length-seq pitch-seq) (loop for i in length-seq with cnt = 0 append (loop for j in i when (> j 0) collect (nth cnt pitch-seq)) do (incf cnt) when (> cnt (length pitch-seq)) do (setq cnt 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun time-splitterd-melody (length-seq pitch-seq &key (possible-lengths '(1 2 3 4)) (rest-weight 0.5) (rhy-factor 1/32)) (make-omn :length (setq lengths (splittering-length-seq length-seq :possible-lengths possible-lengths :rest-weight rest-weight :rhy-factor rhy-factor)) :pitch (add-pitch-seq-to-splittered-length-seq lengths pitch-seq))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;OMN_EXAMPLE HOQUETUS + TIME_SPLTTERED_MELODY :;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq values (flatten (time-splitterd-melody '(16 16 16 16 16 16 16 16 16 16 32 16 16 32) '(c5 d5 e5 c5 c5 d5 e5 c5 e5 f5 g5 e5 f5 g5) :rest-weight 0.5))) (setq lengths (omn :length values)) (setq pitches (omn :pitch values)) (setq pos-durations (car (last (loop for i in lengths with cnt = 0 when (> i 0) collect (incf cnt))))) (setq instrumentation (loop repeat pos-durations 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))  
 
 

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

dear rangarajan
 
i think the motif-map-function has a PATTERN-MATCH inside, but it "replaces the MATCH", (like in a contextual-rewrite), but perhaps i don't use the name/expression "pattern-match" in a wright/correct way... i'm more composer/musician then programmer :-)

here's a very basic example for am SIMPLE/PURE PATTERN MATCH:
a rnd-gen-value-list (to show how you could use it), with a PATTERN-MATCH-prog who scans it. 
the next value - after a complete match - will be changed into a rest... but you also could start a sub-function then who do what ever you want...? (when you change the code)
 
in a concrete project i coded it also in a more complex way - kind of "nontrivial-machines" (as an experiment) -> PATTERNmatch in pitches changes the DURATIONS, PATTERNmatch in durations changes pitches or timbre... and so on... like a "dynamic-interaction-network"...
 
sorry for my bad english...
regards
andré
 
FUNCTION - FOR A SIMPLE EXAMPLE
(defun pattern_cogn (liste pattern)    (loop for z in liste     with cnt = 0     with pattern_cnt = 0        collect z             ;;;check a value - if it's a match -> incf counter     when (or (eq  (nth cnt pattern) z)  (eq '? (nth cnt pattern)))     do (incf pattern_cnt)     and do (incf cnt)     else do (setq cnt (setq pattern_cnt 0))          ;;; if the pattern is MATCHED (=> counter = length pattern)  -> the output changes ... for example, the next value will be a rest     ;;; = consequence     when (eq pattern_cnt (length pattern))     collect (* z -1)     and do (setq cnt (setq pattern_cnt 0))))  
FUNCTION-EVAL
(pattern_cogn (loop repeat 100                 collect (1+ (random 5))) ; generates rnd-values ->  TO SEARCH IN IT               '(4 ? 2)) ; pattern to search (here with wildcard)  
WHEN PATTERN MATCH THEN NEXT VALUE (* -1)

short question (i didn't read the whole documentation)... when i use/work with pattern-matching, i've done it with WILDCARDS ... is there any aspect of that in the motif-map function? or is a "ordinary pattern-matching-function" in OM?
 
like that: pattern to search/replace 
'(0 1 ? 3)  
this is musically interesting, because it works with "fuzziness"....
 
regards,
andré
 
 

dear rangarajan
 
i think the motif-map-function has a PATTERN-MATCH inside, but it "replaces the MATCH", (like in a contextual-rewrite), but perhaps i don't use the name/expression "pattern-match" in a wright/correct way... i'm more composer/musician then programmer :-)

here's a very basic example for am SIMPLE/PURE PATTERN MATCH:
a rnd-gen-value-list (to show how you could use it), with a PATTERN-MATCH-prog who scans it. 
the next value - after a complete match - will be changed into a rest... but you also could start a sub-function then who do what ever you want...? (when you change the code)
 
in a concrete project i coded it also in a more complex way - kind of "nontrivial-machines" (as an experiment) -> PATTERNmatch in pitches changes the DURATIONS, PATTERNmatch in durations changes pitches or timbre... and so on... like a "dynamic-interaction-network"...
 
sorry for my bad english...
regards
andré
 
FUNCTION - FOR A SIMPLE EXAMPLE
(defun pattern_cogn (liste pattern)    (loop for z in liste     with cnt = 0     with pattern_cnt = 0        collect z             ;;;check a value - if it's a match -> incf counter     when (or (eq  (nth cnt pattern) z)  (eq '? (nth cnt pattern)))     do (incf pattern_cnt)     and do (incf cnt)     else do (setq cnt (setq pattern_cnt 0))          ;;; if the pattern is MATCHED (=> counter = length pattern)  -> the output changes ... for example, the next value will be a rest     ;;; = consequence     when (eq pattern_cnt (length pattern))     collect (* z -1)     and do (setq cnt (setq pattern_cnt 0))))  
FUNCTION-EVAL
(pattern_cogn (loop repeat 100                 collect (1+ (random 5))) ; generates rnd-values ->  TO SEARCH IN IT               '(4 ? 2)) ; pattern to search (here with wildcard)  
WHEN PATTERN MATCH THEN NEXT VALUE (* -1)