Jump to content
Sign in to follow this  
AM

find-intervals*

Recommended Posts

Posted (edited)

i coded it to analyze a pitchfield

 

;;; a function witch filters/shows you all pitch-combinations by INTERVAL-SIZE
;;; from 1 to 11 ("octave-independent")

;;; for example you are interested to see all FIFTH-combinations in a SIEVE
;;; or to LIST all resulting/ordered intervals

(defun equal/or (n alist)
  (car (loop for i in alist
         when (equal i n) collect 't)))

;;; FUNCTION

(defun find-intervals* (pitch-seq &key (intervals 'all) (chord nil) (reduced-interval nil))
  (let ((combs (combination 2 pitch-seq))
        (ints)
        (int)
        (all-comb-pitches-intervals))
    (progn
      (setf ints (loop for i in combs 
                   do (setf int (car (pitch-to-interval i)))
                   when (>= int 0)
                   collect (cond ((and (>= int 12) (<= int 24) (equal reduced-interval nil))
                                  (- int 12))
                                 ((and (>= int 24) (equal reduced-interval nil))
                                  (- int 24))
                                 (t int))))
      
      (setf all-comb-pitches-intervals (loop for i from 1 upto 11
                                         append (loop for j in (loop
                                                                 for x in combs
                                                                 for y in ints
                                                                 collect (cons y x))
                                                  when (= (car j) i)
                                                  collect j)))


      (if (equal intervals 'all+int)
        all-comb-pitches-intervals

        (if (equal intervals 'all)
          (loop for i in all-comb-pitches-intervals
            when (equal chord t)
            collect (chordize (rest i))
            else collect (rest i))
          
          (loop for i in all-comb-pitches-intervals
            when (if (listp intervals)
                   (equal/or (car i) intervals)
                    (= (car i) intervals));  when (= (car i) intervals)
            collect (if (equal chord t) 
                      (chordize (rest i))
                      (rest i))))))))


;;; EXAMPLES

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                 :intervals '(1 5 7) ;; as list
                 :reduced-interval t ;; -> only on/in the same octave
                 :chord nil)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals '(1 3 7)
                   :chord t)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 'all
                   :chord t)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 2
                   :chord t)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 3)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 5)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 7)

(find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch)
                   :intervals 'all)

 

other example -> cmd3

 

(setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch))
;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch))
;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6))

(append (find-intervals* seq 
                         :intervals 1
                         :chord t)

        (find-intervals* seq 
                         :intervals 2
                         :chord t)

        (find-intervals* seq 
                         :intervals 5
                         :chord t)

        (find-intervals* seq 
                         :intervals 6
                         :chord t)

        (find-intervals* seq 
                         :intervals 8
                         :chord t))


(find-intervals* seq 
                 :intervals 'all
                 :chord t)



;;; with interval-sizes in output-format

(find-intervals* seq 
                 :intervals 'all+int)

=> ((1 a3 bb5) (1 b3 c4) (1 b3 c6) (1 c4 cs4) (1 cs4 d4) (1 cs4 d6) (1 d4 eb5) (1 gs4 a5) (1 a5 bb5) (1 bb5 b5) (1 b5 c6) (2 f3 g5) (2 a3 b3) (2 a3 b5) (2 b3 cs4) (2 c4 d4) (2 c4 d6) (2 cs4 eb5) (2 d4 e4) (2 e4 fs6) (2 gs4 bb5) (2 g5 a5) (2 a5 b5) (2 bb5 c6) (2 c6 d6) (3 f3 gs4) (3 a3 c4) (3 a3 c6) (3 b3 d4) (3 b3 d6) (3 c4 eb5) (3 cs4 e4) (3 e4 g5) (3 gs4 b5) (3 eb5 fs6) (3 g5 bb5) (3 a5 c6) (3 b5 d6) (4 f3 a3) (4 f3 a5) (4 a3 cs4) (4 b3 eb5) (4 c4 e4) (4 d4 fs6) (4 e4 gs4) (4 gs4 c6) (4 eb5 g5) (4 g5 b5) (4 bb5 d6) (4 d6 fs6) (5 f3 bb5) (5 a3 d4) (5 a3 d6) (5 b3 e4) (5 cs4 fs6) (5 d4 g5) (5 e4 a5) (5 g5 c6) (5 a5 d6) (6 f3 b3) (6 f3 b5) (6 a3 eb5) (6 c4 fs6) (6 cs4 g5) (6 d4 gs4) (6 e4 bb5) (6 gs4 d6) (6 eb5 a5) (6 c6 fs6) (7 f3 c4) (7 f3 c6) (7 a3 e4) (7 b3 fs6) (7 c4 g5) (7 cs4 gs4) (7 d4 a5) (7 e4 b5) (7 gs4 eb5) (7 eb5 bb5) (7 g5 d6) (7 b5 fs6) (8 f3 cs4) (8 b3 g5) (8 c4 gs4) (8 cs4 a5) (8 d4 bb5) (8 e4 c6) (8 eb5 b5) (8 bb5 fs6) (9 f3 d4) (9 f3 d6) (9 a3 fs6) (9 b3 gs4) (9 c4 a5) (9 cs4 bb5) (9 d4 b5) (9 eb5 c6) (9 a5 fs6) (10 f3 eb5) (10 a3 g5) (10 b3 a5) (10 c4 bb5) (10 cs4 b5) (10 d4 c6) (10 e4 d6) (10 gs4 fs6) (11 f3 e4) (11 a3 gs4) (11 b3 bb5) (11 c4 b5) (11 cs4 c6) (11 e4 eb5) (11 gs4 g5) (11 eb5 d6) (11 g5 fs6))

 

 

perhaps OPMO could extend it to an omn-format-FILTER - so that all other pitches (not matched pitches/sets) would be repaced by rests? would be interesting to work like that with pitchfields/sieves.

so you could choose ...for example: "want to have all FIFTHS including a pitch like C or Eb or Gs (octave independent)...? 

Edited by AM
optimized function - intervals as lists / search could be limited on 1 octave

Share this post


Link to post
Share on other sites

function edited - some small changes...

 

extended:

:intervals '(1 2 3) -> all these interval-combinations are shown

or

:intervals 2 (like before)

 

new:

:reduced-interval T or NIL (default NIL) -> when T only basic-intervals search (not 1 = 1 & 13 & 25, only in ONE octave)

 

 

small example

 

;;; SIEVE with SYMM_STRUCTURE

(setf sieve1
      (pitch-transpose -6
                       (integer-to-pitch (gen-sieve '((0 39) (0 40)) '((5) (7))))))

(pitch-to-interval sieve1)


;;; search/permutate interval-combinations
(setf pitchlist (find-intervals* sieve1
                                 :intervals '(1 2 3) 
                                 :reduced-interval t 
                                 :chord nil))
(setf pitchlist (rnd-unique (length pitchlist) pitchlist))




;;; change direction of the interval-pairs
(setf pitchlist (loop for i in pitchlist
                  when (prob? 0.4)
                  collect (reverse i)
                  else collect i))


;;; remove immediate repetitions
(setf pitchlist (filter-repeat 1 (flatten pitchlist)))




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


(def-score sieve-scan
           (:title "sieve-scan"
                   :key-signature 'atonal
                   :time-signature '(4 4) 
                   :tempo 90)
  
  (instrument
   :omn (make-omn :pitch pitchlist
                  :length '(t)
                  :velocity '(p)
                  :span :pitch)
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))



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

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×