add-interval-if-length

[Stephane Boussuge]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;       ADD-INTERVAL-IF-LENGTH                    ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; USAGE
#|
(setf seq '((e c4 p stacc d4 stacc e4 stacc f4 stacc q g4 g3)
            (q c4 mf e c6 b5 a5 g5 f5 d5)
            (s e4 f4 e4 d4 q g4 b4 d5)
            (q g5 ff marc g4 marc h c5 )))

; with default parameters
(add-interval-if-length '(1/4 c4 d4 e4 1/8 e4 f4))
(add-interval-if-length seq)
; with specified condition
(add-interval-if-length seq :condition '<)
(add-interval-if-length seq :condition '=)
; with specifird conditions en length value specification
(add-interval-if-length seq :condition '= :length-val '1/4)
|#



;;; CODE
;;; ==============================================
;;; UTILITY FUNCTIONS
(defun add-interval-if-length-greater* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (> (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-greater (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-greater* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-greater* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-greater '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11))

;(add-interval-if-length-greater* '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11))


(defun add-interval-if-length-lesser* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (< (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-lesser (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-lesser* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-lesser* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-lesser '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :length-val '1/2 :interval-list '(10 11))

;(add-interval-if-length-lesser '(q c4 d4 e4 f4 e g4 a4) :length-val '1/4 :interval-list '(10 11))


(defun add-interval-if-length-equal* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (equal (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-equal (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-equal* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-equal* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-equal '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :length-val '1/4 :interval-list '(10 11))

;(add-interval-if-length-equal '(q c4 d4 e4 f4 e g4 a4) :length-val '1/4 :interval-list '(10 11))

;(add-interval-if-length-equal '(q c4 d4 e4 f4 e g4 a4) :length-val 'q :interval-list '(10 11))



;;; MAIN FUNCTION
;;; =============================
(defun add-interval-if-length (omn &key (condition '>) (length-val '1/8)(interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (do-verbose
      ("add-interval-if-length")
    (if (equal condition '>)
      (add-interval-if-length-greater omn :length-val length-val :interval-list interval-list)
      (if (equal condition '<)
        (add-interval-if-length-lesser omn :length-val length-val :interval-list interval-list)
        (if (equal condition '=)
          (add-interval-if-length-equal omn :length-val length-val :interval-list interval-list)
          )))))



         
        
      

SB.

[torstenanders]

Nice idea! I reduced your code a bit by using case instead of nested if statements, and in particular higher-order programming. This should do this same.

 

Moreover, you can now do things you could not do before like comparing with >=.

 

(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)

=> ((q c4eb4 mf q d4fs4 mf q e4g4 mf q f4a4 mf e g4 mf e a4 mf) (e f4 mf e e4 mf q d4f4 mf q c4e4 mf q a4c5 mf q g4b4 mf h f4gs4 mf))

 

Best,

Torsten

 

;;; ==============================================
;;; UTILITY FUNCTIONS
;;;
(defun add-interval-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (funcall test (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

;(add-interval-if-length-aux '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11))

;;; =============================
;;; MAIN FUNCTION
(defun add-interval-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (do-verbose ("add-interval-if-length")
    (let ((test-fn (case test
                     (> #'>)
                     (< #'<)
                     (= #'=)
                     (otherwise test))))
      (if (listp (car omn))
        (mapcar #'(lambda (x) 
                    (add-interval-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)) 
                omn)
        (add-interval-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)))))
  

;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11))
;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)

 

[Stephane Boussuge]

Thank you very much Torsten !

 

all the best

 

Stéphane