brownian bridge ornaments

Here is a function (with subfunctions) that operates based on the principle of the Brownian bridge. You define the start and end, and with each generation, an extended embellishment emerges. The principle is simple and allows for the creation of ornaments. Attached are some examples — I’ve structured them this way to make the principle easier to understand.

Here is a small graphical model showing four generations. The start and end points remain the same, while new random points are added in between with each generation.

The Code & Examples

(defun pick (a b &key (span 5))
  (let ((rnd1 (car (rnd-number 1 (+ a span) (- a span))))
        (rnd2  (car (rnd-number 1 (+ b span) (- b span))))
        (n))
    (progn
      (setf n (car (rnd-number 1 rnd1 rnd2)))     
      (if (or (= n a) (= n b))
        (+ (rnd-pick '(1 -1)) n)
        n))))


(defun gen-brownian-bridge (n startend &key (all-gen nil) (output 'integer) (span 5))
  (let ((seq)
        (liste startend))
    (progn
      (setf seq (append (list startend)
                        (loop repeat n
                              do (setf liste (filter-repeat 1 (loop repeat (1- (length liste))
                                                                    for cnt = 0 then (incf cnt)
                                                                    append (append (list (nth cnt liste) 
                                                                                         (pick (nth cnt liste) 
                                                                                               (nth (1+ cnt) liste) 
                                                                                               :span span)
                                                                                         (nth (1+ cnt) liste))))))
                              collect liste)))
      (setf seq (if (equal all-gen t)
                    seq
                  (car (last seq))))
      (if (equal output 'pitch)
          (integer-to-pitch seq)
        seq))))


(defun remove-duplicates-keep-edges (lst)
  "Entfernt innere Duplikate aus LST, behält aber den ersten und letzten Wert unabhängig von Wiederholungen."
  (let* ((first (first lst))
         (last (car (last lst)))
         (len (length lst))
         (result '())
         (seen '())
         (index 0))
    (dolist (el lst (reverse result))
      (cond
        ;; Ersten Wert immer behalten
        ((= index 0)
         (push el result)
         (push el seen))
        ;; Letzten Wert immer behalten
        ((= index (1- len))
         (push el result))
        ;; Innere Duplikate von first oder last überspringen
        ((or (and (eq el first) (/= index 0))
             (and (eq el last) (/= index (1- len))))
         ;; überspringen
         nil)
        ;; Andere Duplikate vermeiden
        ((not (member el seen))
         (push el result)
         (push el seen)))
      (setf index (1+ index)))))

;(remove-duplicates-keep-edges '(a b c a d e b c))

(defun reset-pitch-sequence (pitch-sequence pitch &key (type 'low))
  (let ((pitch1 (cond  ((equal type 'low)
                        (car (get-ambitus pitch-sequence :type :pitch)))
                       ((equal type 'high)
                        (cadr (get-ambitus pitch-sequence :type :pitch)))
                       ((equal type 'center) 
                        (center-position-in-list (sort-asc pitch-sequence) :get-value t)))))

    (if (not (omn-formp pitch-sequence))
      (pitch-transpose (car (pitch-to-interval (list (if (chordp pitch1)
                                                       (car (pitch-melodize pitch1))
                                                       (append pitch1))
                                                     pitch))) pitch-sequence)

      (omn-component-replace pitch-sequence
                             (pitch-transpose (car (pitch-to-interval (list (if (chordp pitch1)
                                                                              (car (pitch-melodize pitch1))
                                                     (append pitch1))
                                                                            pitch))) (omn :pitch pitch-sequence))))))

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

;;; only the main function, to see how it works
;;; 6 generations, start with 3 end with 2, span = max inteval/seps
;;; 

(list-plot
 (flatten (gen-brownian-bridge 6 '(3 2) :span 4  :all-gen t))
 :join-points nil :style :fill)


(gen-brownian-bridge 4 '(3 2) :span 3  :all-gen t)

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


;;; example with 6 generations
;;; every generation in an new bar to show how ith works

(omn-list-plot
(progn
  (setf seq (reset-integer-sequence (gen-brownian-bridge 6 '(3 2) :span 4  :all-gen t)))                               
  (setf pitchfield (make-scale 'c4 (find-max (flatten seq)) :alt '(1 1 2 4 7 4 2)))
  (setf pitch (position-filter seq pitchfield))

  (setf rhy 1/16)
  (setf lengths (loop for i in pitch
                        collect (length-rational-quantize (gen-length (gen-repeat (length i) 1) rhy) :round '10/4)))
  (make-omn
   :pitch pitch
   :length lengths))
:join-points nil :style :fill)


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


;;; ALL DUPLCIATIONS INSIDE one PHRASE are removed!!!

;;; example with 6 generations
;;; every generation in an new bar to show how ith works
;;;


(omn-list-plot
(progn
  (setf seq (reset-integer-sequence (loop for i in (gen-brownian-bridge 6 '(3 2) :span 4  :all-gen t)
                                          collect (remove-duplicates-keep-edges i))))

  (setf pitchfield (make-scale 'c4 (find-max (flatten seq)) :alt '(1 1 2 4 7 4 2)))
  (setf pitch (position-filter seq pitchfield))

  (setf rhy 1/16)
  (setf lengths (loop for i in pitch
                        collect (length-rational-quantize (gen-length (gen-repeat (length i) 1) rhy) :round '6/4)))
  (make-omn
   :pitch pitch
   :length lengths))

:join-points nil :style :fill)

      

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