Jump to content
Sign in to follow this  
AM

sorting algorithms

Recommended Posts

hi all

 

i'm looking for different SORTING ALGORITHMS in LISP - no problem to find (different) in the WWW... but: i would like to have as OUTPUT-result ALL generations of the SORTING-process and not only the LAST one  - i'm interested in the PROCESS!!

 

thanks for some help or any idea? (for once i do not want to code it myself :-))

greetings

andré

Share this post


Link to post
Share on other sites

I would use GEN-MORPH for that.

Ex. 1

(setf org (rnd-order '(c4 cs4 d4 ds4) :seed 3657))
=> (d4 c4 ds4 cs4)

(setf sort (sort-asc org))
=> (c4 cs4 d4 ds4)

(gen-morph (length org) sort org)
=> ((c4 cs4 d4 ds4) (d4 cs4 d4 ds4) (d4 cs4 ds4 cs4) (d4 c4 ds4 cs4))

(gen-morph 8 sort org)
=> ((c4 cs4 d4 ds4) (d4 cs4 d4 ds4) (d4 cs4 d4 ds4) (d4 cs4 d4 cs4)
    (d4 cs4 d4 cs4) (d4 cs4 ds4 cs4) (d4 cs4 ds4 cs4) (d4 c4 ds4 cs4))

 

Ex.2

(setf noise (gen-white-noise 200 :seed 23))
(setf sort (sort-asc noise))
(gen-morph 8 noise sort)

 

Share this post


Link to post
Share on other sites

great... but unfortunately, i'm looking for a whole range of different sorting algorithms - which are working by steps...

Share this post


Link to post
Share on other sites

Simply slightly edit the algorithms below by inserting some additional output. Below I simply took one of the algorithms you linked and added a single print statement. If instead you want to collect all the results, then just accumulate them in some variable with a scope surrounding your algorithm function.

(defun bubble-sort/naive (sequence)
  (let ((end (length sequence)))
    (labels ((compare-and-swap (index modified)
               ;; print intermediate results
               (print sequence)
               (if (= index (1- end))
                   (if modified (compare-and-swap 0 nil) (values))
                   (let ((index+1 (1+ index)))
                     (if (> (elt sequence index) (elt sequence index+1))
                         (let ((x (elt sequence index)))
                           (setf (elt sequence index) (elt sequence index+1)
                                 (elt sequence index+1) x)
                           (compare-and-swap index+1 t))
                         (compare-and-swap index+1 modified))))))
      (unless (< end 2)
        (compare-and-swap 0 nil))
      sequence)))

(bubble-sort/naive '(3 1 9 5 3 6 4 2 3 7))


Best,

Torsten

Share this post


Link to post
Share on other sites

Well done, I could add the SORTING function to our system.

The examples are very good as well.

 

Note:

If you like to share a workspace with files etc... you simply make a folder (same name as the workspace file) with the workspace and other files.

This way the workspace is ready to use.

 

Sorting Algorithms.zip

Share this post


Link to post
Share on other sites

you could add if you like, but perhaps... CODE it better! 🙂 and, perhaps it's possible for you to make it working with CHORDS?

this sorting-thing could be also used (if you pick single generations) for producing "variants" of a motif - with more or less difference from/to an original.

 

-

 

i have some more plans - based on musical ideas - for SORTING functions. when it's coded i'll send it to you at "SOURCE CODE" - so you can have a look what is interesting for you. i'd like to work also a bit on MORPH-things (how to "morph" a gestalt into another).

 

 

Share this post


Link to post
Share on other sites

Very nice! Thank you for this AM.

I hope it will make it into OM. I think it should be part of this glorious tool.

 

/Lasse

Share this post


Link to post
Share on other sites

you're welcome 🙂

 

my favorites are: 

 

(make-omn :pitch (setf n (sorting (vector-to-pitch'(g3 bb5) (gen-white-noise 40)) :algorithm 'selection))
          :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))

(make-omn :pitch (setf n (sorting (vector-to-pitch'(g3 bb5) (gen-white-noise 40)) :algorithm 'insertion))
          :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))

 

Share this post


Link to post
Share on other sites

MIN/MAX-SORT

 

a new function: min/max -> 1. max-pitch, 2. min-pitch, 3.rest of the seq .... starting next gen.... have a look at the list-plot.

 

 

minmax-sort.opmo

functions.opmo

 

;;; ordinary examples

(make-omn :pitch (setf n (sorting (vector-to-pitch'(g4 eb5) (gen-white-noise 40)) :algorithm 'min/max))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))

(make-omn :pitch (setf n (sorting (vector-to-pitch'(g4 eb5) (gen-white-noise 40)) :algorithm 'min/max :n '>))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))


(make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))

(make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max :n '>))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e))))


(make-omn :pitch (setf n (sorting (rnd-order '(g4 gs4 a4 bb4 b4 c5 cs5 d5 eb5 e5 f5 fs5)) :algorithm 'min/max))
                      :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e))))

(make-omn :pitch (setf n (sorting (rnd-order '(g4 gs4 a4 bb4 b4 c5 cs5 d5 eb5 e5 f5 fs5)) :algorithm 'min/max :n '>))
                      :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e))))




;;; combined with filter-tie -> ties all pitch repetitions!!

(filter-tie (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))))

(filter-tie (make-omn :pitch (setf n (sorting (vector-to-pitch'(c4 bb5) (gen-white-noise 40)) :algorithm 'min/max :n '>))
                      :length (gen-repeat (length n) (append (gen-repeat 40 '(t)) (list '-e)))))




;;; THREE SCORES with min/max

(def-score example-score
           (:key-signature 'atonal
                           :time-signature '(4 4)
                           :tempo 120
                           :layout (piano-solo-layout 'rhand 'lhand))
  
  (rhand :omn (make-omn :pitch (setf n (sorting (rnd-order '(g6 gs6 a6 bb6 b6 c7 cs7 d7 eb7 e7 f7 fs7)) :algorithm 'min/max :n '<))
                        :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e))))
         :channel 1
         :sound 'gm
         :program 0)
  
  (lhand :omn (make-omn :pitch (setf n (sorting (rnd-order '(g1 gs1 a1 bb1 b1 c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>))
                        :length (gen-repeat (length n) (append (gen-repeat 12 '(t)) (list '-e))))
         :channel 2))

(def-score example-score
           (:key-signature 'atonal
                           :time-signature '(4 4)
                           :tempo 120
                           :layout (piano-solo-layout 'rhand 'lhand))
  
  (rhand :omn (filter-tie 
               (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g6 gs6 a6 bb6 b6 c7 cs7 d7 eb7 e7 f7 fs7)) :algorithm 'min/max :n '<))
                        :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e)))))
         :channel 1
         :sound 'gm
         :program 0)
  
  (lhand :omn (filter-tie 
               (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g1 gs1 a1 bb1 b1 c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>))
                        :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e)))))
         :channel 2))

(def-score example-score
           (:key-signature 'atonal
                           :time-signature '(4 4)
                           :tempo 120
                           :layout (piano-solo-layout 'rhand 'lhand))
  
  (rhand :omn (filter-tie 
               (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(g6 gs6 a6 bb6 b6 c7 cs7)) :algorithm 'min/max :n '<))
                        :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e)))))
         :channel 1
         :sound 'gm
         :program 0)
  
  (lhand :omn (filter-tie 
               (make-omn :pitch (setf n (sorting (rnd-repeat 100 '(c2 cs2 d2 eb2 e2 f2 fs2)) :algorithm 'min/max :n '>))
                        :length (gen-repeat (length n) (append (gen-repeat 100 '(t)) (list '-e)))))
         :channel 2))

 

Share this post


Link to post
Share on other sites

I have added a new keyword :step - number of steps to complete the process.

 

Exp. without step:

(list-plot
 (flatten (sorting (rnd-number 30 1 10 :seed 2346) :type 'selection))
  :zero-based t
  :point-radius 1
  :join-points t)

Screen Shot 2018-04-27 at 11.18.47.png

 

Same as above but with 5 steps:

 

(list-plot
 (flatten (sorting (rnd-number 30 1 10 :seed 2346) :type 'selection :step 5))
  :zero-based t
  :point-radius 1
  :join-points t)

Screen Shot 2018-04-27 at 11.19.00.png

 

Share this post


Link to post
Share on other sites

okay, i see... and waht is the default? i think whole process (all steps) would be good

Share this post


Link to post
Share on other sites

A random sort '? - RND-PICK from ascending and descending result of a sequence.

 

Ascending:

(list-plot
 (flatten (sorting (rnd-number 20 1 10 :seed 2346) :type 'selection :sort '<))
  :zero-based t
  :point-radius 1
  :join-points t)

Screen Shot 2018-04-27 at 12.48.46.png

 

Descending:

(list-plot
 (flatten (sorting (rnd-number 20 1 10 :seed 2346) :type 'selection :sort '>))
  :zero-based t
  :point-radius 1
  :join-points t)

 

Screen Shot 2018-04-27 at 12.48.58.png

 

At random:

(list-plot
 (flatten (sorting (rnd-number 20 1 10 :seed 2346) :type 'selection :sort '?))
  :zero-based t
  :point-radius 1
  :join-points t)

Screen Shot 2018-04-27 at 12.49.13.png

 

In 5 steps:

(list-plot
 (flatten (sorting (rnd-number 20 1 10 :seed 2346) :type 'selection :sort '? :step 5))
  :zero-based t
  :point-radius 1
  :join-points t)

Screen Shot 2018-04-27 at 12.55.09.png

 

The default sort is ascending.

 

Share this post


Link to post
Share on other sites

a kind of MERGE-SORT -> sorry for bad coding i didn't find a better solution -> perhaps a new SORT for GEN-SORT...

 

(defun kind-of-merge-sort (alist)
  (progn 
    (setf alist (mcflatten (loop repeat 30
                             do (setf alist (loop for i in (gen-divide 2 alist)
                                              collect (sort-asc (flatten i))))
                             
                             collect alist)))
    
    (loop repeat (length alist)
      for cnt = 0 then (incf cnt)
      when (not (equal (nth cnt alist) (nth (1+ cnt) alist)))
      collect (nth cnt alist))))



(list-plot (flatten (kind-of-merge-sort (rnd-order (gen-integer 0 20)))) :join-points t :point-radius 0 :style :fill)

 

merge.jpeg

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  

  • Similar Topics

    • By EAIP
      Is there built-in functionality to sort a chord-progression using the top note?
      The following example uses the bottom note:
      (sort-asc '(a2a3 a2a4 a2e4))  
    • By Wim Dijkgraaf
      I'm interested in having a complete list of the more high-level algorithms that Opusmodus supports out-of-the-box. This is what I found going through the integrated help documentation:
      Lindmayer systems Cellular automata Working with pitch class sets Euclidean Algorithm Tonality mapping Mandelbrot sets Rubin (Rubin functions) Twelve-tone row (including All-interval twelve-tone row and Twelve Tone Forms) Klangreihen technique
      Trobes (composer Joseph Hauer )
      The Time Point System (Babbit)
      Infinity Series (Nørgård)
      Messiaen Permutation
      Stravinsky Rotation
      Brownian motion
      Noise generation
      Gaussian noise
      Pink noise
      White noise
      Markov chain
      Random generators (including random walk)
      Schillinger Interference (Schillinger System of Music Composition)
      Spectral Data
      Wave forms (sine, sawtooth, square, triangle)
       
      Any help to get this list complete is very much appreciated :-)
       
      Big hug,
       
      Wim Dijkgraaf
×
×
  • Create New...