code modify the pitch contour in a pitch-field

[AM]

greetings

andré

;;; MODIFY THE PITCH CONTOUR inside a pitchfield or tonality
;;; please evaluate the example and have a look to the contours

;;; subfunction

(defun position-items (items alist)
  (loop 
    for item in items
    append (position-item item alist)))


;;; function

(defun compr/expand-melody (melody field &key (type 'add) (n 1) (shift 0))
  (let* ((ints (loop for i in  (difference 
                                (position-items (pitch-to-midi melody) 
                                                (pitch-to-midi field)))
                 collect (cond ((equal type 'add)
                                (cond ((<= i -1)
                                       (- i n))
                                      ((>= i 1)
                                       (+ i n))
                                      (t i)))

                               ((equal type 'fibonacci)
                                (cond ((>= i 1)
                                       (+ i (fibonacci i)))
                                      ((<= i -1)
                                       (- i (fibonacci (abs i))))
                                      (t i)))

                               ((equal type 'summativ)
                                (cond ((>= i 1)
                                       (+ i (+ i n)))
                                      ((<= i -1)
                                       (- i (+ (abs i) n)))
                                      (t i)))))))

    (position-filter
     (x+b (interval-to-integer ints :start (car  (position-items melody field))) shift)
     field)))



;;; expand 1a

(progn
  (setf seed (random 100))

  (pitch-list-plot
   (list
    

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 1)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 2)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 3)

        (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 5)
    
   (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed))
   
   :join-points t))


;;; expand 1b => using shift (changed startposition)

(progn
  (setf seed (random 100))

  (pitch-list-plot
   (list
    

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 1
                         :shift 1)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 2
                         :shift 2)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 3
                         :shift 3)

        (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n 5
                         :shift 4)
    
   (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed))
   
   :join-points t))



;;; compress 

(progn
  (setf seed (random 100))

  (pitch-list-plot
   (list
    

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n -1)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n -2)

        (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'add
                         :n -3)

    
   (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed))
   
   :join-points t))



;;; expand 2 with fibonacci

(progn
  (setf seed (random 100))

  (pitch-list-plot
   (list
    
    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'fibonacci)
    
    (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed))
   
   :join-points t))



;;; expand 3 summativ

(progn
  (setf seed (random 100))

  (pitch-list-plot
   (list
    

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'summativ
                         :n 1)

    (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1)  :type :pitch) :seed seed) 
                         (gen-sieve '(c1 c9) '(2 1 1) :type :pitch)
                         :type 'summativ
                         :n 2)

    
   (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed))
   
   :join-points t))

 

 

some evaluations -> different melodic contours (rnd / in a sieve) and its expansions

 

[AM]

generate some examples...

 

;;; evaluate shift-cmd-e

(progn
  ;gen a sieve
  (setf sieve (gen-sieve '((c0 c5) (c3 c6) (c4 c8))
                        '((14 1 2) (5 5 1 2) (6 2 1))
                        :type :pitch))

  ; gen a line inside the sieve
  (setf sample (append (gen-rotate (random 8) 
                                   (pick-sample-from-center sieve (rnd-pick '(7 11))))
                     ))

  (pitch-list-plot
   (list
    ; gen modified loines with "compr/expand-melody"
    (setf line1 sample)

    (setf line2 (compr/expand-melody sample 
                                      sieve
                                      :type 'add
                                      :n 1
                                      :shift -5))

    (setf line3 (compr/expand-melody sample 
                                      sieve
                                      :type 'add
                                      :n 2
                                      :shift -8))

    (setf line4 (compr/expand-melody sample 
                                      sieve
                                      :type 'add
                                      :n 3
                                      :shift -11)))
   
   :join-points t)



  (setf chordseq (loop 
                   for i in line1
                   for j in line2
                   for k in line3
                   for l in line4
                   
                   append (chordize (list i j k l)))))




;;; ecvaluate with command2
(setf omn (list 's chordseq))
(setf omn (flatten (list 't line1 '-h 't line2 '-h 't line3 '-h 't line4)))

 

[opmo]

I might add this function to the system, well done 

[AM]

perhaps you have some better ideas - ...perhaps with range/ambitus... sometimes in trouble - but i only use it for my current work, and so it's no problem

 

could be nice if you could do the add-system also with an external list input -> not fibonacci or primes or sum, but perhaps also with any integer or float list. so MODIFY-function could be done with any DATA...

 

and perhaps it could be also nice for LENGTH and DYNAMICS, i would like that (all-in-one)

Edited May 27, 2019 by AM
edited