Jump to content

extension for "rnd-sample-seq"


AM

Recommended Posts

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

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

 

Edited by AM
modified
Link to comment
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.

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy