pattern matching + chance

[AM]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WHEN PATTERN-MATCH => T
;;; THEN WEIGHETD RANDOM DECIDING THE NEXT VALUE
;;; with :gate/:keyword = extra AND-function
;;; with :evaluate => you could evaluate a function-output directly
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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


(defun weighted-random (list)
  (loop for item in list
            with rand-num = (random (loop for x in list sum (second x)))
            for add = (second item) then (+ add (second item))
            when (< rand-num add) return (first item)))


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

;; mainfunction
                            
(defun test.pm+chance (test.seq pattern values/weights &key keyword gate (evaluate 'nil))
  (let ((out))
    (setf out (if (and (test.pm.omn test.seq pattern) (equal keyword gate)) 
                (weighted-random values/weights)
                (append gate)))
    (if (equal evaluate 't)
      (eval out)
      (append out))))

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


;; example => works also with OMN etc...
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.15) (c 0.375) (d 0.21)))


;; more examples
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.25) (c 0.25)) :gate 'no-entry :keyword 'no-entry) ;; => key correct
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.5)) :gate 'no-entry :keyword 'whatever) ;; key incorrect
              
;; example with :evaluate T
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '(((cons 'a 'b) 0.5) ((cons 'c 'd) 0.5)) :evaluate t)