Function gen-string-nat-harm-walk : Generation of walks of natural harmonics for strings

Hello Opusmodus users,

I have made a small function that generates a list of natural harmonics (at sounding pitch) :

• Builds a Markov walk over strings I–IV that never skips a string (I <-> II, II <-> I or II <-> III, III <-> IV, III <-> II, IV <-> III)

• At each step, picks a pitch from the selected instrument’s natural-harmonics list for that string.

• :repeat nil forbids immediate pitch repeats; :repeat t allows them.

• Key words

:instrument lets you choose the instrument (violin, viola, cello or bass)

:start, lets you define the starting string for the sequence

:repeat (t or nil), t allows identical consecutive notes; nil forbids (default t)

:seed, it of course for controling the reproducibility of the random output

Feel free to use it / modify it (for example adding a 5th string for the double bass), etc.

All the best,

Jawher Matmati

;;; ------------------------------------------------------------
;;; Library: Natural harmonics (sounding pitch) for strings
;;; ------------------------------------------------------------
;; Violin
(setf Vln-harm-nat-IV '(g4 d5 g5 b5 d5))
(setf Vln-harm-nat-III (pitch-transpose 7 Vln-harm-nat-IV))
(setf Vln-harm-nat-II (pitch-transpose 7 Vln-harm-nat-III))
(setf Vln-harm-nat-I (pitch-transpose 7 Vln-harm-nat-II))
;; Viola
(setf Vla-harm-nat-IV (pitch-transpose -7 Vln-harm-nat-IV))
(setf Vla-harm-nat-III (pitch-transpose 7 Vla-harm-nat-IV))
(setf Vla-harm-nat-II (pitch-transpose 7 Vla-harm-nat-III))
(setf Vla-harm-nat-I (pitch-transpose 7 Vla-harm-nat-II))
;; Cello
(setf Vlc-harm-nat-IV (pitch-transpose -12 Vla-harm-nat-IV))
(setf Vlc-harm-nat-III (pitch-transpose -12 Vla-harm-nat-III))
(setf Vlc-harm-nat-II (pitch-transpose -12 Vla-harm-nat-II))
(setf Vlc-harm-nat-I (pitch-transpose -12 Vla-harm-nat-I))
;; Bass
(setf Cb-harm-nat-IV '(e2 b2 e3 gs3 b3))
(setf Cb-harm-nat-III (pitch-transpose 5 Cb-harm-nat-IV))
(setf Cb-harm-nat-II (pitch-transpose 5 Cb-harm-nat-III))
(setf Cb-harm-nat-I (pitch-transpose 5 Cb-harm-nat-II))

;;; ------------------------------------------------------------
;;; Adjacent-string Markov transitions (no skipping over strings)
;;; ------------------------------------------------------------
(setf string-adjacent-transitions
'((I (I 1) (II 1))
  (II (I 1) (II 1) (III 1))
  (III (II 1) (III 1) (IV 1))
  (IV (III 1) (IV 1))))

;;; ------------------------------------------------------------
;;; gen-string-nat-harm-walk
;;; ------------------------------------------------------------
;; n number of notes to generate
;; :instrument 'Violin | 'Viola | 'Cello | 'Bass (default 'Violin)
;; :repeat t allows identical consecutive notes; nil forbids (default t)
;; :start 'first | '?' | one of 'I 'II 'III 'IV (default '?)
;; :seed integer for reproducible state walk (passed to GEN-MARKOV-FROM-TRANSITIONS)

(defun gen-string-nat-harm-walk
       (n &key (instrument 'violin) (repeat t) (start '?) seed)
  (labels
      (;; map (instrument, string) -> the corresponding harmonic list
       (string-pool (inst s)
         (case inst
           (violin (case s (I Vln-harm-nat-I) (II Vln-harm-nat-II)
                     (III Vln-harm-nat-III) (IV Vln-harm-nat-IV)))
           (viola (case s (I Vla-harm-nat-I) (II Vla-harm-nat-II)
                    (III Vla-harm-nat-III) (IV Vla-harm-nat-IV)))
           (cello (case s (I Vlc-harm-nat-I) (II Vlc-harm-nat-II)
                    (III Vlc-harm-nat-III) (IV Vlc-harm-nat-IV)))
           (bass (case s (I Cb-harm-nat-I) (II Cb-harm-nat-II)
                   (III Cb-harm-nat-III) (IV Cb-harm-nat-IV)))
           (otherwise (error "Unknown instrument: ~a" inst))))

       ;; is there at least one element in pool different from LAST?
       (has-alternative (pool last)
         (loop for p in pool thereis (not (eql p last))))

       ;; pick one pitch from the relevant pool; honour :repeat NIL
       (pick-pitch (pool last)
         (let ((choice (rnd-pick pool)))
           (if (and (not repeat) last (eql choice last) (has-alternative pool last))

               ;; re-pick until different (keeps pool weighting)
               (loop for c = (rnd-pick pool)
                     until (not (eql c last))
                     finally (return c))
             choice))))

    (let* ((states (gen-markov-from-transitions
                    string-adjacent-transitions
                    :size n :start start :seed seed)))
      (loop
         with last = nil
         for s in states
         for pool = (string-pool instrument s)
         for p = (pick-pitch pool last)
         do (setf last p)
         collect p))))

;;; ------------------------------------------------------------
;;; Examples
;;; ------------------------------------------------------------
;; 24 notes, start anywhere, forbid immediate repeats, for Violin:
(gen-string-nat-harm-walk 24 ; size of the list
                          :instrument 'violin
                          :repeat nil)

;; Start on string II, reproducible state-walk:
(gen-string-nat-harm-walk 24 :instrument 'viola :repeat t :start 'II :seed 123)

;; Cello, start on the first state in the table (I), no repeats:
(gen-string-nat-harm-walk 16 :instrument 'cello :repeat nil :start 'first)