Everything posted by AM
-
filter-omn-by-intervals
a sieve/filter-function - filters specific INTERVALS and replacing the others by rests. (don't work perfect, but as a sketch....) ;;; (defun equal/or (n alist) (car (loop for i in alist when (equal i n) collect 't))) ;;; FUNCTION (defun filter-omn-by-intervals (omn-seq intervals) (setf omn-seq (loop with omn-events = (single-events omn-seq) with i = 0 while (not (null (nth i omn-events))) when (equal/or (car (pitch-to-interval (append (omn :pitch (nth i omn-events)) (omn :pitch (nth (1+ i) omn-events))))) intervals) collect (list (nth i omn-events) (nth (1+ i) omn-events)) and do (incf i 2) else collect (neg! (car (omn :length (nth i omn-events)))) and do (incf i)))) ;;; EXAMPLE (setf basic-omn-seq (make-omn :pitch (vector-to-pitch '(c4 c6) (gen-white-noise 100 :type :logistic)) :length '(t) :span :pitch)) ;;; check out all these filter-tests (setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 2 3))) ;(setf omn-seq (filter-omn-by-intervals basic-omn-seq '(3 -3))) ;(setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 -1 5 -5 7 -7))) (def-score example (:title "example" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument1 :omn (flatten omn-seq) :channel 1 :sound 'gm-piano) (instrument2 :omn (flatten basic-omn-seq) :velocity 20 :channel 3 :sound 'gm-piano)) here is a more complex example (defvar library) (defvar abfolge) (defvar omn-seq) (defvar rhy) (defvar field) ;;;library + rhy -------------------------------------------------------------------------------- (setf rhy 44) ;;; LIBRARY MIRT RHY-PAAREN! (setf library (list '(eb5 5 p mute) '(e4 5 mf mute) '(gs4 3 f mute) '(g5 3 ppp mute) '(f6 2 p mute) '(cs4 1 f mute) '(d5 1 fff mute) '(b3 4 pppp mute) '(bb5 4 mp mute) '(a4 3 pp mute) '(fs3 (2 7) ppp mute) '(c6 (1 11) mp mute))) (setf library (loop for i in library collect (append (list (car i)) (if (listp (cadr i)) (gen-length (list (rnd-pick (cadr i))) rhy) (gen-length (list (cadr i)) rhy)) (filter-last 2 i)))) ;;; gen seq from library/abfolge--------------------------------------------------------------- (setf field '(eb5 e4 gs4 g5 f6 cs4 d5 b3 bb5 a4 fs3 c6)) (setf abfolge (pick-norepeat 500 field)) (setf omn-seq (loop for x in abfolge with y do (setf y (assoc x library)) append (append (reverse (filter-first 2 y)) (filter-last 2 y)))) (setf basic-omn-seq omn-seq) (setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 -1 11 -11 13 -13 4 -4 8 -8 16 -16 20 -20 28 -28 32 -32 7 -7 19 -19))) ;;;--------------------------------------------------------------------------------------------- (def-score example2 (:title "example2" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (flatten omn-seq) :channel 1 :sound 'gm-piano) (hidden-structure :omn (flatten basic-omn-seq) :channel 1 :velocity 0 :sound 'gm-piano)) ;;;--------------------------------------------------------------------------------------------- (omn-list-plot (flatten omn-seq) :join-points t)
-
a tiny function idea
(defun and-span (n a b) (and (>= n a) (<= n b))) (and-span 13 12 45) => t (and-span 2 12 45) => nil
-
rest-diminution/augmentation
i needed functions which shorten/enlarge only the RESTS of my complex/tupled-mixed texture - not precisely - so i coded it with diminution/augmentation+round (otherwise i would be in trouble by the crazy rests)... violà... use it or code it smarter for OMPO! greetings andré 3 functions: rest-diminution rest-augmentation only-length-augmentation ;;; (defun rest-diminution (omnlist &key (factor 1) (round 1/4)) (length-rest-merge (flatten (loop for i in (single-events (length-rest-merge omnlist)) when (< (car (omn :length i)) 0) collect (length-rational-quantize (length-diminution factor i) :round round) else collect i)))) (rest-diminution '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-q e4 mp -h e e4 ff) (rest-diminution '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-e q e4 mp -q. e e4 ff) ;;; (defun rest-augmentation (omnlist &key (factor 1) (round 1/4)) (length-rest-merge (flatten (loop for i in (single-events (length-rest-merge omnlist)) when (< (car (omn :length i)) 0) collect (length-rational-quantize (length-augmentation factor i) :round round) else collect i)))) (rest-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-q e4 mp -d. e e4 ff) (rest-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-q e4 mp -d. e e4 ff) ;;; (defun only-length-augmentation (omnlist &key (factor 1) (round 1/4)) (length-rest-merge (flatten (loop for i in (single-events (length-rest-merge omnlist)) when (> (car (omn :length i)) 0) collect (length-rational-quantize (length-augmentation factor i) :round round) else collect i)))) (only-length-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-3q h. e4 mp -w q. e4 ff) (only-length-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-3q h. e4 mp -w q. e4 ff -e)
- length-to-decimal / length-to-sec
-
filter-events-by-length
for pitch-seq or length-seq + vector-envelope you will need SPAN
-
filter-events-by-length
@janusz: you could expand it with conditionals like >, <, =, span .... and implement it.... and... if you would write this function with conditionals for pitches (sequences of pitches) you could filter by vector-envelope...
-
filter-events-by-length
you can filter all events by length (>= min). all other events will be replaced by rests... (defun filter-events-by-length (omnlist &key min) (let ((omnlist (single-events omnlist)) (min (car (omn :length (list min))))) (flatten (length-rest-merge (loop for i in omnlist when (>= (car (omn :length i)) min) collect i else collect (neg! (car (omn :length i)))))))) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'e) => (e c4 mf e d4 mf e e4 mf e e5 mf q c4 mf q d4 mf q e4 mf h c4 mf h d4 mf h e4 mf) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'q) => (-h q c4 mf q d4 mf q e4 mf h c4 mf h d4 mf h e4 mf) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'h) => (-wq h c4 mf h d4 mf h e4 mf)
- binary-filter
- binary-filter
-
replace-lengths-of-a-pitch-sequence
(defun replace-lengths-of-a-pitch-sequence (omn-list pitch-list length-list) (flatten (loop with cnt = 0 for i in (single-events omn-list) when (equal (cadr i) (nth cnt pitch-list)) collect (append (list (nth cnt length-list)) (rest i)) and do (incf cnt) else collect i when (= cnt (length pitch-list)) do (setf cnt 0)))) (setf white-series-l (vector-to-pitch '(c4 c5) (gen-white-noise 100 :type :logistic :seed 23))) (replace-lengths-of-a-pitch-sequence (cons 't white-series-l) '(e4 f4 a4 gs4 g4 b4 c5 bb4) '(2/16 3/16 4/16 5/16 6/16 7/16 8/16)) => '(t gs4 mf t g4 mf t g4 mf t c5 mf t g4 mf t gs4 mf 1/8 e4 mf 3/16 f4 mf t gs4 mf t gs4 mf t bb4 mf t gs4 mf t fs4 mf t fs4 mf t f4 mf t g4 mf t bb4 mf t b4 mf t b4 mf t g4 mf t e4 mf t g4 mf t fs4 mf t b4 mf 1/4 a4 mf t g4 mf t g4 mf t a4 mf t b4 mf t fs4 mf t bb4 mf t a4 mf 5/16 gs4 mf t a4 mf 3/8 g4 mf t a4 mf t a4 mf t a4 mf t a4 mf t a4 mf t f4 mf t bb4 mf t g4 mf t fs4 mf 7/16 b4 mf t a4 mf t g4 mf t bb4 mf t a4 mf t gs4 mf t a4 mf t gs4 mf t g4 mf t g4 mf t gs4 mf t a4 mf t f4 mf t f4 mf t bb4 mf t gs4 mf t fs4 mf t a4 mf t g4 mf t a4 mf t g4 mf t gs4 mf t bb4 mf t eb4 mf t bb4 mf t fs4 mf t fs4 mf t gs4 mf t g4 mf t gs4 mf t gs4 mf t c4 mf t gs4 mf t g4 mf t gs4 mf 1/2 c5 mf bb4 mf t gs4 mf t fs4 mf t fs4 mf t bb4 mf t a4 mf t g4 mf t g4 mf t b4 mf t g4 mf t f4 mf t g4 mf t gs4 mf t gs4 mf t gs4 mf t gs4 mf t fs4 mf t gs4 mf t eb4 mf t a4 mf)
-
omn-sieve-filter
(defun memberp (n liste) (not (equal 'nil (member n liste)))) ;;; MAIN (defun omn-sieve-filter (omn-list filter-list) (flatten (loop for i in (single-events omn-list) for j from 1 to (length omn-list) when (memberp j filter-list) collect i else collect (length-invert (car i))))) (omn-sieve-filter (make-omn :pitch (rnd-sample 10 '(c4 d4 e4 fs4 gs4) :seed 89) :length '(e) :span :pitch) '(1 2 3 5 8 9 10)) => (e c4 mf e gs4 mf e fs4 mf -1/8 e e4 mf -1/8 -1/8 e c4 mf e gs4 mf e fs4 mf)
-
binary-filter
something i've coded... (defun binary-filter (alist bin-list) (let ((event-list (cond ((omn-formp alist) (single-events alist)) (t alist)))) (flatten (loop for i in event-list for j in bin-list when (= j 1) collect i else append (cond ((omn-formp i) (list (length-invert (car i)))) ((lengthp i) (neg! (omn :length (list i))))))))) (binary-filter '(q -q -q q) '(0 1 0 1)) => (-1/4 -q -1/4 q) (binary-filter '(q q q q -q) '(0 1 0 1 1)) => (-1/4 q -1/4 q -q) (binary-filter '(c4 d4 e4 f4) '(1 1 0 1)) => (c4 d4 f4) (binary-filter '(q c4 mf d4 e4 e f4 ppp g4 a4 b4) '(1 0 1 1 0 1 1)) => (q c4 mf -1/4 q e4 mf e f4 ppp -1/8 e a4 ppp e b4 ppp)
-
neg-sieve
...how ti filter all "unused/complementary" pitches inside a sieve (if you like to extend the function... could be interesting if it works also with chords) (defun neg-sieve (pitchlist) (let ((pitchlist (pitch-to-midi pitchlist))) (midi-to-pitch (loop for i from (car pitchlist) to (car (last pitchlist)) when (null (member i pitchlist)) collect i)))) (setf sieve '(fs3 g3 as3 b3 c4 cs4 ds4 e4 f4 gs4 a4 d5 eb5 fs5 g5 gs5 bb5 b5 c6 cs6 e6 f6)) (neg-sieve sieve) => (gs3 a3 d4 fs4 g4 bb4 b4 c5 cs5 e5 f5 a5 d6 eb6) (neg-sieve '(c4 d4 e4 fs4 gs4 as4 c5)) => (cs4 eb4 f4 g4 a4 b4)
-
filter-repeat for pairs?
i think it's better when it's seperate. keep the function/process as simple and clear as possible?
-
filter-repeat for pairs?
yes, that's it!! already part of the system?
-
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
how to code a NAND gate?
👍
-
how to code a NAND gate?
exactly... thanks for the solution! i will try to CODE some XOR, NOR.... based on it! i was in trouble with the "input-format" (when it's not a list) 🤔
-
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))))
-
how to code a NAND gate?
hi all i would like to code a NAND gate with more then two input-items (as extension to AND etc...). here is a simple version of the NAND function with two inputs, but i don't know how to exapnd it to n-inputs without putting the the inputs to in a list (like lisp-internal AND / OR)... https://en.wikipedia.org/wiki/NAND_gate i dont't want it: (nand '(t t t nil)) but like to have (nand t nil nil t t t) when i get a solution for that i will code an XOR, NOR etc.... so the "problem" is: how to manage in DEFUN more then two inputs (don't work with &optional, i think) i tried it and failed)... any ideas, lisp-nerds? 🙂 thanx! andré ;;; easy with a specific number of input-items - that works! (defun nand (a b) (not (and a b))) (nand t t) => nil (nand nil nil) => t (nand nil t) => t ;;; i like to have an input perhaps like that - with any number of input-items, like lisp's AND / OR (nand t t t t) (nand nil t t t nil t t t nil) ...
-
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)
-
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)))
-
gen-sort-question
short question to GEN-SORT.... the original/start-sequence is not shown with GEN-SORT? i think it should... you see it when using 'min-max... so, i think the AXIOM must be shown greetings andré
-
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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
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