Jump to content

find-intervals*


Recommended Posts

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
Link to comment
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))



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

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy