Jump to content
Sign in to follow this  
AM

count-up/down

Recommended Posts

use it or not...

greetings

andré

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; count-up/down => not well coded but it works
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; A FUNCTION which counts a integer-list from its values (individual) 
;;; to value B (all the same end-value :to (default is 1))

;;; n => how many output values (approx: depends on input/round... was not important for my project)
;;; up or down (default is 'down)
;;; with variabel STEPS => sequencieally (horizontal) or with steps for each value individiual (vertical)
;;; with COUNT => means how many lists with same values (like "global-steps")


;;; SUB
(defun round-to (number precision &optional (what #'round))
    (let ((div (expt 10 precision)))
         (/ (funcall what (* number div)) div)))


;;; MAIN
(defun count-up/down (n intlist &key (steps '(1)) (count 1) (type 'horizontal) (direction 'down) (to 1))
  (let* ((cycles  (round-to (/ (1- n) (length intlist)) 0))
         (intlists (cond ((equal type 'horizontal) 
                         (loop repeat cycles
                           for cnt = 0 then (incf cnt)
                           for stp in (if (< (length steps) cycles)
                                        (filter-first cycles (flatten (gen-repeat cycles steps)))
                                        steps)
                           when (= cnt 0) append (loop repeat count collect intlist)
                           when (integerp (/ cnt count))
                           collect (setf intlist (if (equal direction 'down)
                                                   (loop for i in intlist
                                                     when (>= (- i stp) to)
                                                     collect (- i stp)
                                                     else collect to)
                                                   (loop for i in intlist
                                                   when (<= (+ i stp) to)
                                                   collect (+ i stp)
                                                   else collect to)))
                           else collect intlist))

                        ((equal type 'vertical) 
                         (loop repeat cycles
                           for cnt = 0 then (incf cnt)
                           
                           when (= cnt 0) append (loop repeat count collect intlist)
                           when (integerp (/ cnt count))
                           collect (setf intlist (if (equal direction 'down)
                                                   (loop 
                                                     for i in intlist
                                                     for stp in steps
                                                     when (>= (- i stp) to)
                                                     collect (- i stp)
                                                     else collect to)

                                                   (loop 
                                                     for i in intlist
                                                     for stp in steps
                                                     when (<= (+ i stp) to)
                                                     collect (+ i stp)
                                                     else collect to)))

                           else collect intlist)))))    
    (loop repeat cycles
      for x in intlists
      collect x)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SIMPLE EXAMPLES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(list-plot 
 (flatten 
  (count-up/down 100 '(9 8 7 6 7 9 8 7 6 7) :to 3 :direction 'down))
 :join-points t)

=> ((9 8 7 6 7 9 8 7 6 7) (8 7 6 5 6 8 7 6 5 6) (7 6 5 4 5 7 6 5 4 5) (6 5 4 3 4 6 5 4 3 4) (5 4 3 3 3 5 4 3 3 3) (4 3 3 3 3 4 3 3 3 3) (3 3 3 3 3 3 3 3 3 3) (3 3 3 3 3 3 3 3 3 3) (3 3 3 3 3 3 3 3 3 3) (3 3 3 3 3 3 3 3 3 3))


(list-plot 
 (flatten 
  (count-up/down 100 '(9 8 7 6 7 9 8 7 6 7) :count 2 :to 5 :direction 'down))
 :join-points t)

=> ((9 8 7 6 7 9 8 7 6 7) (9 8 7 6 7 9 8 7 6 7) (8 7 6 5 6 8 7 6 5 6) (8 7 6 5 6 8 7 6 5 6) (7 6 5 5 5 7 6 5 5 5) (7 6 5 5 5 7 6 5 5 5) (6 5 5 5 5 6 5 5 5 5) (6 5 5 5 5 6 5 5 5 5) (5 5 5 5 5 5 5 5 5 5) (5 5 5 5 5 5 5 5 5 5))


(list-plot 
 (flatten
  (count-up/down 100 '(9 8 7 6 7 9 8 7 6 7) :to 15 :direction 'up))
   :join-points t)

=> ((9 8 7 6 7 9 8 7 6 7) (10 9 8 7 8 10 9 8 7 8) (11 10 9 8 9 11 10 9 8 9) (12 11 10 9 10 12 11 10 9 10) (13 12 11 10 11 13 12 11 10 11) (14 13 12 11 12 14 13 12 11 12) (15 14 13 12 13 15 14 13 12 13) (15 15 14 13 14 15 15 14 13 14) (15 15 15 14 15 15 15 15 14 15) (15 15 15 15 15 15 15 15 15 15))

(list-plot 
 (flatten
  (count-up/down 200 '(9 8 7 6 7 9 8 7 6 7) :count 2 :to 15 :direction 'up))
   :join-points t)

=> ((9 8 7 6 7 9 8 7 6 7) (9 8 7 6 7 9 8 7 6 7) (10 9 8 7 8 10 9 8 7 8) (10 9 8 7 8 10 9 8 7 8) (11 10 9 8 9 11 10 9 8 9) (11 10 9 8 9 11 10 9 8 9) (12 11 10 9 10 12 11 10 9 10) (12 11 10 9 10 12 11 10 9 10) (13 12 11 10 11 13 12 11 10 11) (13 12 11 10 11 13 12 11 10 11) (14 13 12 11 12 14 13 12 11 12) (14 13 12 11 12 14 13 12 11 12) (15 14 13 12 13 15 14 13 12 13) (15 14 13 12 13 15 14 13 12 13) (15 15 14 13 14 15 15 14 13 14) (15 15 14 13 14 15 15 14 13 14) (15 15 15 14 15 15 15 15 14 15) (15 15 15 14 15 15 15 15 14 15) (15 15 15 15 15 15 15 15 15 15) (15 15 15 15 15 15 15 15 15 15))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MORE COMPLEX/INTERESTING EXAMPLES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; horizontal means every cycle has a new step-value
(list-plot 
 (flatten
  (count-up/down 100 '(9 8 7 6 7 15 8 7 6 7) :steps '(1 2 1 1 1 1 1 1 1 1) :type 'horizontal :to 2))
    :join-points t)

=> ((9 8 7 6 7 15 8 7 6 7) (8 7 6 5 6 14 7 6 5 6) (6 5 4 3 4 12 5 4 3 4) (5 4 3 2 3 11 4 3 2 3) (4 3 2 2 2 10 3 2 2 2) (3 2 2 2 2 9 2 2 2 2) (2 2 2 2 2 8 2 2 2 2) (2 2 2 2 2 7 2 2 2 2) (2 2 2 2 2 6 2 2 2 2) (2 2 2 2 2 5 2 2 2 2))


;; vertical means every value has its individual step
(list-plot 
 (flatten
  (count-up/down 100 '(9 8 7 6 7 30 8 7 6 7) :steps '(1 2 1 1 1 5 1 1 1 1) :type 'vertical :to 2))
   :join-points t)

=> ((9 8 7 6 7 30 8 7 6 7) (8 6 6 5 6 25 7 6 5 6) (7 4 5 4 5 20 6 5 4 5) (6 2 4 3 4 15 5 4 3 4) (5 2 3 2 3 10 4 3 2 3) (4 2 2 2 2 5 3 2 2 2) (3 2 2 2 2 2 2 2 2 2) (2 2 2 2 2 2 2 2 2 2) (2 2 2 2 2 2 2 2 2 2) (2 2 2 2 2 2 2 2 2 2))
                             
(list-plot 
 (flatten
  (count-up/down 100 '(9 8 7 6 7 30 8 7 6 7) :steps '(1 2 1 3 1 5 3 1 2 1) :type 'vertical :to 1))
   :join-points t)

 

could be extended: would be nice if the END-VALUE (:to)  would/could be also "in between" the start values... start '(6 7 5 1 2 3 9 19)  => :to 4  => values incf, and decf to 4

Edited by AM

Share this post


Link to post
Share on other sites

a less flexible version but with nicer output/usage...

greetings

 



(defun round-to (number precision &optional (what #'round))
    (let ((div (expt 10 precision)))
         (/ (funcall what (* number div)) div)))

;;;


(defun incf/decf-alist (n alist &key (steps '(1 2)) (end 1))
  (let ((span (round-to (/ n (length alist)) 0)))
    (progn
      (setf alist (loop 
                    for start in alist
                    for step in (if (< (length steps) (length alist))
                                  (filter-first (length alist) (loop repeat (length alist) append steps))
                                  steps)
                    
                    when (> start end)
                    collect (loop for i from start downto end by step
                              collect i)
                    else collect (loop for i from start to end by step
                                   collect i)))
      (setf alist (loop for i in alist
                    collect (append i (gen-repeat (- span (length i)) end))))

      (loop repeat (length (car alist))
        for cnt = 0 then (incf cnt)
        collect (loop for i in alist
                  collect (nth cnt i))))))

(list-plot
 (flatten
  (incf/decf-alist 90 '(9 8 7 1 7 30 8 7 6 1) :steps '(1 2 1 3 1 5 3 1 2 1) :end 11))
 :join-points t)

=>((9 8 7 1 7 30 8 7 6 1) (10 10 8 4 8 25 11 8 8 2) (11 11 9 7 9 20 11 9 10 3) (11 11 10 10 10 15 11 10 11 4) (11 11 11 11 11 11 11 11 11 5) (11 11 11 11 11 11 11 11 11 6) (11 11 11 11 11 11 11 11 11 7) (11 11 11 11 11 11 11 11 11 8) (11 11 11 11 11 11 11 11 11 9))

Ohne Titel.jpeg

 

Share this post


Link to post
Share on other sites

here are 2 sound-examples of such a process

- evaluate the FUNCTIONS: incf/decf-alist and round-to

- evaluate example with cmd2/cmd3

- have a look to the list-plot

(progn
  (setf durations  (rnd-number 10 1 19 :prob 0.4))
  
  (setf seq1 (append
              (make-omn :length (gen-length (flatten 
                                             (incf/decf-alist 
                                              100 
                                              (rnd-order durations)
                                              :steps (rnd-number 10 1 5 :prob 0.2) :end 2))
                                             32)
                        :pitch '(c4)
                        :velocity '(pp))

              (make-omn :length (gen-length (flatten
                                             (incf/decf-alist 
                                             100 
                                             (rnd-order durations)
                                             :steps (rnd-number 10 1 5 :prob 0.2) :end 3))
                                            32)
                        :pitch '(b4)
                        :velocity '(f))
              
              (make-omn :length (gen-length (reverse 
                                             (flatten
                                              (incf/decf-alist 
                                               100 
                                               (rnd-order durations)
                                               :steps (rnd-number 10 1 5 :prob 0.2) :end 1)))
                                            32)
                        :pitch '(f4)
                        :velocity '(mf)))))

  
(length-list-plot (omn :length seq1))

(progn
  (setf durations  (rnd-number 10 1 7 :prob 0.4))
  
  (setf seq2 (make-omn :length (gen-length (append (reverse 
                                                    (flatten
                                                     (incf/decf-alist 
                                                      50 
                                                      (setf list (rnd-order durations))
                                                      :steps (rnd-number 10 1 5 :prob 0.2) :end 2)))
                                                   (flatten
                                                    (incf/decf-alist 
                                                     50 
                                                     list
                                                     :steps (rnd-number 10 1 5 :prob 0.2) :end 1)))
                                           32)
                        :pitch '(f4)
                        :velocity '(mf))))

  
(length-list-plot (omn :length seq2))

 

 

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