Jump to content
Sign in to follow this  
AM

gen-chained-sym-vals.by-markov

Recommended Posts

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


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

 

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  

×
×
  • Create New...