Dear All,

Here is a function I created (vibe coded) with NotebookLM/Gemini to create melodic countour of any sequence of pitches. It works with OMN expressions and also with chords. In the case of chords, you must count how many voices there is in the chords in order to create a countour. After processing (melodizing), the function puts the chords back to its place.

Best,

Julio

EXAMPLE

(setf contornos '((1 2 3) (3 1 2) (2 3 1) (1 3 2) (2 1 3) (3 2 1)))
(setf sequencia (gen-divide 3 (gen-repeat 10 '(q c4 e4 g4))))
(contour-mel-poly sequencia contornos)

ORIGINAL

(contour-mel-poly (gen-divide 4 (flatten sequencia)) '(0.5 0.49 2))
;; can be any number

(defun contour-mel-poly (omn-exp contornos)
  "Ordena alturas e acordes segundo um contorno melódico (ranking), 
   ajustando as oitavas para satisfazer a hierarquia do contorno."
  (let* ((dis (disassemble-omn omn-exp))
         (pitches (getf dis :pitch))
         (num-bars (length pitches))
         ;; 1. Alinha a lista de contornos ao número de compassos [2]
         (contorno-list (gen-trim num-bars (if (listp (car contornos)) contornos (list contornos)))))

    (labels ((apply-contour-logic (bar-ints contour)
               "Processa uma lista de inteiros (melodia/acordes) aplicando o contorno."
               (let* (;; A. Melodize: trata tudo como uma sequência linear de notas
                      (flat-ints (flatten bar-ints))
                      (pcs (mapcar (lambda (x) (mod x 12)) flat-ints))
                      (num-notes (length pcs))
                      ;; B. Cria mapeamento (PC, Rank-Alvo, Posição-Original)
                      (pos-rank-pairs (loop for pc in pcs 
                                            for rank in contour 
                                            for pos from 0
                                            collect (list :pc pc :rank rank :pos pos)))
                      ;; C. Ordena pelo ranking para definir as oitavas progressivamente
                      (sorted-by-rank (sort (copy-list pos-rank-pairs) #'< 
                                            :key (lambda (x) (getf x :rank))))
                      (last-val -999)
                      (final-pos-val-pairs nil))

                 ;; D. Atribuição de oitavas baseada no ranking
                 (dolist (item sorted-by-rank)
                   (let* ((pc (getf item :pc))
                          (pos (getf item :pos))
                          (oct 0)
                          (candidate (+ (* oct 12) pc)))
                     ;; Garante que Rank N > Rank N-1 (satisfaz posição aberta/fechada)
                     (while (<= candidate last-val)
                        do (setf oct (1+ oct))
                           (setf candidate (+ (* oct 12) pc)))
                     (setf last-val candidate)
                     (push (cons pos candidate) final-pos-val-pairs)))

                 ;; E. Restaura a ordem linear e reagrupa acordes se existiam
                 (let* ((linear-ints (loop for i from 0 below num-notes
                                           collect (cdr (assoc i final-pos-val-pairs))))
                        (idx 0))
                   (mapcar (lambda (evt)
                             (if (listp evt)
                                 (prog1 (loop repeat (length evt) collect (nth idx linear-ints) do (incf idx)) nil)
                                 (prog1 (nth idx linear-ints) (incf idx))))
                           bar-ints)))))

      ;; 2. Processamento por compasso
      (let ((processed-pitches
             (mapcar (lambda (bar contour)
                       (let* ((bar-ints (pitch-to-integer bar))
                              (new-ints (apply-contour-logic bar-ints contour)))
                         ;; Converte de volta para pitches OMN [4]
                         (integer-to-pitch new-ints)))
                     pitches contorno-list)))

        ;; 3. Remontagem OMN final preservando a estrutura original [5]
        (make-omn :pitch processed-pitches
                  :length (getf dis :length)
                  :velocity (getf dis :velocity)
                  :articulation (getf dis :articulation))))))

Much better version. Really cool !!

(defun contour-mel (sequencias contornos)

"Função de contorno melódico com controle de densidade e direção inter-bar."

(let* (;; 1. Desmonta a sequência para isolar os parâmetros [4, 5]

(dis (disassemble-omn sequencias))

(pitches (getf dis :pitch))

(lengths (getf dis :length))

(velocities (getf dis :velocity))

(num-bars (length contornos))

;; Alinha sequências, ritmos e dinâmicas ao número de contornos [6-8]

(p-list (gen-trim num-bars pitches))

(l-list (gen-trim num-bars lengths))

(v-list (gen-trim num-bars (if velocities velocities '(mf))))

;; Variáveis de estado para a Regra de Direção

(prev-last-pitch nil)

(prev-last-contour-val nil)

(final-pitches nil)

(final-lengths nil)

(final-velocities nil))

(loop for bar-p in p-list

for bar-l in l-list

for bar-v in v-list

for bar-c in contornos

do (let* ((num-notes (length bar-c))

;; Funcionalidade 1: Estabelece quantas notas serão processadas

;; Repete a sequência do começo ao fim se o contorno for maior [7, 9]

(ext-p (gen-trim num-notes bar-p))

(ext-l (gen-trim num-notes bar-l))

(ext-v (gen-trim num-notes bar-v))

;; Processamento por Inteiros (c4 = 0) [1, 3, 10]

(ints (pitch-to-integer ext-p))

(pcs (mapcar (lambda (x) (mod x 12)) ints))

;; Reconstrução do Contorno Interno (Ranking) [1, 4]

(pos-rank-pairs (loop for pc in pcs for rank in bar-c for pos from 0

collect (list :pc pc :rank rank :pos pos)))

(sorted-by-rank (sort (copy-list pos-rank-pairs) #'<

:key (lambda (x) (getf x :rank))))

(temp-bar-results (make-array num-notes))

(last-val -9999))

;; Atribui oitavas para satisfazer o contorno interno

(dolist (item sorted-by-rank)

(let* ((pc (getf item :pc))

(pos (getf item :pos))

(oct 0)

(val (+ (* oct 12) pc)))

(while (<= val last-val)

do (incf oct)

(setf val (+ (* oct 12) pc)))

(setf (aref temp-bar-results pos) val)

(setf last-val val)))

;; Funcionalidade 2: Regra de Direção (Concatenação)

(let* ((final-ints (coerce temp-bar-results 'list))

(current-first-val (car bar-c))

(shift 0))

(when (and prev-last-pitch prev-last-contour-val)

(let* ((target-first (car final-ints))

;; Calcula direção baseada no valor numérico do contorno

(direction (cond ((> current-first-val prev-last-contour-val) 'up)

((< current-first-val prev-last-contour-val) 'down)

(t 'same))))

;; Ajusta o bloco inteiro para satisfazer a direção em relação ao compasso anterior

(case direction

(up (while (<= (+ target-first shift) prev-last-pitch)

do (incf shift 12)))

(down (while (>= (+ target-first shift) prev-last-pitch)

do (decf shift 12))))))

;; Aplica a transposição de registro (oitava) necessária

(setf final-ints (mapcar (lambda (x) (+ x shift)) final-ints))

;; Atualiza estado para o próximo compasso

(setf prev-last-pitch (car (last final-ints)))

(setf prev-last-contour-val (car (last bar-c)))

;; Coleta resultados processados

(push (integer-to-pitch final-ints) final-pitches)

(push ext-l final-lengths)

(push ext-v final-velocities))))

;; 4. Remontagem OMN Final [4, 5, 11]

(make-omn :pitch (nreverse final-pitches)

:length (nreverse final-lengths)

:velocity (nreverse final-velocities)

:articulation (getf dis :articulation))))

EXPLANATION

Explanation of New Features:

Density and Repetition Control (Rule 1):

The gen-trim function is used to force the note sublist to match the size of the contour sublist.

If the original sequence is (c4 e4 g4) (3 notes) and the contour is (1 2 3 4 5) (5 numbers), the system expands the sequence to (c4 e4 g4 c4 e4) before applying octave ranking.

Concatenation Direction (Rule 2):

The algorithm stores the last contour value and the last pitch (as an integer) from the previous measure.

When starting a new measure, it compares the first number of the new contour with the previous one. If it is higher, it applies an octave shift to all notes in the current measure until the first note is higher than the last note of the previous measure, thereby preserving the internal contour while ensuring the required directional flow.

Octave Adjustment and Spelling:

The process adheres to the convention where c4 = 0.

The integer-to-pitch lookup ensures notes remain within a usable register, avoiding "zero-octave" errors when applying the system's implicit base offset of 4.

Rhythmic and Dynamic Integrity:

Using disassemble-omn, rhythms (durations) and dynamics (velocities) are extracted and expanded via gen-trim to match each new note generated by the contour, ensuring the final result is a perfectly valid OMN expression ready for notation or playback.