;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; modify time-signatures like '(1 4 3) to (3 4 1),
;;; helps me after (split-tuplet-lengths) to clean up 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; with the :exclude and :threshold
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun modify-time-signature-repetitions (time-signature-seq &key (exclude '((0 0))) (threshold '10/4) (numerator-threshold 20))
  (loop for i in time-signature-seq 
    when (and (> (third i) 1)
              (< (/ (first i) (second i)) threshold)
              (< (* (first i) (third i)) numerator-threshold)
              (not (if (listp (first exclude)) 
                     (loop for x in exclude
                       when (equal (butlast i) x)
                       collect t)
                     (equal (butlast i) exclude))))
    
    collect (list (* (first i) (third i)) (second i) 1)
    else collect i))


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

(setq bars '((5 4 4) (1 4 2) (3 4 2) (1 8 5) (1 32 8)))

(modify-time-signature-repetitions bars)
(modify-time-signature-repetitions bars :exclude '(1 4))
(modify-time-signature-repetitions bars :exclude '((1 4) (1 8)))
(modify-time-signature-repetitions bars :exclude '((1 32)) :threshold '4/4)

(modify-time-signature-repetitions bars :numerator-threshold 7) ;; because i don't want 200/4 - bars :-)


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

 

I will add the MODIFY-TIME-SIGNATURE function to our system - thank you.

I too will add other function as well: COMPRESS-TIME-SIGNATURE

(setq bars '((1 4 4) (1 4 4) (1 4 4) (3 4 2) (1 8 5) (1 8 5)))
(compress-time-signatures bars)
=> ((1 4 12) (3 4 2) (1 8 10))

(modify-time-signature bars)
=> ((4 4 1) (4 4 1) (4 4 1) (6 4 1) (5 8 1) (5 8 1))

(compress-time-signatures (modify-time-signature bars))
=> ((4 4 3) (6 4 1) (5 8 2))

(modify-time-signature (compress-time-signatures bars))
=> ((12 4 1) (6 4 1) (10 8 1))

Interesting 

perfect...! a kind of...  

(compress-time-signatures bars)

was my next step... so... thanx to you!!

perhaps, both in ONE?

Maybe I do that - both in one.

Final function:

(defun modify-time-signature (time-signature &key compress (exclude '((0 0))) (span '10/4) (numerator 20))
  (do-verbose ("modify-time-signature")
    (let ((ts (if compress (compress-time-signatures time-signature) time-signature)))
      (loop for i in ts 
        when (and (> (third i) 1)
                  (< (/ (first i) (second i)) span)
                  (< (* (first i) (third i)) numerator)
                  (not (if (listp (first exclude)) 
                         (loop for x in exclude
                           when (equal (butlast i) x)
                           collect t)
                         (equal (butlast i) exclude))))
        
        collect (list (* (first i) (third i)) (second i) 1)
        else collect i))))

#|
(setq bars '((5 4 4) (1 4 2) (1 4 4) (1 4 4) (1 4 4) (3 4 2) (1 8 19) (1 32 8) (1 8 5) (1 8 5)))

(modify-time-signature bars)
=> ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (19 8 1) (8 32 1) (5 8 1) (5 8 1))

(modify-time-signature bars :compress t)
=> ((5 4 4) (14 4 1) (6 4 1) (19 8 1) (8 32 1) (10 8 1))

(modify-time-signature bars :exclude '(1 4))
=> ((5 4 4) (1 4 2) (1 4 4) (1 4 4) (1 4 4) (6 4 1) (19 8 1) (8 32 1) (5 8 1) (5 8 1))

(modify-time-signature bars :exclude '((1 4) (1 8)) :compress t)
=> ((5 4 4) (1 4 14) (6 4 1) (1 8 19) (8 32 1) (1 8 10))

(modify-time-signature bars :exclude '((1 32)) :span '4/4)
=> ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (19 8 1) (1 32 8) (5 8 1) (5 8 1))

(modify-time-signature bars :numerator 7)
=> ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (1 8 19) (1 32 8) (5 8 1) (5 8 1))
|#