best normal form

[Rick Taube]

here is a function that returns the Best Normal Form of some specified
notes.


? (normal-form '( f4 e4 ef5 bf4))

(DS5 E5 F5 AS5)

(0 1 2 7)


-----


(defun normal-form (notes)

  (flet ((ints (l &aux (f (first l)))

           (loop for i in l collect (- i f))))

    (let ((length (length notes))

          (width most-positive-fixnum)

          (names? (and notes (symbolp (first notes))))

          norml ints)

      

      ;; coerce to degrees ordered low to high

      (setf notes (sort (if names? (mapcar #'degree notes) notes)

                        #'<<))

      

      ;; reduce to one octave, resort if necessary

      (loop with resort? = nil

            with f = (first notes)

            for i below length

            for d = (- (elt notes i) f)

            do 

            (unless (<< d 12)

              (setf (elt notes i) (+ f (mod d 12))

                    resort? t))

            finally 

            (when resort? (setf notes (sort notes #'<<))))

      

      ;; find the best normal form, ie the rotation with the

      ;; smallest span between the first and last notes and

      ;; the smallest total interval content.

      (loop with f and l and d

            repeat length

            do

            (setf f (first notes) l (first (last notes)) d (- l f))

            (cond ((<< d width) 

                   (setf width d norml notes ints (ints notes)))

                  ((and (= d width)

                        (<< (apply #'+ (ints notes))

                           (apply #'+ ints)))

                   (setf norml notes ints (ints notes))))

            ;; traspose first note above last and append

            (loop while (<< f l) do (incf f 12))

            (setf notes

                  (loop for x in (cdr notes)

                        collect x into r

                        finally (return (append r (list f)))))) 

      ;; returns notes in best normal order and interval set.

      (values (if names? (mapcar #'note norml) norml)

              ints))))