pattern matching + markov

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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

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