Jump to content
Sign in to follow this  
AM

another markov game

Recommended Posts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;another little markov-game => markov with "global-tendency"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;a "neutral table with 4 values"
(setq transitions '((1 (1 1) (2 1) (3 1) (4 1))
                    (2 (1 1) (2 1) (3 1) (4 1))
                    (3 (1 1) (2 1) (3 1) (4 1))
                    (3 (1 1) (2 1) (3 1) (4 1))
                    (4 (1 1) (2 1) (3 1) (4 1))))
      
;;;subfunctions

(defun filter-first-last (n sequence)
  (car (filter-last n sequence)))

(defun substitute-transition-weight (transition-list value new-weight)
  (loop 
    for j in transition-list
    collect (append (list (first j))
                    (loop repeat (1- (length j))
                      for cnt = 1 then (incf cnt)
                      when (equal (first (nth cnt j)) value)
                      collect (list (first (nth cnt j)) new-weight)
                      else collect (nth cnt j)))))

;;;mainfuction
(defun markov-with-tendency (transitions size generations value)
(loop repeat generations
   with list = (gen-markov-from-transitions 
                 transitions
                 :size size :start 1)
  with weight = 1
  with weight-add = 0

  do (setq transitions (substitute-transition-weight transitions value weight))
  append (setq list (gen-markov-from-transitions transitions :size size :start (filter-first-last 1 list)))
  do (incf weight (incf weight-add))))


;;;some simulations => evaluate!!!
(list-plot 
  (markov-with-tendency transitions 10 20 1)
  :point-radius 0 :style :fill) 

(list-plot 
 (list
  (markov-with-tendency transitions 10 20 1)
  (markov-with-tendency transitions 10 20 2)
  (markov-with-tendency transitions 10 20 4))
  :point-radius 0 :style :fill) 

(list-plot ;;non-neutral-table
  (markov-with-tendency '((1 (1 1) (2 4))
                          (2 (1 1) (4 1))
                          (3 (1 4) (3 5) (4 3))
                          (3 (1 1) (2 4) (3 2))
                          (4 (1 1) (3 2) (4 3))) 10 20 1)
  :point-radius 0 :style :fill) 

 

Edited by AM
attached missing function

Share this post


Link to post
Share on other sites

you are right, sorry. no computer with me... think you could replace filter-first-last by: (car (last list))

 

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

  • Similar Topics

    • By Stephane Boussuge
      Here is an example of generation of harmonic progression with Opusmodus using chords rules defined with a transition table.
      The technique presented here uses the concept of tonal degrees, but it is important to note that as you will see later in this article, this concept can be pushed quite far and quite outside the traditional tonal system.
       
      First, we define some transition rules from degree to degree:
       
      (setf transition       '((1 (4 1) (5 1) (6 2))         (2 (5 2) (4 1))         (3 (4 1))         (4 (5 1) (2 1))         (5 (1 3) (6 2) (4 1))         (6 (4 1))         (7 (1 1) (6 1))))  
      So here is a transition rule saying  a 1st degree will be 2 times more likely to be followed by a sixth degree (1 (6 2)) as a 4th or 5th (1 (4 1) (5 1) ).
      A second degree will be most likely followed by a 5th degree (2 (5 2) than a 4th (2 (4 1))
      We define this way all the transition rules for each degree of the scale.
       
      We now generate a sequence of degrees we call prog based on these rules with the function GEN-MARKOV-FROM-TRANSITIONS (for more information on Markov chains, you can consult:  https://en.wikipedia.org/wiki/Markov_chain ):
       
      (setf prog (gen-markov-from-transitions transition :size 24 :start 1))  
      which can for example give this result:
       
      => (1 5 1 4 2 4 2 4 2 5 6 4 5 1 5 6 4 5 1 5 6 4 2 5)
       
      Because the function that we'll use to generate chords is based on a numbering starting from zero but our degrees generation is based on a numbering starting from 1, we will subtract 1 to each value of our list prog to able to provide our next function a number list starting from zero.
      To do this, we use the MAPCAR Lisp function to apply -1 to each value of the list and we store the result in the variable prog.prep.
       
      (setf prog.prep (mapcar (lambda(x) (- x 1)) prog)) => (0 4 0 3 1 3 1 3 1 4 5 3 4 0 4 5 3 4 0 4 5 3 1 4)
       
      Now we generate chords using the HARMONIC-PROGRESSION function and store the result in the variable named chords:
       
      (setf chords (harmonic-progression prog.prep '(d4 major)))   
      The parameters passed to the function are our degrees List prog.prep and a scale with a root base (here d4).
       
      Here is the output of this function in notation:
       

       
      Of course, we are not limited to Major and Minor scales, we can use any scale or pitch structure available or generated by Opusmodus, here are some examples:
       
      (setf chords (harmonic-progression prog.prep '(d4 messiaen-mode5)))
      (setf chords (harmonic-progression prog.prep '(c4 acoustic-scale)                                     :root '(d4 f4 g4 e4 bb3)))  

       
      (setf chords (harmonic-progression prog.prep '(d4e4fs4gs4as4c5ds5)                                     :root '(d4 f4 g4 e4 bb3)))  
       

       
      A final example using the keyword :relative  enabling a smoother transition between chords with a relative voice leading between chords. 
       
      (setf chords (harmonic-progression prog.prep '(d4e4fs4gs4as4c5ds5)                                     :root '(d4 f4 g4 e4 bb3)                                     :relative t))  
       

       
      Once these chords generated, you can use them as you want in Opusmodus, map them on musical structures with TONALITY-MAP function or use them as basic materials to create reservoirs of pitch or other kind of pitch material.
       
      SB.
    • By AM
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;gen-chained-sym-vals.by-markov;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; special-symm-sequences ;;; have look at the possible parameters (&key) ;;; it's generates symm-structures via MARKOV ;;; and the could be "chained" between generations ;;; also with symm.structures... like: (also look at CARTER's work) ;;; => ((1 2 5 8 5 2 1) (3 1 2 2 2 1 3) (8 1 3 1 8) (3 1 2 2 2 1 3) (1 2 5 8 5 2 1)) ;;; chains: 2 1 3 1 2 2 1 3 1 2 ;;; or: ;;; => ((e4 f4 c4 e4 d4 e4 c4 f4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 fs4 f4 fs4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 f4 c4 e4 d4... ;;; chains: c4 f4 e4 c4 e4 f4 c4 e4 c4 e4 e4 c4 e4 ........etc....... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; main function with amateur-code :-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-chained-sym-vals.by-markov (&key (generations 'nil) (non-symmetric 'nil) (number-of-vals 20) (basic-seq-lengths '(3 5)) (transition-matrix '((1 (4 1) (5 1) (6 2)) (2 (5 2) (4 1)) (3 (4 1)) (4 (5 1) (2 1)) (5 (1 3) (6 2) (4 1)) (6 (4 1)) (7 (1 1) (6 1)))) (chain-weight 1.0) (possible-chain-length '(1 2 3)) (reduction 0.0) (start-value (car (car transition-matrix)))) (let ((sequence1 0) (sequence2 0) (seq-lengths basic-seq-lengths)) (setq sequence1 (loop repeat (if (equal generations 'nil) (car (list number-of-vals)) (if (equal non-symmetric 'nil) (if (evenp generations) (/ generations 2) (/ (1- generations) 2)) (car (list generations)))) with seq1 with seq with chain1 with slot = (second (gen-markov-from-transitions transition-matrix :size 2 :start start-value)) with seq-splitter = (gen-markov-from-transitions transition-matrix :size (rnd-pick possible-chain-length) :start slot) with seq-lengths = basic-seq-lengths when (equal (prob? chain-weight) 't) do (setq chain1 (append (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot)))) seq-splitter (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot)))))) and do (setq seq (append (butlast chain1) (reverse chain1))) and collect (if (equal (prob? reduction) 't) (append (setq seq (butlast (rest seq)))) (append seq)) else collect (setq seq1 (gen-markov-from-transitions transition-matrix :size (rnd-pick seq-lengths) :start slot) seq (append seq1 (reverse seq1))) do (setq seq-splitter (reverse (filter-last (rnd-pick possible-chain-length) seq))))) (if (equal generations 'nil) (progn (setq sequence2 (filter-first (if (evenp number-of-vals) (/ number-of-vals 2) (/ (1- number-of-vals) 2)) (flatten sequence1))) (if (evenp number-of-vals) (append sequence2 (reverse sequence2)) (append sequence2 (list (rnd-pick (flatten (filter-first 1 transition-matrix)))) (reverse sequence2)))) (if (equal non-symmetric 'nil) (if (evenp generations) (append sequence1 (reverse sequence1)) (append sequence1 (list (gen-sym-markov :seq-length (rnd-pick seq-lengths) :transition-matrix transition-matrix)) (reverse sequence1))) (append sequence1))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; test it! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (gen-chained-sym-vals.by-markov :generations 5 :transition-matrix '((1 (2 1) (3 3) (5 2) (8 1)) (2 (1 2) (5 3)) (3 (1 2) (8 1) (2 3)) (5 (3 2) (2 1) (1 3)) (8 (1 2) (2 2) (3 1)))) (gen-chained-sym-vals.by-markov :generations 5 :transition-matrix '((c4 (d4 1) (e4 3) (f4 2) (fs4 1)) (d4 (c4 2) (f4 3)) (e4 (c4 2) (fs4 1) (d4 3)) (f4 (e4 2) (d4 1) (c4 3)) (fs4 (c4 2) (d4 2) (e4 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
    • By AM
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; WHEN PATTERN-MATCH => T ;;; THEN MARKOV PRODUCES THE NEXT VALUES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; subfunctions (defun pattern-match (liste pattern) (loop for z in liste with cnt = 0 with pattern_cnt = 0 when (or (equal (nth cnt pattern) z) (equal '? (nth cnt pattern))) do (incf pattern_cnt) and do (incf cnt) else do (setq cnt (setq pattern_cnt 0)) when (equal pattern_cnt (length pattern)) collect 't into bag and do (return (car bag)))) (defun test.pm.omn (seq pattern) (let ((seq (if (omn-formp seq) (cond ((lengthp (car pattern)) (omn :length seq)) ((pitchp (car pattern))(omn :pitch seq)) ((velocityp (car pattern)) (omn :velocity seq))) (append seq)))) (pattern-match seq pattern))) ;; mainfuction (defun test.pm+markov (seq pattern start-slot transitions &key (size 1)) (if (test.pm.omn seq pattern) (if (= size 1) (car (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot))) (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot))) (append start-slot))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setf transitions '((a (a 2) (b 1)) (b (a 2) (b 1)))) (setq test-omn '(t fs4 pp tasto g4 ppp tasto -s. t e4 pppp tasto -s. t eb4 pp tasto -het - t)) ;; examples1 (test.pm+markov test-omn '(pp ppp) 'a transitions) ;; evaluate a few times (test.pm+markov test-omn '(fs4 g4) 'a transitions) ;; evaluate a few times (test.pm+markov test-omn '(g2) 'a transitions) ;; evaluate a few times => no match => no new value (test.pm+markov test-omn '(1/32 -3/32) 'a transitions) ;; evaluate a few times ;; examples2 (test.pm+markov test-omn '(pp) 'a transitions :size 5) ;; evaluate a few times (test.pm+markov test-omn '(g4 e4) 'a transitions :size 3) ;; evaluate a few times ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
×
×
  • Create New...