Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation since 05/22/2018 in Posts

  1. 3 points
    Hello, here's one of my personal orchestral template. It use plogue Bidule as host (because some special KeySwitch configuration) and EastWest Hollywood orchestra and East west Convolution reverb (but you can replace it by another one). You can use this template and associated files (soundset etc..) as this or use it as a base for designing you own and take inspiration from it. Attached you will find and audio example of the raw output of the template, the template itself (.opmo), the Bidule file and the soundset necessary to drive this template. Put the BaseOrch4.bidule file into the Instrument/Templates folder from Opmo folder. (create the Template folder if not exist) Put the soundset file BaseOrchestra4.lisp into the Def-soundset folder from opmo folder. Have fun !! SB. TemplateOutExample.mp3 ForumHWBiduleBaseOrchestra.opmo BaseOrch4.bidule BaseOrchestra4.lisp
  2. 2 points
    opmo

    Opusmodus 1.2.23428

    View File Opusmodus 1.2.23428 New: vector-to-envelope sum-to-size snippet - Audition default parameters. Function name change: vector-shift -> vector-envelope2 L-System addition: Allows functions inside a rule. New keyword :seq in filter-repeat sum-to-size This function returns a list of numbers in a given size of equal numbers (plus/minus 1) which add up to a total. Examples: (sum-to-size 45 8) => (5 5 5 6 6 6 6 6) (sum-to-size 25 7) => (3 3 3 4 4 4 4) (sum-to-size 25 3) => (8 8 9) (sum-to-size 25 11) => (2 2 2 2 2 2 2 2 3 3 3) (sum-to-count 104 8) => (13 13 13 13 13 13 13 13) Snippet Audition default parameters: (defparameter *audition-tempo* 120) (defparameter *audition-length* 1/4) (defparameter *audition-pitch* 'c4) (defparameter *audition-velocity* 'mf) (defparameter *audition-ignore-ports* t) (defparameter *audition-sound* 'gm) (defparameter *audition-channel* 1) (defparameter *audition-program* 0) (defparameter *audition-volume* 92) (defparameter *audition-port* 0) The default ‘Audition’ parameters will allow you to make changes to the ‘Preferences/Audition’ parameters without the need to open the window each time you make a change to port, channel, sound or program. Using the ‘Audition’ parameters as a part of the code will help you in your work flow. This possibility is useful for demonstrations and presentations. Examples: 1. (progn ;;; Cello (defparameter *audition-tempo* 72) (defparameter *audition-velocity* 'f) (defparameter *audition-sound* 'gm) (defparameter *audition-channel* 7) (defparameter *audition-program* 'cello) (defparameter *audition-volume* 100) ) ;(J. S. Bach, Sechs Suiten Sonaten fuer Violoncello solo, Suite I, Preludium, 1722) '(((leg s g2 mf e3 b3 a3 b3 g3 fs3 g3) (leg e3 g3 dig2 fs3 g3 b2 > dig1 d3 > cs3 > b2 >)) ((leg s cs3 p dig3 g3 dig2 a3 sul g3 dig2 a3 g3 a3 g3) (leg cs3 g3 a3 g3 a3 g3 a3 g3)) ((leg s fs3 p< dig1 a3 < sul d4 < cs4 d4 mf a3 dig4 g3 a3 fs3) (leg a3 g3 a3 d3 > sul fs3 > dig3 e3 > d3 >)) ((leg s e2 p dig1 b2 g3 fs3 g3 b2 g3 b2) (leg e2 b2 g3 fs3 g3 b2 g3 b2))) 2. (progn ;;; Piano (defparameter *audition-tempo* 98) (defparameter *audition-velocity* 'f) (defparameter *audition-sound* 'gm) (defparameter *audition-channel* 1) (defparameter *audition-program* 'Acoustic-Grand-Piano) (defparameter *audition-volume* 100) ) ;(F. Chopin, Etudes, Op. 10, No. 5, 1833) '((3e gb6 bb6 db6 gb6 eb6 gb6 db6 gb6 bb5 db6 gb5 bb5) (3e gb5 bb5 db5 gb5 eb5 gb5 db5 gb5 bb4 db5 gb4 bb4) (3e db4 db5 ab4 db5 ab4 ab5 ab4 ab5 eb5 ab5 eb5 eb6) (3e eb5 eb6 ab5 eb6 ab5 ab6 ab5 ab6 db6 ab6 db6 db7)) To send the snippet to a port you need to set the *audition-ignore-ports* to nil and set the *audition-port* to a number of your virtual instrument port: 3. (progn ;;; Violin (defparameter *audition-tempo* 120) (defparameter *audition-velocity* 'mf) (defparameter *audition-ignore-ports* nil) (defparameter *audition-sound* 'vsl-violin) (defparameter *audition-channel* 1) (defparameter *audition-program* 0) (defparameter *audition-volume* 100) (defparameter *audition-port* 1) ) vector-to-envelope This function applies ‘ambitus series’ derived from a envelope list into a list of floating-point numbers. Lets examine first how envelope create the ambitus series (low high). We interleave the envelope with a value 2 first and then we apply a sort function: (setf envelope '(-5.1 -2.3 1.5 -0.8 4.6 10.6)) (sort-asc (gen-interleave 2 envelope)) => ((-5.1 -2.3) (-2.3 1.5) (-0.8 1.5) (-0.8 4.6) (4.6 10.6)) From the envelope above the function creates five ambitus series each with two lists: start (low high) and end (low high). Start End ((-5.1 -2.3) (-2.3 1.5)) ((-2.3 1.5) (-0.8 1.5)) ((-0.8 1.5) (-0.8 2.1)) ((-0.8 2.1) (-0.8 4.6)) ((-0.8 4.6) (4.6 10.6)) Next, the values list (floating-point numbers) is divided by the count of the ambitus series. In our example the count is 5: (sum-to-size 128 5) => (25 25 26 26 26) The final process is to select randomly segment numbers for each of the 5 sublists: With :type 1 (rnd-sum 25 '(2 3 5 7 11 13 17 19)) => (7 3 2 2 11) With :type 2 (length segments) (rnd-sum-to-size 25 8 '(2 3 5 7 11 13 17 19)) => (2 5 3 3 3 3 3 3) With :type 3 (length segments) - with equal or plus/minus 1 equal numbers. (sum-to-size 25 8) => (3 3 3 3 3 3 3 4) Lets see the result: (list-plot (vector-to-envelope '(-5.1 -2.3 1.5 -0.8 4.6 10.6) (gen-white-noise 128))) A slightly different result we can achieve with optional :type 2: (list-plot (vector-to-envelope '(-5.1 -2.3 1.5 -0.8 4.6 10.6) (gen-white-noise 128) :type 2)) Most equal distribution of segments is achieved with :type 3: (list-plot (vector-to-envelope '(-5.1 -2.3 1.5 -0.8 4.6 10.6) (gen-white-noise 128) :type 3)) Examples: (list-plot (vector-to-envelope (rnd 12 :low -10.0 :high 40.0) (gen-white-noise 356) :segment '(1 2 3 4 5))) (list-plot (vector-to-envelope (rnd 6 :low -1.0 :high 4.0 :seed 45) (gen-white-noise 356) :segment '(1 2 3) :type 3)) (list-plot (vector-to-envelope (rnd 4 :low -1.0 :high 4.0 :seed 45) (gen-white-noise 356) :segment (primes 12))) (setf env2 '(0.2 0.1 0.5 0.1 0.8 0.5 0.1 0.4 0.2 0.3)) (list-plot (vector-to-envelope (gen-tendency 4 env2) (gen-tendency 356 env2) :segment (primes 4))) New keyword :seq in filter-repeat (filter-repeat 1 '(a4 gs4 a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) :seq 2) => (a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) (filter-repeat 1 '(gs4 fs3 a4 fs3 a4 bb5 a4 gs4) :seq 2) => (gs4 fs3 a4 bb5 a4 gs4) (filter-repeat 1 '(gs4 fs3 a4 fs3 fs3 a4 fs3 a4 bb5 a4 gs4) :seq 3) => (gs4 fs3 a4 fs3 a4 bb5 a4 gs4) L-System Example with a function inside a rule: (progn (defclass llen (l-system) ((axiom :initform '(s e)) (depth :initform 2))) (defmethod l-productions ((ls llen)) (choose-production ls (s (--> (rnd-pick '((s * e * s /) (s e -s /))) q / s e -s /)) (e (--> s * s * s / q / s e -s / (rnd-pick '(h -q s -e) :encode nil))))) ) (rewrite-lsystem 'llen :depth 2) => (s * e * s / q / s e -s / q / s e -s / s * s * s / q / s e -s / -q -s / s e -s / q / s e -s / * s e -s / q / s e -s / * s e -s / q / s e -s / / q / s e -s / q / s e -s / s * s * s / q / s e -s / -e -s / -e) or => (s e -s / q / s e -s / s * s * s / q / s e -s / -q -s / q / s e -s / q / s e -s / s * s * s / q / s e -s / -e -s / s * e * s / q / s e -s / * s e -s / q / s e -s / * s e -s / q / s e -s / / q / s * e * s / q / s e -s / s * s * s / q / s e -s / h -s / h) . . . (length-lsystem 'llen :depth 2) => (s e -s e t e -s e t e -s t e = = t e -s - - t e -s e t e -s = e -s e t e -s = e -s e t e -s = t e -s e t e -s t e = = t e -s -e -s -e) Best wishes, Janusz Submitter opmo Submitted 06/11/2018 Category Opusmodus Latest Release
  3. 2 points
    AM

    filter-repeat for pairs?

    is there a possibility to filter some "combinations"? when i have a seq like that: (a4 gs4 a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) i want to filter all immediate repetitions with pattern-length = 2 the result would be: (a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) because a4-gs4 is the pair that repeats
  4. 2 points
    Stephane Boussuge

    Opusmodus 1.2.23428

    Thank you for this update Janusz, the possibility to specify the snippets audition parameters directly into the code was very useful for me for designing and test instrument by instrument the orchestral template based on EastWest Hollywood orchestra and Plogue Bidule shared into the Template and customisation section. no need to alway click and go to preferences just write some preconfigured code and evaluate it depend on your need Very convenient SB.
  5. 2 points
    AM

    vector-range-drift

    (defun vector-range-drift (start end input &key (spread 8)) (let ((values (gen-divide (rnd-sum (length input) (primes spread)) input)) (n-values) (a-step) (b-step)) (progn (setf n-values (1- (length values))) (setf a-step (/ (car (difference (list (car start) (car end)))) n-values)) (setf b-step (/ (car (difference (list (cadr start) (cadr end)))) n-values)) (loop for i in values for a = (car start) then (incf a a-step) for b = (cadr start) then (incf b b-step) append (vector-range a b i))))) ;;;;; EXAMPLES -> MODULATE/DRIFT white-noise - with different spreads (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 10)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 6)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 5.6) (gen-white-noise 517))) (list-plot (vector-range-drift '(-1.1 1) '(-3.1 5.6) (gen-white-noise 317)))
  6. 2 points
    AM

    vector-range-drift

    INPUT-curves could be like that: (in that way you could imitate some early "xenakis-curves" when you map it to pitches :-)) (setf curve1 '(-5.1 -2.3 -1.1 -0.8 -0.3 -2.5)) (setf curve2 '(1.0 1.2 1.5 2.1 4.6 10.6)) (vector-range-drift curve1 curve2 (gen-white-noise 250)) as result: "imitated" by my old/simple function: (list-plot (append (vector-range-drift '(-5.1 1) '(-2.3 1.2) (gen-white-noise 50)) (vector-range-drift '(-2.3 1.2) '(-1.1 1.5) (gen-white-noise 50)) (vector-range-drift '(-1.1 1.5) '(-0.8 2.1) (gen-white-noise 50)) (vector-range-drift '(-0.8 2.1) '(-0.3 4.6) (gen-white-noise 50)) (vector-range-drift '(-0.3 4.6) '(-2.5 10.6) (gen-white-noise 50))))
  7. 2 points
    AM

    find-intervals*

    function edited - some small changes... extended: :intervals '(1 2 3) -> all these interval-combinations are shown or :intervals 2 (like before) new: :reduced-interval T or NIL (default NIL) -> when T only basic-intervals search (not 1 = 1 & 13 & 25, only in ONE octave) small example ;;; SIEVE with SYMM_STRUCTURE (setf sieve1 (pitch-transpose -6 (integer-to-pitch (gen-sieve '((0 39) (0 40)) '((5) (7)))))) (pitch-to-interval sieve1) ;;; search/permutate interval-combinations (setf pitchlist (find-intervals* sieve1 :intervals '(1 2 3) :reduced-interval t :chord nil)) (setf pitchlist (rnd-unique (length pitchlist) pitchlist)) ;;; change direction of the interval-pairs (setf pitchlist (loop for i in pitchlist when (prob? 0.4) collect (reverse i) else collect i)) ;;; remove immediate repetitions (setf pitchlist (filter-repeat 1 (flatten pitchlist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-score sieve-scan (:title "sieve-scan" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :velocity '(p) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. 2 points
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; rnd-walk in a pitchfield - with interval-control ;;; ;;; this is a little function which does an rnd-walk in a special way ;;; the function is checking all possible interval-pairs first inside the pitchfield ;;; so that is on one hand all the time "inside" the pitchfield/sieve, but also only ;;; uses the :POSSIBLE-INTERVALS, so you could control the "interval-color" of the walk ;;; in an non-chromatic-pitchfield/sieve ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun enlarge-intervals (possible-intervals &key (octaves 2)) (let ((possible-intervals (append possible-intervals (loop repeat octaves for i = 12 then (incf i 12) append (x+b possible-intervals i))))) (append possible-intervals (neg! possible-intervals)))) ;(enlarge-intervals '(2 3 4)) ;;;;;;;;;;; (defun special-rnd-walk (n &key pitchfield startpitch possible-intervals (interval-octaves 2)) (let ((int-list (loop for i in pitchfield collect (list (pitch-to-midi i) (loop for x in pitchfield with int do (setf int (car (pitch-to-interval (list i x)))) when (/= int 0) collect int)))) (possible-intervals (enlarge-intervals possible-intervals :octaves interval-octaves))) (append (list startpitch) (midi-to-pitch (loop repeat n with int with pitch = (pitch-to-midi startpitch) do (setf int (rnd-pick (filter-preserve possible-intervals (cadr (assoc pitch int-list))))) when (null int) do (setf int (rnd-pick (cadr (assoc pitch int-list)))) collect (setf pitch (pitch-to-midi (cadr (interval-to-pitch (list int) :start (midi-to-pitch pitch)))))))))) ;;;;;;;;;;; EXAMPLES ;;; rnd-walk in a "chromatic-field" - as the most easiest example/way ;;; => so all possible-intervals could be used -> THE ORDINARY WAY... (special-rnd-walk 20 :startpitch 'cs4 :pitchfield '(gs3 a3 bb3 b3 c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4) :possible-intervals '(1 2 3)) ;;; BUT have a look to the next examples!!! ;;; rnd-walk in a PITCHFIELD -> the function is checking all possible interval-pairs inside the pitchfield ;;; so that the rnd-walk INSIDE the PITCHFIELD could be done with specific intervals (if they are inside the field) ;;; COMPARE THE RESULT with the PITCHFIELD!!! ;;; (setf pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) ;;; "interval-color" of the walk is made with :possible-intervals (special-rnd-walk 5 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(1 2 3)) ; + octaves of this intervals (special-rnd-walk 10 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(1 3 4 5) :interval-octaves 0) ;;; reduced interval-span (special-rnd-walk 10 :startpitch 'ds4 :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6) :possible-intervals '(5 6 7)) ; + octaves of this intervals more examples -> SOUND ;;; rnd-versions so you will here the different interval-colors inside the pitchfield (setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch)) ;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch)) ;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) (setf pitchlist (special-rnd-walk (rnd-pick '(3 5 7 11)) :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals (rnd-pick '((1 2) (3 4) (5 6 7))) :interval-octaves 3)) (def-score intervals (:title "walk" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; rnd-walk in SIEVE only with intervals '(5 6 8) (setf seq (gen-sieve '((c4 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch)) (setf pitchlist (special-rnd-walk 30 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(5 6 8))) (def-score intervals (:title "intervals" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) (setf seq (gen-sieve '((c2 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch)) ;;; EXAMPLE with changes -> all inside the same SIEVE (setf pitchlist (append (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(1)) ; minor second (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(2)) ; major second (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(3 4)) ;thirds (special-rnd-walk 50 :startpitch (rnd-pick seq) :pitchfield seq :possible-intervals '(5 7)))) ; fourth-fifth (def-score intervals (:title "intervals" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano))
  9. 1 point
    opmo

    filter-repeat for pairs?

    With the next release. I wonder if the result should remove the repeats of single notes: (filter-repeat 1 '(a4 gs4 a4 gs4 a4 fs4 gs4 g5 bb5 g5 g5 g5 gs4 a4 gs4) :seq 2) => (a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4 a4 gs4)
  10. 1 point
    opmo

    Opusmodus 1.2.23392

    View File Opusmodus 1.2.23392 New functions: rnd-sum-to-size vector-shift (thanks to Andre Meier) rnd-sum-to-size This function returns a list of numbers which add up to N and a given size (list length). If total was not reached in a given size in a trial, altered numbers are append to the numbers set. (rnd-sum-to-size 11 5 '(1 2 3)) => (2 3 1 3 2) Set random :seed to ensure recurring output: (rnd-sum-to-size 11 5 '(1 2 3) :seed 879) => (1 2 2 3 3) Examples: (rnd-sum-to-size 45 8 '(2 3 5 7 11 13 17 19)) => (2 11 3 5 13 2 2 7) (rnd-sum-to-size 25 7 '(6 11 13 1 3) :seed 436) => (6 3 3 3 1 3 6) (rnd-sum-to-size 25 3 '(6 11 13 1 3) :seed 436) => (11 13 1) (rnd-sum-to-size 25 11 '(6 1 3) :seed 13) => (3 1 1 6 1 1 6 1 3 1 1) (rnd-sum-to-size 45 22 '(1 2 3) :seed 835) => (3 3 3 1 2 3 1 2 2 3 1 2 3 1 1 1 1 3 2 3 2 2) In the next two examples the numbers set is altered: (rnd-sum-to-size 8 7 '(9 8 6) :seed 45) => (1 1 1 1 2 1 1) (rnd-sum-to-size 17 7 '(1 2) :seed 234) => (2 3 1 3 3 3 2) vector-shift This function applies ‘ambitus series’ derived from wave1 and wave2 values into a list of floating-point numbers. Lets examine first how wave1 and wave2 create the ambitus series (low high). We mix the two waves first and then we apply a sort function: (setf wave1 '(-5.1 -2.3 1.5 -0.8 4.6 10.6)) (setf wave2 '(1.0 1.2 -1.1 2.1 -0.3 -2.5)) (sort-asc (gen-mix wave1 wave2)) => ((-5.1 1.0) (-2.3 1.2) (-1.1 1.5) (-0.8 2.1) (-0.3 4.6) (-2.5 10.6)) From the two waves above the function creates five ambitus series each with two lists: start (low high) and end (low high). Start End ((-5.1 1.0) (-2.3 1.2)) ((-2.3 1.2) (-1.1 1.5)) ((-1.1 1.5) (-0.8 2.1)) ((-0.8 2.1) (-0.3 4.6)) ((-0.3 4.6) (-2.5 10.6)) Next, the values list (floating-point numbers) is divided by the count of the ambitus series. In our example the count is 5: (setf values (gen-white-noise 120)) (/ (length values) 5) => 24 The final process is to select randomly segment numbers for each of the 5 sublists: With :type 1 (rnd-sum 24 '(2 3 5 7 11 13 17 19)) => (2 7 13 2) With :type 2 (length segments) (rnd-sum-to-size 24 8 '(2 3 5 7 11 13 17 19)) => (3 3 3 3 3 3 3 3) Lets see the result: (list-plot (vector-shift wave1 wave2 (gen-white-noise 120))) A slightly different result we can achieve with optional :type 2: (list-plot (vector-shift wave1 wave2 (gen-white-noise 120) :type 2)) Examples: (list-plot (vector-shift '(-7.1 1) '(-0.1 10) (gen-white-noise 356))) (list-plot (vector-shift '(-7.1 1) '(-0.1 10) (gen-white-noise 356) :segment '(1 2 3))) (list-plot (vector-shift '(-7.1 1) '(-0.1 10) (gen-white-noise 356) :segment '(1 2 3) :type 2)) (list-plot (vector-shift '(4.2456284 7.2268248 6.4440737) '(3.682579 8.78879 10.000002) (gen-white-noise 356) :segment (primes 12))) (list-plot (vector-shift '(4.2456284 7.2268248 6.4440737) '(3.682579 8.78879 10.000002) (gen-white-noise 356) :segment (primes 12) :type 2)) (setf wave1 '(-5.1 -2.3 1.5 -0.8 4.6 10.6)) (setf wave2 '(1.0 1.2 -1.1 2.1 -0.3 -2.5)) (list-plot (vector-shift wave1 wave2 (gen-white-noise 356))) (list-plot (vector-shift wave1 wave2 (gen-white-noise 356) :type 2)) (list-plot (vector-shift (rnd 12 :low -1.0 :high 4.0 :seed 45) (rnd 12 :low -1.0 :high 4.0 :seed 23) (gen-white-noise 356) :segment '(1 2 3))) (list-plot (vector-shift (rnd 12 :low -1.0 :high 4.0 :seed 45) (rnd 12 :low -1.0 :high 4.0 :seed 23) (gen-white-noise 356) :segment '(1 2 3) :type 2)) (list-plot (vector-shift (rnd 12 :low -1.0 :high 4.0 :seed 45) (rnd 12 :low -1.0 :high 4.0 :seed 23) (gen-white-noise 356) :segment '(3 6 9))) (list-plot (vector-shift (rnd 12 :low -1.0 :high 4.0 :seed 45) (rnd 12 :low -1.0 :high 4.0 :seed 23) (gen-white-noise 356) :segment (primes 12))) (setf wave3 '(.2 .1 .5 .1 .8 .5 .1 .4 .2 .3)) (list-plot (vector-shift (gen-tendency 24 wave3) (gen-tendency 24 wave3) (gen-tendency 356 wave3) :segment (primes 6))) (list-plot (vector-shift (gen-tendency 24 wave3) (gen-tendency 24 wave3) (gen-tendency 356 wave3) :segment (primes 6) :type 2)) Best wishes, JP Submitter opmo Submitted 06/06/2018 Category Opusmodus Latest Release  
  11. 1 point
    AM

    logikgatter / logic gates (completed)

    complementation to OR/AND/NOT! i hope everything is correct... https://de.wikipedia.org/wiki/Logikgatter (defun nand (&rest rest) (flet ((every-truep (x) (equal x t))) (not (every #'every-truep rest)))) (nand nil nil nil) => t (nand t t t t t t) => nil (nand nil t t t nil t) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun nor (&rest rest) (contain-itemp 'nil rest)) (nor t t t t) => nil (nor nil t nil) => t (nor t nil nil nil) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xor (&rest rest) (oddp (car (count-item t rest)))) (xor t nil t t nil nil nil) => t (xor t t nil) => nil (xor nil t) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xnor (&rest rest) (evenp (car (count-item t rest)))) (xnor t nil t t nil nil nil) => nil (xnor t t nil) => t (xnor nil t) => nil (xnor t nil t t nil nil t nil) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. 1 point
    opmo

    vector-range-drift

    I will make it that way.
  13. 1 point
    opmo

    how to code a NAND gate?

    Few more function which could be useful for you (part of the system): (contain-itemp 'inv '(c 7b9s11 inv 1 chord)) => t (contain-itemp '= '(e f d s)) => nil (contain-itemsp '(9 8) '(0 1 11 8 10 9)) => t (contain-sequencep '(11 8) '(0 1 11 8 10 9)) => t JP
  14. 1 point
    AM

    vector-range-drift

    perhaps you could expand the function when we could not only have "start->end-process/linear", also with a seq-curve (two) for LOW and HIGH values... would be very smart. so it's a kind of ambitus-modulation (with perhaps white-noise)
  15. 1 point
    opmo

    Opusmodus 1.2.23374

    View File Opusmodus 1.2.23374 New: GEN-CHORD-SERIES I think many of you will love the new function The function GEN-CHORD-SERIES builds chords using a scale in three types of harmonic steps: fifth (default), fourth and third. The scale needs to be in a range between c4 and b4 (0 11) and the root must be an element of the scale. Method 1 Fifth: (c4 g4 d5 a5 e6 b6 f7) (d4 a4 e5 b5 f6 c7 g7) (e4 b4 f5 c6 g6 d7 a7) (f4 c5 g5 d6 a6 e7 b7) (g4 d5 a5 e6 b6 f7 c8) (a4 e5 b5 f6 c7 g7 d8) (b4 f5 c6 g6 d7 a7 e8) Fourth: (c4 f4 b4 e5 a5 d6 g6) (d4 g4 c5 f5 b5 e6 a6) (e4 a4 d5 g5 c6 f6 b6) (f4 b4 e5 a5 d6 g6 c7) (g4 c5 f5 b5 e6 a6 d7) (a4 d5 g5 c6 f6 b6 e7) (b4 e5 a5 d6 g6 c7 f7) Third: (c4 e4 g4 b4 d5 f5 a5) (d5 f5 a5 c6 e6 g6 b6) (e4 g4 b4 d5 f5 a5 c6) (f4 a4 c5 e5 g5 b5 d6) (g4 b4 d5 f5 a5 c6 e6) (a4 c5 e5 g5 b5 d6 f6) (b4 d5 f5 a5 c6 e6 g6) Method 2 (intervals) Fifth: (7 7 7 7 7 7 -5 -5 -5 -5 -5) Fourth: (5 5 5 5 5 5 5 -7 -7 -7 -7) Third: (3 3 3 4 3 3 3 4 3 3 3) For example if the root is fs4 and the type is 5 (fifth) then the map we use is: (f4 c5 g5 d6 a6 e7 b7). In method 1 it doesn’t matter whether the notes are natural, sharp, or flat. Let’s examine the three types: (setf hexachord '(d4 eb4 fs4 g4 a4 bb4)) Fifth: (gen-chord-series hexachord 'fs4) => (fs4g4d5a5eb6bb5) Third: (gen-chord-series hexachord 'fs4 :type 3) => (fs4a4eb5g5bb5d6) Fourth: (gen-chord-series hexachord 'fs4 :type 4) => (fs4bb4eb5a5d6g5) Examples: Building chords using a hexachord scale: (gen-chord-series hexachord 'fs4 :type 3 :segment t) => (fs4eb5bb5 a4g5d6) With the segment option set to T we divide the chord into two segments by selecting every other second note: (gen-chord-series hexachord '(fs4 fs4) :type 3 :width '(30 24) :segment t) => (fs4eb5bb5 a4g5d6 fs4eb5bb5 a4g5d5) Below the type is selected at random: (gen-chord-series hexachord '(fs4 a4 d4) :type '? :segment '? :seed 56) => (fs4bb4eb5a5d6g5 a4d5g5fs6bb5eb6 d4a4g5 fs4eb5bb5) In the next few examples we use a list of width values (ambitus) - each value assigned to each chord: (gen-chord-series hexachord hexachord :type 3 :width '(30 24 36 12)) => (d4fs4a4eb5g5bb5 eb4g4bb4d5fs5a5 fs4a4eb5g5bb5d6 g4bb4d4fs4a4eb4 a4eb5g5bb5d6fs6 bb4d5fs5a5eb5g5) Please note, if the root list length is bigger than the width list length then the width list values will be looped: (gen-chord-series hexachord hexachord :type 4 :width '(30 24 36 12)) => (d4g4fs5bb5eb6a5 eb4a4d5g5fs5bb5 fs4bb4eb5a5d6g6 g4fs4bb4eb4a4d4 a4d5g5fs6bb5eb6 bb4eb5a5d5g5fs5) (gen-chord-series hexachord hexachord :width '(30 24 36 12)) => (d4a4eb5bb5fs6g5 eb4bb4fs5g5d5a5 fs4g4d5a5eb6bb6 g4d4a4eb4bb4fs4 a4eb5bb5fs6g5d6 bb4fs5g5d5a5eb5) (gen-chord-series hexachord hexachord :type '? :width '(30 24 36 12) :segment t :seed 23) => (d4a4g5 fs4eb5bb5 eb4fs5d5 bb4g5a5 fs4eb5d6 bb4a5g6 g4d4a4 bb4fs4eb4 a4g5d6 eb5bb5fs6 bb4a5g5 eb5d5fs5) Building chords using C Major scale: (setf c-major '(c4 d4 e4 f4 g4 a4 b4)) (gen-chord-series c-major c-major :width 36) => (c4g4d5a5e6b6f6 d4a4e5b5f6c7g6 e4b4f5c6g6d6a6 f4c5g5d6a6e6b6 g4d5a5e6b6f6c7 a4e5b5f6c7g6d6 b4f5c6g6d6a6e6) (gen-chord-series c-major c-major :type 3 :width 36) => (c4e4g4b4d5f5a5 d4f4a4c5e5g5b5 e4g4b4d5f5a5c6 f4a4c5e5g5b5d6 g4b4d5f5a5c6e6 a4c5e5g5b5d6f6 b4d5f5a5c6e6g6) (gen-chord-series c-major c-major :type 4 :width 36) => (c4f4b4e5a5d6g6 d4g4c5f5b5e6a6 e4a4d5g5c6f6b6 f4b4e5a5d6g6c7 g4c5f5b5e6a6d6 a4d5g5c6f6b6e6 b4e5a5d6g6c7f6) Here we use transposition values for each chord or segments: (gen-chord-series c-major '(b4 f4 d4 c4 e4 g4 a4) :type '? :width 36 :segment t :seed 45 :transpose '(0 6 -1 13)) => (b4a5g6f6 e5d6c7 b4cs6eb6f6 fs5gs6bb6 cs4gs4eb5bb5 e4b4fs5 cs5gs5eb6bb6 f5c6fs6 e4f5g6a6 b4c6d6 cs5eb6f6fs6 gs5bb6b6 gs4eb5bb5e6 b4fs5cs6) (gen-chord-series c-major (rnd-order c-major :seed 543) :type '? :width '(12 12 18 24 30 36 36) :segment t :seed 5462) => (a4e4b4f4 c5g4d4 d4c5b4a4 g4f4e4 e4b4f5c5 g4d5a4 b4c6d5e5 f5g5a5 c4b4a5g5 f4e5d6 g4a5b6c7 d5e6f6 f4e5d6c7 b4a5g6) (gen-chord-series c-major '(f4 b4 d4) :width 12 :type 3 :chord nil) => ((f4 a4 c5 e4 g4 b4 d4) (b4 d4 f4 a4 c5 e4 g4) (d4 f4 a4 c5 e4 g4 b4)) (gen-chord-series c-major '(f4 b4 d4) :width 12 :type 4 :chord nil) => ((f4 b4 e4 a4 d4 g4 c5) (b4 e4 a4 d4 g4 c5 f4) (d4 g4 c5 f4 b4 e4 a4)) (gen-chord-series c-major '(f4 b4 d4) :width '(36 24 28) :chord nil) => ((f4 c5 g5 d6 a6 e6 b6) (b4 f5 c6 g5 d5 a5 e5) (d4 a4 e5 b5 f5 c6 g5)) Some more examples with method 1 and method 2: (setf a-scale '(c4 eb4 e4 g4 gs4 b4)) First with method 1 (default): (gen-chord-series a-scale a-scale :type '(4 4 5 5 4 3) :width 36 :segment t) => (c4eb5g5 b4e5gs5 eb4g4c5 e4gs4b5 e4g4c5 eb4gs4b5 g4c5eb6 gs4b5e6 gs4c5eb6 g4b5e6 b4e5gs5 eb5g5c6) Now with method 2: (gen-chord-series a-scale a-scale :type '(4 4 5 5 4 3) :method 2 :width 36 :segment t) => (c4eb5e6 g4gs5b6 eb4b4e5 gs4c5g5 e4g5c6 b4gs5eb6 g4e5eb6 c5b5gs6 gs4b5c7 eb5e6g6 b4c6e6 gs5eb6g6) (setf chrom '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4)) (gen-chord-series chrom chrom :method 1 :width 36) (gen-chord-series chrom chrom :method 2 :width 36) (gen-chord-series chrom chrom :method 1 :width 36 :segment t) (gen-chord-series chrom chrom :method 2 :width 36 :segment t) As we can see there are endless possibilities. Just copy a few of the expressions to your Composer (Editor) and start exploring. Best wishes, Janusz Submitter opmo Submitted 05/13/2018 Category Opusmodus Latest Release
  16. 1 point
    loopyc

    Opusmodus Vs. Symbolic Composer

    oneder, I wrote Peter Stone around that time, and he stated that he was very busy on a project(s) and would update at some time in future but DID take the time to assist me. He has been at this a long time (my original copy of SCOM I have been upgrading from was purchased for an Atari in the early 90's!), and he has always replied to my emails over that long period...but I imagine SCOM is not necessarily 'in demand' such to be a priority from a marketing standpoint i.e the website. If you need support, write him directly... he has always presented himself to me as a professional and a gentleman, and has maintained SCOM for decades now... just appears to have other areas of his life he is fully committed to right now ;-)
  17. 1 point
    AM

    find-intervals*

    i coded it to analyze a pitchfield ;;; a function witch filters/shows you all pitch-combinations by INTERVAL-SIZE ;;; from 1 to 11 ("octave-independent") ;;; for example you are interested to see all FIFTH-combinations in a SIEVE ;;; or to LIST all resulting/ordered intervals (defun equal/or (n alist) (car (loop for i in alist when (equal i n) collect 't))) ;;; FUNCTION (defun find-intervals* (pitch-seq &key (intervals 'all) (chord nil) (reduced-interval nil)) (let ((combs (combination 2 pitch-seq)) (ints) (int) (all-comb-pitches-intervals)) (progn (setf ints (loop for i in combs do (setf int (car (pitch-to-interval i))) when (>= int 0) collect (cond ((and (>= int 12) (<= int 24) (equal reduced-interval nil)) (- int 12)) ((and (>= int 24) (equal reduced-interval nil)) (- int 24)) (t int)))) (setf all-comb-pitches-intervals (loop for i from 1 upto 11 append (loop for j in (loop for x in combs for y in ints collect (cons y x)) when (= (car j) i) collect j))) (if (equal intervals 'all+int) all-comb-pitches-intervals (if (equal intervals 'all) (loop for i in all-comb-pitches-intervals when (equal chord t) collect (chordize (rest i)) else collect (rest i)) (loop for i in all-comb-pitches-intervals when (if (listp intervals) (equal/or (car i) intervals) (= (car i) intervals)); when (= (car i) intervals) collect (if (equal chord t) (chordize (rest i)) (rest i)))))))) ;;; EXAMPLES (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals '(1 5 7) ;; as list :reduced-interval t ;; -> only on/in the same octave :chord nil) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals '(1 3 7) :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 'all :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 2 :chord t) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 3) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 5) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 7) (find-intervals* (gen-sieve '(c3 g7) '(3 1 5) :type :pitch) :intervals 'all) other example -> cmd3 (setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch)) ;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch)) ;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)) (append (find-intervals* seq :intervals 1 :chord t) (find-intervals* seq :intervals 2 :chord t) (find-intervals* seq :intervals 5 :chord t) (find-intervals* seq :intervals 6 :chord t) (find-intervals* seq :intervals 8 :chord t)) (find-intervals* seq :intervals 'all :chord t) ;;; with interval-sizes in output-format (find-intervals* seq :intervals 'all+int) => ((1 a3 bb5) (1 b3 c4) (1 b3 c6) (1 c4 cs4) (1 cs4 d4) (1 cs4 d6) (1 d4 eb5) (1 gs4 a5) (1 a5 bb5) (1 bb5 b5) (1 b5 c6) (2 f3 g5) (2 a3 b3) (2 a3 b5) (2 b3 cs4) (2 c4 d4) (2 c4 d6) (2 cs4 eb5) (2 d4 e4) (2 e4 fs6) (2 gs4 bb5) (2 g5 a5) (2 a5 b5) (2 bb5 c6) (2 c6 d6) (3 f3 gs4) (3 a3 c4) (3 a3 c6) (3 b3 d4) (3 b3 d6) (3 c4 eb5) (3 cs4 e4) (3 e4 g5) (3 gs4 b5) (3 eb5 fs6) (3 g5 bb5) (3 a5 c6) (3 b5 d6) (4 f3 a3) (4 f3 a5) (4 a3 cs4) (4 b3 eb5) (4 c4 e4) (4 d4 fs6) (4 e4 gs4) (4 gs4 c6) (4 eb5 g5) (4 g5 b5) (4 bb5 d6) (4 d6 fs6) (5 f3 bb5) (5 a3 d4) (5 a3 d6) (5 b3 e4) (5 cs4 fs6) (5 d4 g5) (5 e4 a5) (5 g5 c6) (5 a5 d6) (6 f3 b3) (6 f3 b5) (6 a3 eb5) (6 c4 fs6) (6 cs4 g5) (6 d4 gs4) (6 e4 bb5) (6 gs4 d6) (6 eb5 a5) (6 c6 fs6) (7 f3 c4) (7 f3 c6) (7 a3 e4) (7 b3 fs6) (7 c4 g5) (7 cs4 gs4) (7 d4 a5) (7 e4 b5) (7 gs4 eb5) (7 eb5 bb5) (7 g5 d6) (7 b5 fs6) (8 f3 cs4) (8 b3 g5) (8 c4 gs4) (8 cs4 a5) (8 d4 bb5) (8 e4 c6) (8 eb5 b5) (8 bb5 fs6) (9 f3 d4) (9 f3 d6) (9 a3 fs6) (9 b3 gs4) (9 c4 a5) (9 cs4 bb5) (9 d4 b5) (9 eb5 c6) (9 a5 fs6) (10 f3 eb5) (10 a3 g5) (10 b3 a5) (10 c4 bb5) (10 cs4 b5) (10 d4 c6) (10 e4 d6) (10 gs4 fs6) (11 f3 e4) (11 a3 gs4) (11 b3 bb5) (11 c4 b5) (11 cs4 c6) (11 e4 eb5) (11 gs4 g5) (11 eb5 d6) (11 g5 fs6)) perhaps OPMO could extend it to an omn-format-FILTER - so that all other pitches (not matched pitches/sets) would be repaced by rests? would be interesting to work like that with pitchfields/sieves. so you could choose ...for example: "want to have all FIFTHS including a pitch like C or Eb or Gs (octave independent)...?
  18. 1 point
    opmo

    filter-repeat for pairs?

    Yes, we should have function like that.
  19. 1 point
    AM

    gen-brownian-bridge

    something new... greetings andré ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; BROWNIAN BRIDGE -> could be use as a rnd-process from A to B (integers or pitches) ;;; if you have a look to example with ":all-gen t", you will see the process with all generations, how it works ;;; or take a look to: ;;; https://de.wikipedia.org/wiki/Wiener-Prozess#/media/File:BrownscheBewegung.png ;;; https://de.wikipedia.org/wiki/Brownsche_Brücke ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUB (defun pick (a b &key (span 5)) (let ((rnd1 (car (rnd-number 1 (+ a span) (- a span)))) (rnd2 (car (rnd-number 1 (+ b span) (- b span)))) (n)) (progn (setf n (car (rnd-number 1 rnd1 rnd2))) (if (or (= n a) (= n b)) (+ (rnd-pick '(1 -1)) n) n)))) ;;; MAIN ;;; MAIN (defun gen-brownian-bridge (n startend &key (all-gen nil) (output 'integer) (span 5)) (let ((seq)) (progn (setf seq (append (list startend) (loop repeat n with liste = startend do (setf liste (filter-repeat 1 (loop repeat (1- (length liste)) for cnt = 0 then (incf cnt) append (append (list (nth cnt liste) (pick (nth cnt liste) (nth (1+ cnt) liste) :span span) (nth (1+ cnt) liste)))))) collect liste))) (setf seq (if (equal all-gen t) seq (car (last seq)))) (if (equal output 'pitch) (integer-to-pitch seq) seq)))) ;;; EXAMPLES ;; SPAN influence -> span 2 (list-plot (gen-brownian-bridge 5 '(50 23) :span 2 :all-gen t) :zero-based t :point-radius 3 :join-points t) ;; SPAN influence -> span 10 (list-plot (gen-brownian-bridge 5 '(50 23) :span 20 :all-gen t) :zero-based t :point-radius 3 :join-points t) ;;; SPAN default (5) (list-plot (gen-brownian-bridge 5 '(50 23) :all-gen t) :zero-based t :point-radius 3 :join-points t) (list-plot (gen-brownian-bridge 5 '(50 23)) :zero-based t :point-radius 3 :join-points t) (gen-brownian-bridge 5 '(50 23) :all-gen t :output 'pitch) (gen-brownian-bridge 5 '(50 23) :output 'pitch) some sound-examples ;;; EXAMPLE with ALL GENS / seperated by rests (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 72) (instrument :omn (make-omn :pitch (setf n (gen-brownian-bridge 5 '(30 10) :all-gen t :output 'pitch)) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; EXAMPLE with LAST GEN -> rnd-evaluations => rnd-ways from a to b (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 72) (instrument :omn (make-omn :pitch (gen-brownian-bridge (car (rnd-number 1 2 7)) '(30 10) :output 'pitch) :length '(t) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) two examples with different SPAN on MESSIEAN's mode5 mapped with <tonality-map> ;;; on MESSIAENS- mode5 - > 8 cycles + SPAN 10 => bigger intervals/steps (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch (setf n (tonality-map '(messiaen-mode5 :map step :root 'fs3) (integer-to-pitch (gen-brownian-bridge 8 '(10 27) :span 10 :all-gen t)))) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;; on MESSIAENS- mode5 - > 8 cycles + SPAN 3 => smaller intervals/steps (def-score brownian-bridge (:title "score title" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch (setf n (tonality-map '(messiaen-mode5 :map step :root 'fs3) (integer-to-pitch (gen-brownian-bridge 8 '(10 27) :span 3 :all-gen t)))) :length (loop for i in n append (list '-1/4 (loop repeat (length i) append '(t)))) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano))
  20. 1 point
    opmo

    sorting algorithms

    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) Descending: (list-plot (flatten (sorting (rnd-number 20 1 10 :seed 2346) :type 'selection :sort '>)) :zero-based t :point-radius 1 :join-points t) 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) 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) The default sort is ascending.
  21. 1 point
    AM

    sorting algorithms

    i solved the problems. here is a workspace/files to experiment with SORTING ALGORITHMS thanx to torsten and philippe! greetings andré functions.opmo abstract examples.opmo sound examples.opmo sorting algorithms.opmows
  22. 1 point
    torstenanders

    sorting algorithms

    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
  23. 1 point
    AM

    bubble-sort

    for a musical research project where i work with the sorting processes of different sorting algorithms (bubble-sort, heap-sort ...), i have to program such algorithms myself. the ide is that not only the end result of the algorithm is visible but also the constant changes (the mechansim). here the first: bubble-sort. very simple and inelegant programmed - but the thing i need to have :-) bubble-sort: https://en.wikipedia.org/wiki/Bubble_sort have a look to different sorting algorithms: greetings andré ;;; bubble-sort -> with all GEN's to see the process of sorting ;;; end-test "until (equal (sort-asc alist) list)" very uncommon (and strange), ;;; but most simple-stupid test to check the end, only okay for this kind of idea ("watching the process not the endresult") (defun bubble-sort (seq) (let ((alist)) (progn (setf alist (cond ((pitchp (car seq)) (pitch-to-midi seq)) ((lengthp (car seq)) (omn :length seq)) (t seq))) (setf alist (loop until (equal (sort-asc alist) list) with list = alist append (loop for i from 0 to (- (length list) 2) for j from 1 to (- (length list) 1) when (> (nth i list) (nth j list)) collect (setf list (position-swap (list j i) list)) else do (setf list list)))) (cond ((pitchp (car seq)) (midi-to-pitch alist)) (t alist))))) (bubble-sort (rnd-order '(c5 e4 g3 b7))) (bubble-sort (rnd-order '(t s e q h w))) (bubble-sort '(1 6 334 2 6 4 111))
  24. 1 point
    opmo

    length-to-decimal / length-to-sec

    I used this function for conversion of 4 instrument each with in its own tempo to one 'global' tempo. Examples: (length-tempo-map 72 36 '1/4) => 1/2 (length-tempo-map 72 36 'w) => 2 (length-tempo-map 72 88 '(1/8 1/4 -1/4)) => (9/88 9/44 -9/44) (length-tempo-map 72 '(120 36) '((1/8 1/4 -1/4) (1/16 1/8 -1/4 1/1))) => ((3/40 3/20 -3/20) (1/8 1/4 -1/2 2)) (length-tempo-map 72 '(36 96 72) '((1/20 1/20 1/20 1/20 1/20) (1/16 1/16 1/16 1/16 1/16 1/16 1/16 1/16) (1/8 1/8 1/8 1/8) (1/4 1/4 1/4 1/4 1/4 1/4 1/4 1/4)) :meter '(1 1 1)) => ((1/10 1/10 1/10 1/10 1/10) (1/8 1/8 1/8 1/8 1/8 1/8 1/8 1/8) (1/4 1/4 3/32 3/32) (3/16 3/16 3/16 1/4 1/4 1/4 1/4 1/2)) (length-tempo-map 72 36 '((e c4 e4 g4 h_e c5) (q c4 = = - - =) (q cs5 = - - = =))) => ((q c4 e4 g4 w_q c5) (h c4 = = - - =) (h cs5 = - - = =)) (length-tempo-map 72 '(36 96 72) '((e c4 e4 g4 h_e c5) (q c4 = = - - =) (q cs5 = - - = =)) :meter '(1 1 1)) => ((q c4 e4 g4 w_q c5) (e. c4 = = - -q =) (q cs5 = -h - = =))
  25. 1 point
    AM

    length-to-decimal / length-to-sec

    two functions i needed for working with POLYTEMPO-NETWORK http://philippekocher.ch/#109 http://polytempo.zhdk.ch greetings andré (defun length-to-decimal (alist &key (sum nil)) (let ((list (loop for i in (omn :length alist) collect (float (* i 4))))) (if (equal sum t) (sum list) list))) ;;; result: q = 1 / h. = 3 ...etc... (length-to-decimal '(h. h. 3q 5e 3h)) => (3.0 3.0 0.33333334 0.1 0.6666667) (length-to-decimal '(h. h. 3q 5e 3h) :sum t) => 7.1 (defun length-to-sec (alist tempo &key (sum nil)) (let ((list (loop for i in (omn :length alist) collect (* (/ 60 tempo) (float (* i 4)))))) (if (equal sum t) (sum list) list))) (length-to-sec '(h. h. 3q 5e 3h) 60) => (3.0 3.0 0.33333334 0.1 0.6666667) (length-to-sec '(h. h. 3q 5e 3h) 51) => (3.5294118 3.5294118 0.3921569 0.11764707 0.7843138) (length-to-sec '(h. h. 3q 5e 3h) 51 :sum t) => 8.3529415
×