shift-length-proportions / morph

[AM]

shift-length-proportions 

 

a bit like gen-morph for LENGTHS. every item of a length-list will change linear till the endpattern is reached.

 

 

;;; subfunction

(defun compare (start end &key (step 1/32))
  (list (loop 
          for i in start
          for j in end
          
          when (/= i j)
          collect (if (> i 0)
                    (if (< i j)
                      (+ i step)
                      (- i step))
                    (if (> i j)
                      (- i step)
                      (+ i step)))
                    
          else collect i)
        end))


;;; mainfunction

(defun shift-length-proportions (start end &key (step 1/32) (rnd-pick nil))
  (let ((seq))
    (progn 
      (setf seq
            (progn 
              (setf start (omn :length start)
                    end (omn :length end))
              (append (list start)
                      (loop until (equal start end)
                        collect (setf start (car (compare start end :step step)))))))
  (if (or (null rnd-pick) (equal rnd-pick 'all))
    seq
    (rnd-sample rnd-pick seq)))))
  

;;; EXAMPLES

(shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32)
(shift-length-proportions '(1/16 1/16 1/16 1/16 1/16 -1/2) '(1/16 7/32 1/16 3/16 1/4 -1/2)  :step 1/32)


(shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32 :rnd-pick 3)
(shift-length-proportions '(1/32 7/32 1/16 3/16 1/4 -1/2) '(1/16 1/16 1/16 1/16 1/16 -1/2) :step 1/32 :rnd-pick 4)
(shift-length-proportions '(e q h e.. s -h) '(q q q q q -h) :step 1/32 :rnd-pick 3)

 

[opmo]

Note to all. Please add to your examples the results of the expressions. This will help to understand the idea on the spot :-)