19 Markov Processes

Example 19-1. Ptable functions discussed in Chapter 18.

(define (make-ptable data)
  (let ((total (loop for d in data sum (second d)))
        (sum 0))
    ;; total holds sum of weights in data
    (loop for d in data 
          for v = (first d)      ; outcome to return
          for w = (second d)     ; relative weight
          do (set! sum (+ sum w))
          ;; collect outcome and normalized probability
          collect (list v (/ sum total)))))

(define (pran table)
  ;; return outcome in table according
  ;; to its weighted probability
  (let ((x (random 1.0)))
    ;; x is uniform number < 1.
    (loop for d in table
          for p = (second d)
          when (< x p )   ; x in this segment.
          return (first d))))

Example 19-2. Defining a transition table constructor.

(define (make-ttable data)
  ;; create a transition table from data.
  (loop for trans in data
        for past = (first trans)
        for probs = (rest trans)
        ;; each row transition is a past value and a ptable
        collect (list past (make-ptable probs))))

Interaction 19-1. Creating a transition table from Table 4.

cm> (define coin
      (make-ttable '((h (h .6) (t .4))
                     (t (h .2) (t .8)))))

cm> (pprint coin)
((h ((h 0.6) (t 1.0)))
 (t ((h 0.2) (t 1.0))))
cm>

Interaction 19-2. The equal? general equivalence predicate.

cm> (equal? 1 1)
#t
cm> (equal? 1 1.0)
#f
cm> (equal? 'a 'a)
#t
cm> (equal? '(t t) '(t t))
#t
cm> (equal? '(h t) '(t h))
#f
cm>

Example 19-3. A lookup function to find the ptable for a specified past outcome.

(define (find-ptable ttable past)
  ;; find the row matching past and return its ptable
  (loop for trans in ttable
        for this = (first trans)
        if (equal? this past)
        return (second trans)))

Interaction 19-3. Looking up ptables for past outcomes.

cm> (find-ptable coin 't)
((h 0.2) (t 1.0))
cm> (find-ptable coin 'h)
((h 0.6) (t 1.0))
cm> (find-ptable coin 'xyz)
#f
cm>

Example 19-4. Defining the Markov selection function.

(define (pran table)
  ;; return outcome in table according
  ;; to its weighted probability
  (let ((x (random 1.0)))
    ;; x is uniform number < 1.
    (loop for d in table
          for p = (second d)
          when (< x p )   ; x in this segment.
          return (first d))))

(define (mran ttable past)
  ;; find row matching past and return its ptable
  (let ((ptab (find-ptable ttable past)))
    (if ptab
      (pran ptab)
      #f))) 

Interaction 19-4. Two methods for Markov selection.

cm> (loop with past = 'h 
          repeat 20 
          for y = (mran coin past)
          collect y
          do (set! past y))
(h h t t t h h h h t t t t t h h t t t t)
cm> (loop repeat 20 
          for next = 'h then (mran coin next)
          collect next)
(h h t t t t t h h t t h h t t t h h h t)
cm>

Example 19-5. Comparison of uniform and Markov rhythmic patterns.

(define rhy-table
  '((q  (q .5) (e  2) (e. .75) )
    (e  (e 3) (q 1) )
    (e. (s 1))
    (s  (e 2) (q 1))))

(define tcurve '(0 1 .7 .75 1 1))  ; tempo envelope

(define (markov-rhythms len)
  ;; rhythms generated from first order Markov
  (let ((tbl (make-ttable rhy-table)))
    (process for i below len
             for k = 60 then (drunk k 6 :low 40 :high 80 
                                    :mode :jump)
             for r = 'q then (mran tbl r)
             for d = (* (rhythm r 120)
                        (interpl (/ i len) tcurve))
             output (new midi :time (now) :keynum k
                         :duration d)
             wait d)))

Interaction 19-5. Listening to Markov rhythm patterns.

cm> (events (markov-rhythms 80) "rhy.mid")
"rhy-1.mid"
cm>

Example 19-6. Markov rhythm with start and stop transitions.

(define rhy-table2
  '((start (e. 2) (q 1))
    (q  (q .5) (e  2) (e. .75) (w .2))
    (e  (e 3) (q 1) )
    (e. (s 1))
    (s  (e 2) (q 1))
    (w  (stop 1))))

(define (markov-rhythms2 )
  ;; rhythms generated from first order Markov with
  ;; explicit start and stop transitions.
  (let ((tabl (make-ttable rhy-table2))
        (past 'start))
    (process for k = 60 then (drunk k 6 :low 40 :high 80
                                    :mode :jump)
             for r = (mran tabl past)
             until (equal? r 'stop)
             for d = (rhythm r 120)
             output (new midi :time (now) :keynum k
                         :duration d)
             wait d
             set past = r)))

Interaction 19-6. Listening to Markov rhythm patterns.

cm> (events (markov-rhythms2 ) "rhy.mid")
"rhy-2.mid"
cm>

Example 19-7. Dorian Gregorian Chant

(define dchant 
  '((d4  (d4 .1) (e4 .35) (f4 .25) (g4 .1) (a4 .15))
    (e4  (d4 .35) (f4 .35) (e4 .1) (g4 .1) (a4 .1))
    (f4  (d4 .2) (e4 .2) (f4 .1) (g4 .2) (a4 .12))
    (g4  (d4 .2) (e4 .1) (f4 .3) (g4 .1) (a4 .3) (bf4 .2))
    (a4  (d4 .1) (e4 .2) (f4 .25) (g4 .3) (a4 .1) (bf4 .3))
    (bf4 (a4 1))))

(define (monks1 len chant rhy)
  (let ((tbl (make-ttable chant)))
    (process repeat len
             for k = 'd4 then (mran tbl k)
             output (new midi :time (now)
                         :keynum k duration rhy)
             wait rhy)))

Interaction 19-7. Listening to Markov monks.

cm> (events (monks1 30 dchant .8) "monks.mid")
"monks-1.mid"
cm>

Example 19-8. Markov with external conditional checks.

(define (chant-dur tone dur)
  ;; adjust dur if tone is D, F or A.
  (let ((doub (* dur 2)))
    (if (scale= tone 'd4)
      (odds .7 doub dur)
      (if (scale= tone 'a4)
        (odds .5 doub dur)
        (if (scale= tone 'f4)
          (odds .25 doub dur)
          dur)))))

(define (monks2 end chant rhy oct)
  (let ((tabl (make-ttable chant)))
    (process for k = 'd4 then (mran tabl k)
             for dur = (chant-dur k rhy)
             output (new midi :time (now) 
                         :keynum (transpose k oct)
                         :amplitude .8
                         :duration dur)
             wait dur
             until (and (> (now) end)
                        (scale= k 'd4)))))

Interaction 19-8. Listening to Monks2.

cm> (events (list (monks2 24 dchant .8 12)
                  (monks2 24 dchant .8 0)
                  (monks2 24 dchant .8 -12))
            "monks.mid")
"monks-2.mid"
cm> (events (list (monks2 24 dchant .8 -6)
                  (monks2 24 dchant .8 0)
                  (monks2 24 dchant .8 11))
            "monks.mid")
"monks-3.mid"
cm>

Example 19-9. Markov interval patterns.

(define int-mix 
  '((1 (3 .4) (4 .4) (6 .1))
    (2 (2 .2 ) (3 .4) (4 .4) (6 .1))
    (3 (1 .2 )(2 .6 )  (4 .4) )
    (4 (2 .2 ) (3 .4) (4 .4) )
    (6 (2 .4) (3 .2) (4 .2))))

(define (markov-chorder len int-mix note size ud rhy dur )
  (let ((tabl (make-ttable int-mix))
        (int 1)
        (key (keynum note))
        (chord #f))
    (process repeat len
             set int = (mran tabl int)
             set key = (fit (transpose key (odds ud int (- int)))
                            50 90)
             set chord = (loop with n = key
                               repeat size
                               collect n
                               do 
                               (set! int (mran tabl int))
                               (set! n (transpose n (- int))))
             each c in chord
             output (new midi :time (now)
                         :keynum c duration dur)
             wait rhy)))

Interaction 19-9. Listening to Markov generated harmony.

cm> (events (markov-chorder 25 int-mix 'g4 6 .6 1.2 1.2 ) 
            "chord.mid")
"chord-1.mid"
cm>

Example 19-10. Persistent black and white keys.

(define bw-intervals
  ;; first line of each transition hold weights
  ;; for keys of same color. second lines contains
  ;; weights for moving to other color
  '((0  (0 .5) (2 2) (4 1.5) (5 1) (7 .5) (9 .5) (11 .5)
        (1 .2) (3 .1) (6 .1)  (8 .1) (10 .1))
    (1  (1 .5) (3 2) (6 1.5) (8 1) (10 1) 
        (0 .2) (2 .2) (4 .1)  (5 .1) (7 .1) (9 .1) (11 .1))
    (2  (0 2)  (2 .5) (4 2)   (5 1.5) (7 1) (9 .5)
        (1 .2) (3 .2) (6 .1) (8 .1) (10 .1) (11 .1) )
    (3  (1 2)  (3 .5) (6 1.5) (8 1) (10 .5)
        (0 .1) (2 .2) (4 .2) (5 .1) (7 .1) (9 .1) (11 .1))
    (4  (0 1.5)(2 2)  (4 .5) (5 2) (7 1.5) (9 1) (11 .5)
        (1 .1) (3 .2) (6 .2) (8 .1) (10 .1))
    (5  (0 1)  (2 1.5)(4 2) (5 .5) (7 2) (9 1.5) (11 1)
        (1 .1) (3 .2) (6 .2) (8 .1) (10 .1))
    (6  (1 1.5)(3 2)  (6 .5) (8 2) (10 1.5) 
        (0 .1) (2 .1) (4 .1) (5 .2) (7 .2) (9 .1) (11 .1))
    (7  (0 .5) (2 1)  (4 1.5) (5 2) (7 .5) (9 2) (11 1.5) 
        (1 .1) (3 .1) (6 .2) (8 .2) (10 .1))
    (8  (1 1)  (3 1.5)(6 2) (8 .5) (10 2) 
        (0 .1) (2 .1) (4 .1) (5 .1) (7 .2) (9 .2) (11 .1))
    (9  (0 .5) (2 .4) (4 1) (5 1.5) (7 2) (9 .5) (11 2) 
        (1 .1) (3 .1) (6 .1) (8 .2) (10 .2))
    (10 (1 .5) (3 1) (6 1.5) (8 2) (10 .5) 
        (0 .1) (2 .1) (4 .1) (5 .1) (7 .1) (9 .2) (11 .2))
    (11 (0 .5) (2 .5) (4 .5) (5 1) (7 1.5) (9 2) (11 0.5)
        (1 0.1) (3 .1) (6 .1) (8 .1) (10 .2))))

(define bw-octaves
  '((c3 (c3 2)   (c4 1)  (c5 .5) (c6 .25))
    (c4 (c3 1)   (c4 2)  (c5 1)  (c6 .5))
    (c5 (c3 .5)  (c4 1)  (c5 2)  (c6 1))
    (c6 (c3 .25) (c4 .5) (c5 1)  (c6 2))))

(define (bw len oct rate)
  (let ((ints (make-ttable bw-intervals))
        (octs (make-ttable bw-octaves))
        (reps 0)
        (int 0))
    (process repeat len
             if (= reps 0)
             set reps = (pick 4 8 12 16)
             and set oct = (mran octs oct)
             set int = (mran ints int)
             output (new midi :time (now)
                         :keynum (transpose oct int)
                         :duration (* rate 1.5))
             wait rate
             set reps = (- reps 1))))

Interaction 19-10. Listening to Black and White.

cm> (events (bw 120 'c4 .125) "bw.mid")
"bw-1.mid"
cm> (events (list (bw 120 'c4 .125)
                  (bw 120 'c3 .125))
            "bw.mid"         '(0 4))
"bw-2.mid"
cm> (events (list (bw 120 'c4 .125)
                  (bw (* 120 21/13) 
                      'c4
                      (* .125 13/21)))
            "bw.mid")
"bw-3.mid"
cm>

Example 19-11. Happy Birthday, data and player.

(define bday
  (note '(c4 c d c f e c c d c g f 
          c c c5 a4 f e d bf bf a f g f)))

(define (play-bday order reps rate)
  ;; process to play happy birthday in various orders.
  (let ((pat (markov-analyze bday :order order 
                             :print? false)))
    (process repeat reps
             output (new midi :time (now)
                         :keynum (next pat)
                         :duration (* rate 1.5))
             wait rate)))

Interaction 19-11. Listening to zero order Happy Birthday.

cm> (events (play-bday 0 40 .15) "bday.mid")
"bday-1.mid"
cm>

Interaction 19-12. Listening to first order Happy Birthday.

cm> (events (play-bday 1 40 .15) "bday.mid")
"bday-2.mid"
cm>

Interaction 19-13. Listening to second order Happy Birthday.

cm> (events (play-bday 2 40 .15) "bday.mid")
"bday-3.mid"
cm>

Interaction 19-14. Listening to Happy Birthday, orders 3, 4 and 5.

cm> (events (play-bday 3 40 .15) "bday.mid")
"bday-3.mid"
cm> (events (play-bday 4 40 .15) "bday.mid")
"bday-4.mid"
cm> (events (play-bday 5 40 .15) "bday.mid")
"bday-5.mid"
cm>

Chapter Source Code

The source code to all of the examples and interactions in this chapter can be found in the file markov.cm located in the same directory as the HTML file for this chapter. The source file can be edited in a text editor or evaluated inside the Common Music application.