extension for "rnd-sample-seq"

;;;;perhaps you could/would extend the "rnd-sample-seq" function by:
;;;;(also with OMN-format) ... regards andré


;;;;SUBFUNCTIONS

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


;;;;MAINFUNCTION 
;;;;sampling-machine

(defun sampling-seq-machine (&key seq (type 'rnd) (sample-lengths 'rnd))
  (let ((span (if (equal sample-lengths 'rnd)
                 (1+ (random (length seq)))
                 (rnd-pick sample-lengths))))

    (cond ((equal type 'rnd)
           (rnd-sample-seq span
                           seq))
          ((equal type 'from-center)
           (loop repeat span
             with center = (center-position-in-list (omn :length seq))
             with startpoint = (if (evenp span)
                                 (- center (/ span 2))
                                 (- center (/ (1+ span) 2)))
             
             for i = startpoint then (incf startpoint)
             append (position-filter i seq)))
          
          ((equal type 'from-start)
           (loop repeat span
             for i = 0 then (incf i)
             append (position-filter i seq)))
          
          ;;; don't
          ((equal type 'from-end)
           (loop repeat span
             for i = (- (length (omn :length seq)) span) then (incf i)
             append (position-filter i seq))))))

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

(sampling-seq-machine :seq '(1 2 3 4 5 6 7 8 9) 
                      :type 'from-end
                      :sample-lengths '(3 5 7))
                  
(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'rnd
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-start
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-center
                      :sample-lengths '(3 5 7))

(sampling-seq-machine :seq '(t bb3 pppp a3 ppp g3 pp eb3 p gs2 mp cs2 mf fs1 mp d1 p c1 pp) 
                      :type 'from-end
                      :sample-lengths '(3 5 7))

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