substitute markov-transition-rules

[AM]

i'm working on a program including "markov"...

so i coded this small FUNCTION to SUBSTITUTE markov-rules-values (because in my "project" i'm generating a feedback on the markov-rules (after a pattern-match)). i know it could be coded a lot smarter but it works.

have fun! andré

 

;;;;FUNCTION

(defun substitute-transition-value (transition-list value-old value-new)
  (loop for j in transition-list 
    collect (loop 
              for i in j
              when (numberp i)
              append (substitute value-new value-old (list i))
              when (listp i)
              collect (append (substitute value-new value-old (list (first i))) (list (second i))))))

;;;;;EXAMPLE

(setq transitions '((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))))

(substitute-transition-value transitions 1 -1)
=> ((-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)))

 

[opmo]

Update to SUBSTITUTE-MAP:

 

substitute-map new old sequence &key section

 

[Function]

 

Arguments and Values:

 

new                               an item or a list of items.

old                               an item or a list of items.

sequence        a sequence.

section         an integer or list of integers. Selected list or lists to process.

 

Description:

 

SUBSTITUTE-MAP can be used to create a list of substitutions in an existing list.

 

(substitute-map -1 1 '(1 2 3 3 2 1))

=> (-1 2 3 3 2 -1)

 

(substitute-map -1 1 '((1 2 3) (3 2 1)))

=> ((-1 2 3) (3 2 -1))

 

(substitute-map -1 1 '((1 2 3) (3 2 1)) :section 0)

=> ((-1 2 3) (3 2 1))

 

Examples:

 

(substitute-map '(a b c d) '(1 2 3 4) '(1 4 3 2 3 4 3 2))

=> (a d c b c d c b)

 

Not all items in a given list have to be substituted:

 

(substitute-map '(a c) '(1 3) '(1 4 3 2 3 4 3 2))

=> (a 4 c 2 c 4 c 2)

 

Creating a melody with SUBSTITUTE-MAP:

 

(substitute-map '(c4 e4 g4 c5) '(0 1 2 3) '(0 3 1 2 3 1 0 2))

=> (c4 c5 e4 g4 c5 e4 c4 g4)

 

(setq transitions '((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))))

 

Substitute of markov transition values:

 

(substitute-map -1 1 transitions)

=> ((-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)))

[AM]

bug? keep attention with transition-values! 

 

(substitute-map -1 1 transitions)

=> ((-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)))

-> "weight" should not be replaced!

 

 Like this

[opmo]

You are absolutely right. What I did is to extend the functionality.

For specific functionality (like the markov transition list) you need to use something else, as you did.

 

 

[AM]

a version for 2+LEVEL-markov-tables

all the best

andré

 

;;example-mat

(setq pitch-seq (append '(c4 cs4 fs4 g4) 
                        '(a4 gs4 eb4 d4)
                        '(c4 d4 eb4 ab4 bb4 b4)
                        '(c5 bb4 e4 d4 db4 b3 f3 eb3)
                        '(d3 g3 c4 cs4 fs4 b4)
                        '(c5 bb4 f4 e4 b3 a3)
                        '(g3 c4 b3 bb3 f3)
                        '(g3 c4 b3 bb3 f3)
                        '(g3 c4 b3 bb3 f3)
                        '(e3 eb3 a2 bb2)))


;; different levels of transition-tables > LEVEL 2, 3, & 4

(setf transition2 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 2))
(setf transition3 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 3))
(setf transition4 (gen-markov-transitions (pitch-to-interval pitch-seq) :level 4))


;; the substitution-function for LEVELS 2+ (!!!)

(defun substitute-transition-value2 (transition-list value-old value-new)
  (loop for j in transition-list 
    with cnt = 0
    collect (loop 
              for i in j
              when (and (listp i) (= cnt 0))
              collect (substitute value-new value-old i) and do (incf cnt)
              else collect (append (substitute value-new value-old (list (first i))) (list (second i))))
    do (setq cnt 0)))


;; examples 
(gen-markov-from-transitions
 (substitute-transition-value2 transition2 -1 11) :size 100 :start 2)
(gen-markov-from-transitions
 (substitute-transition-value2 transition3 -1 11) :size 100 :start 2)
(gen-markov-from-transitions
 (substitute-transition-value2 transition4 -1 11) :size 100 :start 2)