Jump to content

AM

Members
  • Posts

    792
  • Joined

  • Last visited

Posts posted by AM

  1. (progn
    
      ;; your list with EVEN-length!!! (necessary for length/rest-structure) -> starting with all values as rests
      (setf seq '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8)) 
    
      ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => the number of your ON/OFF-vals (switching values, not the rests!) 
      (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1))
                                            with val = '()
                                            do (setf val (decimal-to-binary i))
                                            collect (append (loop repeat (- (/ (length seq) 2) (length val))
                                                              collect 0) ;; necessary "to fill" the seq-length
                                                            val)))
    
      ;; combines the 1/0-list with 0 (for the unchanging rests)
      (setf binary-seq-completed (loop for x in all-basic-binary-combinations
                                   collect (loop for y in x
                                             append (list y 0))))
    
      ;; maps the "binary-seq-completed" on your values
      (loop for k in binary-seq-completed
        collect (loop 
                  for l in k
                  for value in seq
                  when (= l 1)
                  collect (abs value)
                  else collect value)))

    ...is perhaps a way to get the output?

    ...evaluate...

    ...or press CMD2 -> so you see the rhythm-structure...

     

    ...in this version the gen-structure is based on the "BINARY-incf", if you want a RND-version, just "RND-ORDER" the list...

    packed in a function:

     

     
    (defun all-variants (seq)
    
      (let ((all-basic-binary-combinations)
            (binary-seq-completed))
    
        ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) 
        (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1))
                                              with val = '()
                                              do (setf val (decimal-to-binary i))
                                              collect (append (loop repeat (- (/ (length seq) 2) (length val))
                                                                collect 0)
                                                              val)))
        
        ;; combines the 1/0-list with 0 (for the unchanging rests)
        (setf binary-seq-completed (loop for x in all-basic-binary-combinations
                                     collect (loop for y in x
                                               append (list y 0))))
        
        ;; maps the "binary-seq-completed" on your values
        (loop for k in binary-seq-completed
          collect (loop 
                    for l in k
                    for value in seq
                    when (= l 1)
                    collect (abs value)
                    else collect value))))
    
    
    (all-variants '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8))

     

  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; LENGTH-REST-RATIO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; to TEST in a OMN- or LENGTH-sequence
    
    (defun length-rest-ratio (seq)
      (let ((liste (omn :length seq)))
        (loop for i in liste
          when (< i 0) sum (abs i) into -bag
          when (> i 0) sum i into +bag
          finally (return (ratio-to-float (* +bag (/ 1 (+ +bag -bag))))))))
    
    (length-rest-ratio '(e. q. -q))
    (length-rest-ratio '(-2 3 4 -1 -1))
    (length-rest-ratio '(e. c4 ppp -q. q d3 e3 f3))
            
            
    ;;; evaluate this test a few times    
    (if (> (length-rest-ratio (rnd-repeat 10 '(1 2 3 4 -1 -2 -3 -4))) 0.5)
      (append 'more-lengths)
      (append 'more-rests))

     

  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; i needed a function who changes randomly lengths to rests
    ;;; step by step, and modify (enlarge) its rest-values over x-generations
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    (defun modify-lengths-to-rests (liste &key (items 1) (step -1) (factor 2) (enlarge-type 'add))
      (let ((liste (loop for j in liste
                       when (< j 0) collect (cond ((equal enlarge-type 'add)
                                                   (+ step j))
                                                  ((equal enlarge-type 'augmented)
                                                   (* factor j)))
                       else collect j)))
        (loop 
          for i in liste
          
          with repl = (rnd-pick (remove 0 liste :test #'>))
          with cnt = 0
          when (and (equal i repl)
                    (< cnt items)) 
          collect (* -1 (abs repl)) and do (incf cnt)
          else collect i)))
           
    
    ;;;; examples-1 -> ONE generation
    ;;;; evaluate a few times to see how it works
    
    (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                             :items 1
                             :enlarge-type 'add) ;enlarge only values < 0
    
    (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                             :items 2
                             :enlarge-type 'add) ;enlarge only values < 0
    
    (modify-lengths-to-rests '(1 1 1 2 2 2 3 3 3 4 4 4 -5 5 5) 
                             :items 3
                             :enlarge-type 'add) ;enlarge only values < 0
    
    ;;;; examples-2 
    ;;;; recursiv - with x-generations
    
    (loop repeat 10
      with seq = '(1 2 3 4 4 4 5 6 7)
      collect (setf seq (modify-lengths-to-rests seq 
                                                 :items 1
                                                 :enlarge-type 'augmented)))
    
    (loop repeat 10
      with seq = '(1 2 3 4 4 4 5 6 7)
      collect (setf seq (modify-lengths-to-rests seq 
                                                 :items 1
                                                 :enlarge-type 'add)))

     

  4. i needed something like that..

    regards

    andré

    (defun rnd-replace/user (item sequence &key (exclude 'nil))
        (loop for i in sequence
          with val
          with pos = (position (car (loop 
                                      do (setf val (nth (random (length sequence)) sequence))
                                      when (null (member val exclude))
                                      collect val into bag
                                      when (= (length bag) 1)
                                      do (return bag))) 
                               sequence)
          for cnt = 0 then (incf cnt)
          when (= cnt pos)
          collect (rnd-pick item)
          else collect i))
    
    (rnd-replace/user '(123 987) '(1 2 3 4 5) :exclude '(1 5))

     

  5. works fine:

    (rnd-replace '(123) '(1 2 3 4))

    => (1 2 3 123)

     

    don't work ... why?

    (rnd-replace '(123) '(1 2 3 4) :exclude '(2 3))

    => 

    > Error: The value 1 is not of the expected type list.
    > While executing: pos-rep, in process Listener-1(6).
    > Type cmd-. to abort, cmd-\ for a list of available restarts.
    > Type :? for other options.

  6. don't know if this already exists in the library

    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; chord-multiplication like boulez ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    (defun chord-multiplication (chord1 chord2 &key (chord 'nil))
      (let ((liste (sort-asc (remove-duplicates (loop for i in chord1
                           append (pitch-transpose-start i chord2))))))
        (if (equal chord 't)
          (chordize liste)
          (append liste))))
        
    (defun all-chord-multiplications (liste &key (chord 'nil))
      (let ((liste (loop for i in (combination 2 liste)
                     collect (chord-multiplication (first i) (second i)))))
        (if (equal chord 't)
          (chordize liste)
          (append liste))))
    
    
    ;;; EXAMPLES
    ;;; with 2 chords
    (chord-multiplication '(eb4 a4 d5) '(ab4 g5) :chord 't)
    
    ;;; all possible multiplications (combinations of 2) in a diveded list
    (setf divided-list '((eb4 a4 d5) (ab4 g5) (e4 gs4 db4) (b3 f4 bb4 c5)))
    (all-chord-multiplications divided-list :chord 't)
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     

     

  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    ;;;; A WAY TO MUTATE/MODIFY A PROPORTION-LIST FOR "gen-length-constant"
    ;;;; the SUM in all generations is CONSTANT
    
    ;;;; FUNCTION
    (defun modify-prop-seq (generations values &key (value-step 1) (chance 1.0))
      (append (list values)
              (loop repeat (- generations 1)
                with rnd-seq 
                with new-seq
                
                do (if (prob? chance)
                     (setq rnd-seq (rnd-sample-seq 2 values)
                           new-seq (list (+ (car rnd-seq) value-step) (- (car (rest rnd-seq)) value-step))
                           values (loop for i in (pattern-map  (list (append (list rnd-seq) (list new-seq))) values)
                                    when (> i 0) 
                                    collect i))
                     (append values))
                
                collect values)))
    
    ;;;; tests
    (modify-prop-seq 5 '(1 2 3 4 5 6 7 8 9))
    (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.9)
    (modify-prop-seq 5 '(4 4 4 4 4) :value-step 1 :chance 0.5)
    
    
    ;;;; practical-use -> every generation in 1 bar
    (loop for i in (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.8)
      collect (gen-length-constant i '4/4))
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     

  8. ;;;; function (-> don't know if this is already existing in opusmodus)
    
    (defun expand-intervals/integers (seq &key (type 'add) (value 1))
      (cond ((equal type 'add)
             (loop for i in seq
               when (> i 0)
               collect (+ i value)
               when (< i 0)
               collect (- i value)
               when (= i 0)
               collect i))
            ((equal type 'multiply)
             (loop for i in seq
               collect (* i value)))
            ((equal type 'expt)
             (loop for i in seq
               when (>= i 0)
               collect (expt i value)
               else collect (* (expt i value) -1)))
            ((equal type 'fibonacci)
             (loop for i in seq
               when (>= i 0)
               collect (+ i (fibonacci i))
               else collect (- i (fibonacci (abs i)))))))
             
    ;;; examples 
                 
    (expand-intervals/integers '(0 -1 1 -2 2 -3 3)
                               :type 'add
                               :value 2)
    
    (expand-intervals/integers '(0 -1 1 -2 2 -3 3)
                               :type 'multiply
                               :value 2)
    
    (expand-intervals/integers '(0 -1 1 -2 2 -3 3)
                               :type 'expt
                               :value 2)
            
    (expand-intervals/integers '(0 -1 1 -2 2 -3 3 -4 4 -5 5)
                               :type 'fibonacci)
    

     

  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;;PERMUTE-SYMMETRCIAL -> seq of any lengths;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    ;;; SUB
    
    (defun divide-seq-length (seq)
      (if (evenp (length seq))
        (/ (length seq) 2)
        (/ (1- (length seq)) 2)))
      
    
    ;;; MAIN
    
    (defun permute-symmetrical (row &key (chance 0.5))
      (let ((1st (loop repeat (divide-seq-length row)
                   for cnt = 0 then (incf cnt)
                   collect (nth cnt row)))
            (2nd (loop repeat (divide-seq-length row)
                       for cnt = (- (length row) 1) then (decf cnt)
                       collect (nth cnt row))))
    
        (loop 
          for i in 1st
          for j in 2nd
    
          when (prob? chance)
          collect j into 1st-bag and collect i into 2nd-bag
          else collect i into 1st-bag and collect j into 2nd-bag
    
          when (= (length 1st-bag) (divide-seq-length row))
          do (return (if (evenp (length row))
                       (append 1st-bag (reverse 2nd-bag))
                       (append 1st-bag (list (nth (length 1st) row)) (reverse 2nd-bag)))))))
      
    
    ;;; EXAMPLE
    
    (pitch-list-plot 
     (permute-symmetrical '(a4 bb4 ab4 b4 g4 c5 fs4 cs4 f4 d4 e4 eb4) ;zimmermann-row
                          :chance 0.3))
    
     

     

  10. for further ideas: i think it's a good solution to work with "structures" = "datasets" and a "machine" who generates output based on these datas.

     

    ... your "machine" will pick its rules/datas... from there, so you have good possibilties to work with more then one dataset, and give also a feedback on this sets (such a dataset is like a "GENOM", and the machine produces its outputs based on this "GENOM" but also influences it = feeback)...

     

    an dataset-example from my current project...

    ;;; defines a  structure called  CHORDSET
    
    (defstruct chordset 
      name
      interval-seq
      interval-direction
      startpitch
      durations
      rhy
      velocity
      cresc-dim
      seq-length
      rotate-dynmics
      sampling-types
      form-types
      data1)
    
    ;;;  VARIABLE CHORD1 will be  "filled" with datas in this structure -> see "make-chordset"
    
    (setf chord1 
          (make-chordset
           :name 'chord1
           :interval-seq '(3 5 3 3 5 3 3 5 3 3)
           :interval-direction '((up 0.5) (down 0.5))
           :startpitch '(c4 gs4)
           :durations '1
           :rhy '((1/32 0.4) (1/20 0.4) (1/12 0.2))
           :velocity (weighted-random '(((pppp ppp pp p mp mf mp p pp ppp pppp) 0.5)
                                        ((p p p mp mp mf mp mp p p p) 0.5)))
           :cresc-dim '(pppp p)
           :seq-length '((3 0.3) (5 0.3) (7 0.1) (11 0.3))
           :form-types '(crippled asymmetric symmetric broken)
           :sampling-types '(rnd from-center)))
    
    
    ;;; every  data could be read by (for example)
    	(chordset-startpitch chord1)
    	=>  (c4 gs4)
    ;;; or could be rewritten by
    	(setf (chordset-startpitch chord1) 'c3)
    ;;; then:
    	(chordset-startpitch chord1)
    	=>  c3
    

     

    => the machine reads this self-definied datas and generating output (like YOUR program)

    => an perhaps when some patterns are recognized (in the production-process) there could be an influence on the dataset

         -> rewrite the dataset

     

    => that's a way to control and design such recursiv-production-systems, but there are also many other ways...

     

    i hope that helps you - and i hope i did not misunderstand  your ideas/code...

    regards

    andré 

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

     

  12. 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)

     

     

     

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

     

  14. 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)))

     

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

     

  16. 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é

     

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy