is there a function to ROTATE a complete omn-sequence? (like a sample) .... 

thanks for help!

bad code but nice results... :-)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; rnd-symm-expand => generates rnd-symm transpositions
;;;; in different sequences (intervals, OMN-form,rhythms...
;;;; :chance => 0.0 - 1.0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rnd-symm-expand (seq &key (possible-intervals '(12 -12)) (chance 1))
  (let ((row)
        (firstpart)
        (rev-secondpart)
        (out))
    (setq row (if (pitchp (first seq))
                (pitch-to-midi seq)
                (append seq)))
    (setq firstpart (loop repeat (if (evenp (length row))
                                   (/ (length row) 2)
                                   (/ (1- (length row)) 2))
                      for cnt = 0 then (incf cnt)
                      collect (nth cnt row)))
    (setq rev-secondpart (loop repeat (if (evenp (length row) )
                                        (/ (length row) 2)
                                        (/ (1- (length row)) 2))
                           
                           for cnt = (- (length row) 1) then (decf cnt)
                           collect (nth cnt row)))
    
    (loop 
      for i in firstpart
      for j in rev-secondpart
      with int = 0 
      do (if (prob? chance)
           (setq int (rnd-pick possible-intervals))
           (setq int 0))
      collect (+ i int) into bag1
      collect (+ j (* -1 int)) into bag2
      when (= (length bag2) (if (evenp (length row))
                              (/ (length row) 2)
                              (/ (1- (length row)) 2)))
      do (if (evenp (length row))
           (setq out (append bag1 (reverse bag2)))
           (setq out (append bag1 (list (nth (length firstpart) row)) (reverse bag2)))))
    (if (pitchp (first seq))
      (midi-to-pitch out)
      (append out))))
    
;;;examples

(rnd-symm-expand '(0 0 0 0 0 0 0 0 0 0) :possible-intervals '(4 12 7) :chance 0.5)
(rnd-symm-expand '(1/4 1/4 1/4 1/4 1/4) :possible-intervals '(-1/32 1/32) :chance 0.5)
(rnd-symm-expand '(c1 c2 c3 c4 c5 c6) :possible-intervals '(1 -1) :chance 0.5)

 

perfect...! a kind of...  

(compress-time-signatures bars)

was my next step... so... thanx to you!!

perhaps, both in ONE?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; modify time-signatures like '(1 4 3) to (3 4 1),
;;; helps me after (split-tuplet-lengths) to clean up 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; with the :exclude and :threshold
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun modify-time-signature-repetitions (time-signature-seq &key (exclude '((0 0))) (threshold '10/4) (numerator-threshold 20))
  (loop for i in time-signature-seq 
    when (and (> (third i) 1)
              (< (/ (first i) (second i)) threshold)
              (< (* (first i) (third i)) numerator-threshold)
              (not (if (listp (first exclude)) 
                     (loop for x in exclude
                       when (equal (butlast i) x)
                       collect t)
                     (equal (butlast i) exclude))))
    
    collect (list (* (first i) (third i)) (second i) 1)
    else collect i))


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

(setq bars '((5 4 4) (1 4 2) (3 4 2) (1 8 5) (1 32 8)))

(modify-time-signature-repetitions bars)
(modify-time-signature-repetitions bars :exclude '(1 4))
(modify-time-signature-repetitions bars :exclude '((1 4) (1 8)))
(modify-time-signature-repetitions bars :exclude '((1 32)) :threshold '4/4)

(modify-time-signature-repetitions bars :numerator-threshold 7) ;; because i don't want 200/4 - bars :-)


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

 

it's allready in my USER LIBRARY...

just say when you are not interested in such things - i know you have a lot of work without these extra-stuff... :-) 

i'm very happy with OPUSMODUS!

VERY NICE CODE... but your function does not do the same as mine 

...perhaps a misunderstanding / a different idea!

...you compensate EVERY value, my code only compensates when "rhy" is changing

 

(length-round '(1/16 3/16 2/32 5/7 4/20 6/20 3/20 5/16))

=> (1/16 -3/16 3/16 -1/16 1/16 -3/16 5/7 -1/28 1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16)

..after the 1/16 it's not necessary to "round" with -3/16, because -> also with teh other values

 

here with my code -> i only want to compensate when "denominators" are changing => have a look at markings (bold)

(length-compensate2  '((1 16) (3 16) (2 32) (5 7) (4 20) (6 20) (3 20) (5 16)))

=> (1/16 3/16       1/16 -3/16      5/7 -1/28    1/5    3/10      3/20 -1/10     5/16 -3/16)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; a little function to compensate special-rhy-changes
;;; to 1/4-note structure... (or all :compensating-to -values)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; best format-solution was 1/32 => '(1 32) etc... otherwise
;;; i get in trouble with 1/8 = 4/32 - what is mathematicclay 
;;; correct - but bringing BUGS to the output

;;; if anybody could transform things '(2/32) to '(2 32) or
;;; '(3/12) to '(3 12) would be nice, i coudn't code it. this
;;; things are necessary because the function makes decicions
;;; bewtween the denominators, so there sould be constant!!!!

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



(defun length-compensate2 (liste &key (compensating-to '(1 4)))
  (butlast 
   (loop for event in (loop for i in (append liste (list (list (* -1 (first compensating-to)) (/ 1 (second compensating-to)))))
                        collect (list (first i) (/ 1 (second i))))
     with nenner
     with modulo
     with event_stack 
     with add_duration = 0
     with corr_event 
     
     when (or (null event_stack)
              (= (second event_stack) (second event)))
     do (setq add_duration (+ add_duration (abs (first event)))
              event_stack event
              corr_event nil)
     else do (progn 
               (setq nenner (/ (/ 1 (second event_stack)) (second compensating-to))
                     modulo (mod add_duration nenner))
               (if (/= modulo 0)
                 (setq corr_event (* (* -1 (- nenner modulo)) (second event_stack))))
               (setq add_duration (abs (first event))))
     
     when (not (equal corr_event 'nil))
     collect corr_event
     and do (setq corr_event nil)
     
     collect (* (first event) (second event))
     do (setq event_stack event))))



;example-1
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16)))))
;exampl-2
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16))))
                    :compensating-to '(1 8))

 

i know, but only mathematically!! -> you remember the problem with gen-stacc? => we discussed that with rangarajan?

for some functions it's necessary that 2/20 will not be "reduced" to 1/20

 

=> https://opusmodus.com/forums/topic/528-gen-stacc-question/#comment-1446

 

Quote

Yes, I have also experienced this difficulty, for example, can't distinguish between 4/4 and 2/2 because both reduce to 1! As JP points out, this is a Lisp issue, nothing to do with OM. If we are adventurous, we could implement our own "data type", for example keeping numerator and denominator separately as a cons pair (numerator . denominator) or something similar. We can write a set of functions that operate on this, and then apply reduction when actually needed. More work, of course, but Lisp gives you control.

 

Regards,

Rangarajan

 

thanx, but i see my idea don't work with that...

concrete: i want to split 2/20 into exactly '(2 20) 

 

function with numerator/denominator it will be '(1 10) - not what i need

 

also with (explode '2/20) => (1 / 1 0)

 

is there any solution?

hi all

 

i need a little lisp-help...

 

i want to split things like this perhaps 'an3 into '(a n 3)

is there a way?

 

thanx

andré

thanx!!! a.

a short - and perhaps stupid - question... what's the idea for this function, useful for ...? practical purpose?

thanx for a short hint!

thank you, i just like it :-)

know everythings seems complete...

;;;;; 
;;;;; gen-stacc2 and gen-stacc3 => usefull tools to build little variants

;;;; subfunctions => also possible with prob?

(defun weighted-random (list)
  (loop for item in list
            with rand-num = (random (loop for x in list sum (second x)))
            for add = (second item) then (+ add (second item))
            when (< rand-num add) return (first item)))
                            
(defun weighted-t/nil (on-weight)
  (let ((off-weight (- 1 on-weight)))
    (weighted-random (list (list 't on-weight) (list 'nil off-weight)))))

                            
;;;; mainfunctions
                            
(defun gen-stacc (liste)
  (if (numberp liste) 
    (if (> (numerator liste) 1)
      (list (/ 1 (denominator liste)) (/ (* -1 (- (numerator liste) 1)) (denominator liste)))
      (list liste))
    (loop for i in liste
      append (if (> (numerator i) 1)
               (list (/ 1 (denominator i)) (/ (* -1 (- (numerator i) 1)) (denominator i)))
               (list i)))))

  
(gen-stacc '(1/32 7/32 9/32 17/32))
(gen-stacc '(3/8))

;;

(defun gen-stacc2 (n liste &key (stacc-chance 1))
  (loop for i in liste
    when (and (> i n) (equal (weighted-t/nil stacc-chance) 't))
    append (list n (* -1 (- (abs i) n)))
    else collect i))

(gen-stacc2 1/32 '(1/32 7/32 9/32 17/32) :stacc-chance 0.5)

;;

(defun gen-stacc3 (n-liste liste &key (stacc-chance 1))
  (loop for i in liste
    with n
    do (setq n (rnd-pick n-liste))
    when (and (> i n) (equal (weighted-t/nil stacc-chance) 't))
    append (list n (* -1 (- (abs i) n)))
    else collect i))

(gen-stacc3 '(1/32 5/32) '(1/32 7/32 5/32 9/32 17/32 3/8 9/32 17/32) :stacc-chance 0.5)


;;;;;;

 

a concrete example (but musical-nonsense)... of a TRANSITION produced by a special markov-program

 

1) functions/subfuctions

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

(defun add-transition-weight (transition-list value add-weight)
  (loop 
    for j in transition-list
    collect (append (list (first j))
                    (loop repeat (1- (length j))
                      for cnt = 1 then (incf cnt)
                      when (equal (first (nth cnt j)) value)
                      collect (list (first (nth cnt j)) (+ add-weight (second (nth cnt j))))
                      else collect (nth cnt j)))))

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

(defun count-repetitions (value-list)

  (let ((seq (append value-list (list 'nil))))
    (loop repeat (1- (length seq))
      
      with count = 1
      
      for cnt1 = 0 then (incf cnt1)
      for cnt2 = 1 then (incf cnt2)

      when (equal (nth cnt1 seq) (nth cnt2 seq)) do (incf count)
      when (not (equal (nth cnt1 seq) (nth cnt2 seq))) collect count and do (setq count 1))))


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

(defun eliminate-repetitions (liste)

  (let ((liste (append liste (list 'nil))))
    (loop repeat (1- (length liste))
      with cnt = 0
      when  (not (equal (nth cnt liste) (nth (+ 1 cnt) liste)))
      collect (nth cnt liste)      
      do (incf cnt))))

(eliminate-repetitions '(1 1 2 3 4 4 4 1 1 2))

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

(defun gen-markov-from-transitions-with-tendency (transitions size generations value &key (add-weight 1) (start (first (first transitions))))
  (loop repeat generations
    with list = (gen-markov-from-transitions transitions :size size :start start )
    with weight = add-weight
    with weight-growth = 0
    
    do (setq transitions (add-transition-weight transitions value weight))
    append (setq list (gen-markov-from-transitions transitions :size size :start (filter-first-last 1 list)))
    do (incf weight (incf weight-growth))))

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

 

 

2) example and possible implementation => create a TRANSITION to value 3 (=> to pitch eb4)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;evaluate a few times, to check it;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(list-plot ;;non-neutral-table
 (setq integers (gen-markov-from-transitions-with-tendency 
                          '((1 (1 1) (2 4) (3 1))
                            (2 (1 1) (4 1) (3 3))
                            (3 (1 4) (3 5) (4 3))
                            (4 (1 1) (3 2) (4 3))) 10 20 3  :add-weight 3))
  :point-radius 0 :style :fill)

#|
;;another example with different mapping
(list-plot ;;non-neutral-table
 (setq integers (gen-markov-from-transitions-with-tendency 
                          '((1 (1 1) (2 4) (3 1))
                            (2 (1 1) (4 1) (3 3) (6 1))
                            (3 (1 4) (3 5) (4 3) (6 1) (5 1))
                            (4 (1 1) (3 2) (4 3) (5 2) (6 1))
                            (5 (1 1) (3 1) (4 1))
                            (6 (2 3) (1 2) (3 1) (5 1))) 10 20 3  :add-weight 3))
  :point-radius 0 :style :fill)

(setq integers (replace-map '((5 -5) (1 0) (2 6) (3 14) (4 20) (6 25)) integers))
|#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;gen an example-score;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
(def-score example
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (make-omn :pitch (eliminate-repetitions (integer-to-pitch integers))
                   :length (gen-length (count-repetitions integers) 1/32))
   
   :sound 'gm-piano))

 

https://en.wikipedia.org/wiki/Collatz_conjecture

 

;;experiment with COLLATZ-conjecture
;;https://en.wikipedia.org/wiki/Collatz_conjecture

(defun collatz (start-value number-of-value)
  (loop repeat number-of-value
    with value = start-value
    
    when (evenp value)
    do (setq value (/ value 2))
    else do (setq value (+ (* 3 value) 1))
    
    collect value))

(list-plot (collatz 15 20)
 :zero-based t
 :point-radius 2
 :join-points t)


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

;;same function like fibonacci-transition but now with COLLATZ.
;;don't know if that makes sense - just a bit code :-)

(defun transition-with-collatz (number-of-values start-val value-a value-b) 
  (let ((coll-length) (coll-seq) (all-seq))
    (setq coll-length (loop
                       for cnt = 1 then (incf cnt)
                       collect (sum (collatz start-val cnt)) into bag
                       when (> (car (last bag)) number-of-values)
                       do (return (1- (length bag)))) 
          coll-seq (collatz start-val coll-length)
          all-seq (append (reverse coll-seq) (loop repeat (- number-of-values (sum coll-seq))
                                              collect 1)))
    (loop for i in all-seq 
      append (loop repeat i
               for cnt = 0 then (incf cnt)
               when (= cnt 0)
               collect value-b else collect value-a))))



;;example-1 => only the process => makes sense when using a lot of values...
(list-plot
 (transition-with-collatz 500 56 1 2)
  :zero-based t
 :point-radius 2
 :join-points t)

 

;;little function to make a transition by FIBONACCI-seq
;;i have seen this idea in "slippery chicken" (by michael edwards),
;;so here is a - "not so smart" but working - basic-function.

(defun transition-with-fibonacci (number-of-values value-a value-b) 
  (let ((fib-length) (fib-seq) (all-seq))
    (setq fib-length (loop
                       for cnt = 1 then (incf cnt)
                       collect (sum (fibonacci 2 cnt)) into bag
                       when (> (car (last bag)) number-of-values)
                       do (return (1- (length bag)))) 
          fib-seq (fibonacci 2 fib-length)
          all-seq (append (reverse fib-seq) (loop repeat (- number-of-values (sum fib-seq))
                                              collect 1)))
    (loop for i in all-seq 
      append (loop repeat i
               for cnt = 0 then (incf cnt)
               when (= cnt 0)
               collect value-b else collect value-a))))



;;example-1 => only the process
(transition-with-fibonacci 70 1 2)

;;example-2 => with context = sequence with 1 or 2 (before/after transition)
(list-plot
 (append  (gen-repeat 10 1) 
          (transition-with-fibonacci 32 1 2)
          (gen-repeat 10 2))
 :zero-based t
 :point-radius 2
 :join-points t)

 

now edited!

you are right, sorry. no computer with me... think you could replace filter-first-last by: (car (last list))

 

 

don't konw if something like this exists in ONE function... could be useful!! 

andré

(defun count-repetitions (value-list)

  (let ((seq (append value-list (list 'nil))))
    (loop repeat (1- (length seq))
      
      with count = 1
      
      for cnt1 = 0 then (incf cnt1)
      for cnt2 = 1 then (incf cnt2)

      when (equal (nth cnt1 seq) (nth cnt2 seq)) do (incf count)
      when (not (equal (nth cnt1 seq) (nth cnt2 seq))) collect count and do (setq count 1))))

(count-repetitions '(1 1 2 2 2 3 4 4 1))
(count-repetitions '(abc bc a a a a bc))

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;another little markov-game => markov with "global-tendency"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;a "neutral table with 4 values"
(setq transitions '((1 (1 1) (2 1) (3 1) (4 1))
                    (2 (1 1) (2 1) (3 1) (4 1))
                    (3 (1 1) (2 1) (3 1) (4 1))
                    (3 (1 1) (2 1) (3 1) (4 1))
                    (4 (1 1) (2 1) (3 1) (4 1))))
      
;;;subfunctions

(defun filter-first-last (n sequence)
  (car (filter-last n sequence)))

(defun substitute-transition-weight (transition-list value new-weight)
  (loop 
    for j in transition-list
    collect (append (list (first j))
                    (loop repeat (1- (length j))
                      for cnt = 1 then (incf cnt)
                      when (equal (first (nth cnt j)) value)
                      collect (list (first (nth cnt j)) new-weight)
                      else collect (nth cnt j)))))

;;;mainfuction
(defun markov-with-tendency (transitions size generations value)
(loop repeat generations
   with list = (gen-markov-from-transitions 
                 transitions
                 :size size :start 1)
  with weight = 1
  with weight-add = 0

  do (setq transitions (substitute-transition-weight transitions value weight))
  append (setq list (gen-markov-from-transitions transitions :size size :start (filter-first-last 1 list)))
  do (incf weight (incf weight-add))))


;;;some simulations => evaluate!!!
(list-plot 
  (markov-with-tendency transitions 10 20 1)
  :point-radius 0 :style :fill) 

(list-plot 
 (list
  (markov-with-tendency transitions 10 20 1)
  (markov-with-tendency transitions 10 20 2)
  (markov-with-tendency transitions 10 20 4))
  :point-radius 0 :style :fill) 

(list-plot ;;non-neutral-table
  (markov-with-tendency '((1 (1 1) (2 4))
                          (2 (1 1) (4 1))
                          (3 (1 4) (3 5) (4 3))
                          (3 (1 1) (2 4) (3 2))
                          (4 (1 1) (3 2) (4 3))) 10 20 1)
  :point-radius 0 :style :fill) 

 

;;; little markov-game:

;;; gen-markov => analyze the output => produce new rules => gen-markov
;;; make x-times the list-plot and you will see how the system most of the times
;;; comes to a "constant STATE"

(defun self-analyzing/generating-markov (transitions size generations)
  (loop repeat generations
    with list = (gen-markov-from-transitions 
                 transitions
                 :size size :start 1)
    
    append (setq list (gen-markov-from-transitions 
                       (gen-markov-transitions list)
                       :size size :start (car (last list))))))

;;; a "neutral table with 4 values"
(setf transition-table
	      '((1 (1 1) (2 1) (3 1) (4 1))
                (2 (1 1) (2 1) (3 1) (4 1))
                (3 (1 1) (2 1) (3 1) (4 1))
                (3 (1 1) (2 1) (3 1) (4 1))
                (4 (1 1) (2 1) (3 1) (4 1))))


;;; evaluate a few times and have a look on the output
(list-plot 
 (self-analyzing/generating-markov transition-table 20 20) 
 :point-radius 0 :style :fill)

 

;;; little program to change markov-weight for a specific value
;;; to give markov a "rule-tendency" 

(setq transitions '((a (b 1) (c 3) (d 2) (e 1))
                    (b (a 2) (d 3))
                    (c (a 2) (e 1) (b 3))
                    (d (c 2) (b 1) (a 3))
                    (e (a 2) (b 2) (d 1))))


(defun substitute-transition-weight (transition-list value new-weight)
  (loop 
    for j in transition-list
    collect (append (list (first j))
                    (loop repeat (1- (length j))
                      for cnt = 1 then (incf cnt)
                      when (equal (first (nth cnt j)) value)
                      collect (list (first (nth cnt j)) new-weight)
                      else collect (nth cnt j)))))


(substitute-transition-weight transitions 'a 100)



;;; example for "concrete use"

(loop repeat 20
  with transitions = '((a (b 3) (c 3) (a 2))
                       (b (a 2) (b 3) (c 5))
                       (c (a 2) (c 1)))
  with weight = 1
  do (setq transitions (substitute-transition-weight transitions 'a weight))
  do (incf weight 2)
  collect (gen-markov-from-transitions transitions
	                             :size 20 :start 'a))

best wishes 

andré

looking forward to next release!

if you want to pick a sample from approx.center (depends on odd/even)  of a list... 

 

(defun pick-sample-from-center (list span)
  (let ((center (if (evenp (length list))
                  (/ (length list) 2)
                  (/ (1+ (length list)) 2)))
        (span (if (> span (length list))
                    (length list)
                    (append span))))
    (loop repeat span
      with startpoint = (if (evenp span)
                          (- center (/ span 2))
                          (- center (/ (1+ span) 2)))

      for i = startpoint then (incf startpoint)
      collect (nth i list))))


;;;EXAMPLES:

(pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 7)
=> (2 3 4 5 4 3 2)

(pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 3)
=> (4 5 4)

(pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 6)
=> (3 4 5 4 3 2)

(pick-sample-from-center '(1 2 3 4 5 4 3 2 1) 20) ; (if (> span length) => input-list as output
=> (1 2 3 4 5 4 3 2 1)