code gen-chained-sym-vals.by-markov

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


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