Jump to content
Sign in to follow this  
AM

count-up/down

Recommended Posts

Posted (edited)

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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×