;;; i think what you are looking for is something like that:
;;; in every generation the sequence will be new, and at some 
;;; points (when sample-length = 1) the row is changing...


(setf generations 200)
(setf omn (loop repeat generations
            with seq = (rnd-row)
            do (setf pitch (integer-to-pitch (setf seq (rnd-sample-seq (1+ (random (length seq))) seq)))) ;; picks a rnd-length-sample of the row
            
            ;; when the random-chosen seq-length = 1 then a new row will be generated but ONE value shorter
            ;; (see: (butlast (rnd-row)) , so the feedback will come quicker and quicker... because
			;; of the chance to match  seq-length = 1
     
			when (= (length seq) 1) do (setq seq (butlast (rnd-row))) ;;  the feedback on production
            do (setf len (span pitch '(s)))
            collect (make-omn :pitch pitch :length len)))
      

(def-score 12-tone
           (:key-signature 'atonal
                           :time-signature '(4 4)
                           :tempo 120)
  (inst :omn omn))
(display-musicxml '12-tone)
(display-midi '12-tone)

;;;

 

hi yuichi

 

here a version without exit-problems... a simple loop (with x-generations), that's what your code is doing... so you don't have to re-evaluate, loop is doing this...

(setf generations 20)
(setf omn (loop repeat generations
            do (setf pitch (integer-to-pitch (rnd-row)))
            do (setf len (span pitch '(s)))
            collect (make-omn :pitch pitch :length len)))

(def-score 12-tone
           (:key-signature 'atonal
                           :time-signature '(4 4)
                           :tempo 120)
  (inst :omn omn))
(display-musicxml '12-tone)
(display-midi '12-tone)

 

 

 

;;;;perhaps you could/would extend the "rnd-sample-seq" function by:
;;;;(also with OMN-format) ... regards andré


;;;;SUBFUNCTIONS

(defun pick-sample-from-center (list span)
  (let ((center (if (evenp (length list))
                  (/ (length list) 2)
                  (/ (1+ (length list)) 2)))
        (span (if (> span (length list))
                    (length list)
                    (append span))))
    (loop repeat span
      with startpoint = (if (evenp span)
                          (- center (/ span 2))
                          (- center (/ (1+ span) 2)))

      for i = startpoint then (incf startpoint)
      collect (nth i list))))


;;;;MAINFUNCTION 
;;;;sampling-machine

(defun sampling-seq-machine (&key seq (type 'rnd) (sample-lengths 'rnd))
  (let ((span (if (equal sample-lengths 'rnd)
                 (1+ (random (length seq)))
                 (rnd-pick sample-lengths))))

    (cond ((equal type 'rnd)
           (rnd-sample-seq span
                           seq))
          ((equal type 'from-center)
           (loop repeat span
             with center = (center-position-in-list (omn :length seq))
             with startpoint = (if (evenp span)
                                 (- center (/ span 2))
                                 (- center (/ (1+ span) 2)))
             
             for i = startpoint then (incf startpoint)
             append (position-filter i seq)))
          
          ((equal type 'from-start)
           (loop repeat span
             for i = 0 then (incf i)
             append (position-filter i seq)))
          
          ;;; don't
          ((equal type 'from-end)
           (loop repeat span
             for i = (- (length (omn :length seq)) span) then (incf i)
             append (position-filter i seq))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(sampling-seq-machine :seq '(1 2 3 4 5 6 7 8 9) 
                      :type 'from-end
                      :sample-lengths '(3 5 7))
                  
(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'rnd
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-start
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-center
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-end
                      :sample-lengths '(3 5 7))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

have fun or delete it...

chord-rotation by karel goeyvaerts (his early works), also used/modfied by stockhausen & co, etc...

regards

a.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;some OLD code -> changed for OMN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; goeyvaerts-rotation -> from "komposition 1";;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; SUBS

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


;;;

(defun single-pitch-transpose (pitch interval &key (midi-output 'nil))
  (if (numberp pitch)
    (if (equal midi-output 'nil)
      (midi-to-pitch (+ interval pitch))
      (+ interval pitch))
    (if (equal midi-output 'nil)
      (midi-to-pitch (+ interval (pitch-to-midi pitch)))
      (+ interval (pitch-to-midi pitch)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;MAIN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun goeyvaerts-rotation (&key pitches 
                                 static-pitches
                                 generations
                                 goeyvaerts-transpose-interval
                                 (direction 'up)
                                 low-border
                                 high-border
                                 correction-interval)
  (let ((pitches (filter-remove (pitch-to-midi static-pitches) (pitch-to-midi pitches))))
    (midi-to-pitch (append  (list (append pitches (pitch-to-midi static-pitches)))
                            (cond ((equal direction 'up)
                                   (loop repeat generations
                                     collect (append (setf pitches (append (loop for i in pitches
                                                                             when (> i (- (pitch-to-midi high-border) goeyvaerts-transpose-interval))
                                                                             collect (- i (- (abs correction-interval) 12))
                                                                             else collect (+ i goeyvaerts-transpose-interval))))
                                                     (pitch-to-midi static-pitches))))
                                  ((equal direction 'down)
                                   (loop repeat generations
                                     collect (append (setf pitches (append (loop for i in pitches
                                                                             when (< i (+ (pitch-to-midi low-border) goeyvaerts-transpose-interval))
                                                                             collect (+ i correction-interval 12)
                                                                             else collect (- i goeyvaerts-transpose-interval))))
                                                     (pitch-to-midi static-pitches)))))))))
      

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(chordize (goeyvaerts-rotation :pitches '(cs2 a2 gs3 d4 bb4 a5 eb6)
                               :static-pitches '(d4)
                               :direction 'down
                               :generations 3
                               :goeyvaerts-transpose-interval 12
                               :low-border 'c2
                               :high-border 'c5
                               :correction-interval 24))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;put in in a specific interval-to-chord-function ;;;;;;;;;;;;;
;;;;;:type rnd-octaves or goeyvaerts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun interval-to-chord+ (&key interval-seq 
                               startpitch 
                               (generations 1)
                               (no-duplicates 'nil) 
                               (type 'rnd-octaves) 
                               (transpose-intervals '(-12 12))
                               (transpose-chance 0.5)
                               (arpeggiando 'nil)

                               (goeyvaerts-direction 'up)
                               (goeyvaerts-static-pitches '(c4))
                               (goeyvaerts-transpose-interval 12)
                               (goeyvaerts-low-border 'c2)
                               (goeyvaerts-high-border 'c5)
                               (goeyvaerts-correction-interval 24)

                               (sorted-asc 't))

                               
  (let ((pitches (interval-to-pitch interval-seq :start startpitch)))
    (setf pitches (if (equal no-duplicates 't)
                    (remove-duplicates pitches)
                    (append pitches)))
    
    (setf pitches 
                ;;type with rnd-octaves
          (cond ((equal type 'rnd-octaves)
                 (loop repeat generations 
                   collect (setf pitches (loop for i in pitches
                                           collect (single-pitch-transpose i (if (weighted-t/nil transpose-chance)
                                                                               (rnd-pick transpose-intervals)
                                                                               (append 0)))))))

                ;;type with goeyvaerts-transp -> (from "komposition 1")
                ((equal type 'goeyvaerts)
                 (goeyvaerts-rotation :pitches pitches
                                      :static-pitches goeyvaerts-static-pitches
                                      :direction goeyvaerts-direction
                                      :generations generations
                                      :goeyvaerts-transpose-interval goeyvaerts-transpose-interval
                                      :low-border goeyvaerts-low-border
                                      :high-border goeyvaerts-high-border
                                      :correction-interval goeyvaerts-correction-interval))
                
                (t (append pitches))))
    
    (if (equal sorted-asc 't)
      (setf pitches (sort-asc pitches)))
    (if (equal arpeggiando 't)
      (append pitches)
      (chordize pitches))))
  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; examples ;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; GOEYVAERTS
(pitch-list-plot
 (flatten (interval-to-chord+ :type 'goeyvaerts
                              :interval-seq '(5 3 3 3 5 3 3 3 5)
                              :generations 10
                              :startpitch 'c4 
                              :type 'goeyvaerts
                              :goeyvaerts-direction 'up
                              :goeyvaerts-low-border 'c2
                              :goeyvaerts-high-border 'c5
                              :goeyvaerts-correction-interval 48
                              :arpeggiando t
                              :sorted-asc 't)))

;;; RND-OCTAVES
(pitch-list-plot
 (flatten (interval-to-chord+ :type 'rnd-octaves
                              :interval-seq '(5 3 3 3 5 3 3 3 5)
                              :startpitch 'c4 
                              :type 'rnd-octaves
                              :no-duplicates 't
                              :transpose-intervals '(-12 12)
                              :transpose-chance 0.5
                              :arpeggiando t
                              :sorted-asc 't)))

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;gen-chained-sym-vals.by-markov;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; special-symm-sequences
;;; have look at the possible parameters (&key)
;;; it's generates symm-structures via MARKOV
;;; and the could be "chained" between generations
;;; also with symm.structures... like: (also look at CARTER's work)

;;; => ((1 2 5 8 5 2 1) (3 1 2 2 2 1 3) (8 1 3 1 8) (3 1 2 2 2 1 3) (1 2 5 8 5 2 1))
;;; chains:        2 1   3 1 2                               2 1 3   1 2

;;; or:

;;; => ((e4 f4 c4 e4 d4 e4 c4 f4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 fs4 f4 fs4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 f4 c4 e4 d4...
;;; chains:                c4 f4 e4   c4 e4 f4 c4           e4 c4   e4            e4   c4 e4          ........etc.......          


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; main function with amateur-code :-)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun gen-chained-sym-vals.by-markov (&key (generations 'nil) 
                                         (non-symmetric 'nil) 
                                         (number-of-vals 20) 
                                         (basic-seq-lengths '(3 5))
                                         (transition-matrix 
                                          '((1 (4 1) (5 1) (6 2))
                                            (2 (5 2) (4 1))
                                            (3 (4 1))
                                            (4 (5 1) (2 1))
                                            (5 (1 3) (6 2) (4 1))
                                            (6 (4 1))
                                            (7 (1 1) (6 1))))
                                         (chain-weight 1.0) 
                                         (possible-chain-length '(1 2 3)) 
                                         (reduction 0.0)
                                         (start-value (car (car transition-matrix))))
  (let ((sequence1 0)
        (sequence2 0)
        (seq-lengths basic-seq-lengths))
    (setq sequence1 (loop repeat (if (equal generations 'nil)
                                   (car (list number-of-vals))
                                   (if (equal non-symmetric 'nil)
                                     (if (evenp generations)    
                                       (/ generations 2)
                                       (/ (1- generations) 2))
                                     (car (list generations))))
                      with seq1
                      with seq
                      with chain1
                      with slot = (second (gen-markov-from-transitions transition-matrix :size 2 :start start-value))
                      with seq-splitter = (gen-markov-from-transitions transition-matrix :size (rnd-pick possible-chain-length) :start slot)
                      with seq-lengths = basic-seq-lengths
                      
                      when (equal (prob? chain-weight) 't)
                      do (setq chain1 (append  (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot))))
                                               seq-splitter
                                               (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot))))))

                      and do (setq seq  (append (butlast chain1) (reverse chain1)))
                      and collect (if (equal (prob? reduction) 't)
                                       (append (setq seq (butlast (rest seq))))
                                       (append seq))
                      
                      else collect (setq seq1 (gen-markov-from-transitions transition-matrix :size (rnd-pick seq-lengths) :start slot)
                                         seq (append seq1 (reverse seq1)))
                      do (setq seq-splitter (reverse (filter-last (rnd-pick possible-chain-length) seq)))))
    
    (if (equal generations 'nil) 
      (progn (setq sequence2 (filter-first (if (evenp number-of-vals)
                                             (/ number-of-vals 2)
                                             (/ (1- number-of-vals) 2))
                                           (flatten sequence1)))
        (if (evenp number-of-vals)
          (append sequence2 (reverse sequence2))
          (append sequence2 (list (rnd-pick (flatten (filter-first 1 transition-matrix)))) (reverse sequence2))))
      
      (if (equal non-symmetric 'nil)
        (if (evenp generations)
          (append sequence1 (reverse sequence1))
          (append sequence1 (list (gen-sym-markov :seq-length (rnd-pick seq-lengths) :transition-matrix transition-matrix)) (reverse sequence1)))
        (append sequence1)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; test it!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(gen-chained-sym-vals.by-markov :generations 5
                                :transition-matrix '((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))))


(gen-chained-sym-vals.by-markov :generations 5
                                :transition-matrix '((c4 (d4 1) (e4 3) (f4 2) (fs4 1))
                                                     (d4 (c4 2) (f4 3))
                                                     (e4 (c4 2) (fs4 1) (d4 3))
                                                     (f4 (e4 2) (d4 1) (c4 3))
                                                     (fs4 (c4 2) (d4 2) (e4 1))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

is there a FILE in opusmodus where i can write/define my own attributes (for program-changes in conTIMBRE)...? ...like a  (USER-) LIBRARY?

the existing attributes like

 

   "... mouthpiece-backwards

    mouthpiece-only

    play-and-sing

    silent-brass

    snap-with-a-finger-on-the-bell

    stop-mute-closed

    stop-mute-open

    stop-mute-wahwah-effect

    without-mouthpiece

    air-noise-f ..."

 

 

 

are too "innacurate" (?) for me, i would need more, and very specific/personal...

 

thanx and regards 

andré

 

thanx! i can modify my own function now, so that it will work properly :-)

 

nice :-)

;;;function which replaces/rewrites the component in OMN-seq

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

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

 

great :-) release date? 

with yours and rangarajan-help it works!! thanx! 

dear janusz, stephan.......

 

i tried to install SCREAMER via quicklisp... quicklisp-thing worked, but for the rest i'm to stupid... :-) coudl anyone help me.... where should i copy folders/files... i have no idea 

... i'm only a simple musician who is coding in lisp-OMN (but not more) :-)

 

i would like i step by step...

 

thanx

andré

thanks. yes i know it...

but i'm working different... more "generative" (and not with many OMN-functions)... i have to check in every generation the output  on different parameters, and as a feedback i change when PATTERN-MATCH => T the data-DNA (the production-datas for next gen via (defstruct => make-.... )) or the function which generates something in the generative APP ...  most of the code is in pure LISP. it's great that i can code it like that in OPUSMODUS (very open!)...i can find my own solutions and ways, and it's not necessary to use the "official grammar" (always a problem with music-production-software), but i could i if i want :-)

 

... so i have a large personal USER LIBRARY now :-)

 

thanks for your pracitcal examples how to work on OMN-level - i can learn a lot from them on OMN :-)

regards

andré

 

possible?

would like it if i could see/open/work COMPOSER, SCORE, MIDI-display, GRAPHICS in different windows  (for working with more then one SCREEN)...?

what do you think?

regards 

andré

thanx for articulationp!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;how to split randomly a number into "n-parts"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rnd-split-number (n &key (total-sum 1.0))
  (let ((values))
    (setq values (loop repeat (- n 1)
                   with val-a = total-sum
                   with val-b
                   collect (setq val-b (random val-a))
                   do (setq val-a (- val-a val-b))))
    (append values (list (- total-sum (sum values))))))


;; examples
(rnd-split-number 5 :total-sum 1.8)

=> (0.26645982 1.47964 0.014375878 0.014122969 0.025401235)

(rnd-split-number 3 :total-sum 9.8)

=> (5.1533704 1.7459779 2.900652)

 

so i could search articulation-patterns in my BOTS => is it complicated? i would need it urgent :-)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WHEN PATTERN-MATCH => T
;;; THEN WEIGHETD RANDOM DECIDING THE NEXT VALUE
;;; with :gate/:keyword = extra AND-function
;;; with :evaluate => you could evaluate a function-output directly
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; subfunctions

(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))


(defun test.pm.omn (seq pattern)
  (let ((seq (if (omn-formp seq)
               (cond ((lengthp (car pattern)) (omn :length seq))
                     ((pitchp (car pattern))(omn :pitch seq))
                     ((velocityp (car pattern)) (omn :velocity seq)))
               (append seq))))
    (pattern-match seq pattern)))


(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 test.pm+chance (test.seq pattern values/weights &key keyword gate (evaluate 'nil))
  (let ((out))
    (setf out (if (and (test.pm.omn test.seq pattern) (equal keyword gate)) 
                (weighted-random values/weights)
                (append gate)))
    (if (equal evaluate 't)
      (eval out)
      (append out))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; example => works also with OMN etc...
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.15) (c 0.375) (d 0.21)))


;; more examples
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.25) (c 0.25)) :gate 'no-entry :keyword 'no-entry) ;; => key correct
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.5)) :gate 'no-entry :keyword 'whatever) ;; key incorrect
              
;; example with :evaluate T
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '(((cons 'a 'b) 0.5) ((cons 'c 'd) 0.5)) :evaluate t)

 

yes, because with it, i could code more "multi-usable" functions :-)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WHEN PATTERN-MATCH => T 
;;; THEN MARKOV PRODUCES THE NEXT VALUES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; subfunctions

(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))

(defun test.pm.omn (seq pattern)
  (let ((seq (if (omn-formp seq)
               (cond ((lengthp (car pattern)) (omn :length seq))
                     ((pitchp (car pattern))(omn :pitch seq))
                     ((velocityp (car pattern)) (omn :velocity seq)))
               (append seq))))
    (pattern-match seq pattern)))


;; mainfuction

(defun test.pm+markov (seq pattern start-slot transitions &key (size 1))
  (if (test.pm.omn seq pattern)
    (if (= size 1)
      (car (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot)))
      (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot)))
    (append start-slot)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setf transitions '((a (a 2) (b 1))
                    (b (a 2) (b 1))))

(setq test-omn '(t fs4 pp tasto g4 ppp tasto -s. t e4 pppp tasto -s. t eb4 pp tasto -het - t))

;; examples1
(test.pm+markov test-omn '(pp ppp) 'a transitions) ;; evaluate a few times
(test.pm+markov test-omn '(fs4 g4) 'a transitions) ;; evaluate a few times
(test.pm+markov test-omn '(g2) 'a transitions) ;; evaluate a few times => no match => no new value
(test.pm+markov test-omn '(1/32 -3/32) 'a transitions) ;; evaluate a few times


;; examples2
(test.pm+markov test-omn '(pp) 'a transitions :size 5) ;; evaluate a few times
(test.pm+markov test-omn '(g4 e4) 'a transitions :size 3) ;; evaluate a few times

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

is there an articulationp like a pitchp etc???

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PATTERN MATCH FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; i needed some PATTERN_MATCH-FUNCTIONS (also with wildcards) 
;;; in my projects to check sequences
;;; output is t/nil - 
;;; implement it if you whant :-) regards, andré

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))


(pattern-match '(1 2 3 4 5 6 7 8) '(2 ? 3))
=> nil


(pattern-match '(1 2 3 4 5 6 7 8) '(2 ?))
=> t

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun test.pm.length (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :length seq)
               (append seq))))                 
    (pattern-match seq pattern)))

(defun test.pm.pitch (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :pitch seq)
               (append seq))))                     
    (pattern-match seq pattern)))

(defun test.pm.velocity (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :velocity seq)
               (append seq))))                     
    (pattern-match seq pattern)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR => some nonsense-sound-examples
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; little function for mapping...

(defun eliminate-repetitions (liste)

  (let ((liste (append liste (list 'nil))))
    (loop repeat (1- (length liste))
      with cnt = 0
      when  (not (equal (nth cnt liste) (nth (+ 1 cnt) liste)))
      collect (nth cnt liste)      
      do (incf cnt))))


;;; some examples

;(setq integers
;      (flatten (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17))))
(setq integers
      (flatten (ashby-operator-1 '( 3 1 4 0 7 8 9 10  5 6 2 11))))
;(setq integers
 ;     (flatten (ashby-operator-1 (gen-sieve '(c4 c7) '(1 2 3)))))


;;; mapping

(setq pitches (eliminate-repetitions (integer-to-pitch integers)))

(def-score example
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch pitches
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
#|

(def-score example-reverse
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch (reverse pitches)
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
|#

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; i coded somethings special, that i have seen in a book
;;; of HEINZ VON FOERSTER (my favorite writer/philosopher..)
;;; https://en.wikipedia.org/wiki/Heinz_von_Foerster
;;; => i didn't found this ASHBY-algo (he is writing about it)
;;; anywhere else, but for me it was interesting to code it.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; every list of integers (from 0 to ?) will end with "0"
;;; perhaps you could map it with whatever you want .......

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun ashby-operator-1 (liste)
  (append (list liste)
                (loop 
                  with slot-pos
                  with slot-val
                  with slot-product
                  
                  ;; choose two positions in the list
                  do (setq slot-pos (loop repeat 2
                                      collect (random (length liste))))
                  
                  ;; picks the values from the positions
                  do (setq slot-val (list (nth (first slot-pos) liste) (nth (second slot-pos) liste))
                           ;; gen the product of the two values
                           slot-product (* (first slot-val) (second slot-val)))
                  
                  ;; replace the value of the first pos with the (first (explode slot-product))
                  ;; or when it's < 10 with 0
                  do (setq liste (loop for i in liste
                                   for cnt = 0 then (incf cnt)
                                   
                                   when (= cnt (first slot-pos))
                                   collect (if (> slot-product 9)
                                             (first (explode slot-product))
                                             (append 0))
                                   else collect i))

                  ;; replace the value of the second pos with the (second (explode slot-product))
                  ;; or or when it's < 10 with the slot-product
                  collect (setq liste (loop for i in liste
                                        for cnt = 0 then (incf cnt)
                                        when (= cnt (second slot-pos))
                                        collect (if (> slot-product 9)
                                                  (second (explode slot-product))
                                                  (append slot-product))
                                        else collect i)) 
                  into bag ;; collects all into bag

                  ;; when LISTE only '(0 0 0 0 0 ...) return all generations
                  when (= (sum liste) 0)
                  do (return bag))))



;;;examples

(ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9))

(list-plot
 (flatten 
  (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 11)))
 :point-radius 0.1 :style :fill :line-width 1)

(integer-to-pitch
 (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11)))

(chordize-list
 (integer-to-pitch
  (remove-duplicates
  (ashby-operator-1 '(0 1 2 3 5 8 13)))))

 

yes, but... it has some error...

 

> Error: No length specified before first pitch
> While executing: (:internal parse-omn-note), in process Listener-1(6).
> Type cmd-. to abort, cmd-\ for a list of available restarts.
> Type :? for other options.

 

only when i do gen-rotate with the sequence

the sequence works with perhaps (gen-retrograde seq) or...

 

 

the sequence (produced by rnd-bots) is for example, something like that...

 

((et b1 f gettato t f1 ff ord et cs3 mf gettato t fs3 f tasto d5 tasto et g5 mf gettato t eb7 ff ord et a6 f gettato))

 

and works fine without (gen-rotate