Jump to content

AM

Members
  • Content Count

    600
  • Joined

  • Last visited

Everything posted by AM

  1. when i evaluate this: (setf pianomainHarm (tonality-map (append (gen-repeat 4 '((scale2))) (gen-repeat 4 '((scale1))) (gen-repeat 4 '((scale3))) ) pianomain)) Error: > Error: scale2 is not a tonality or a chord. > While executing: make-tonality, in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options. so, take a look what is your scale2 etc or it's in YOUR library, so i can't test YOUR score/code
  2. (apply #'mapcar #'(lambda (&rest all) all) lists)) this is really cool! :-)
  3. ;;; in "pure lisp" with NIL when lists have not the same length (defun trans* (lists) (loop repeat (car (last (sort-asc (mapcar 'length lists)))) for cnt = 0 then (incf cnt) collect (loop for i in lists collect (nth cnt i)))) (trans* '((1 2 3 4) (a b c d) (11 12 13 14) (k l m n))) (trans* '((1 2 3 4) (a b c d e) (11 12 13 14 14 16) (k l m n o p q r s t))) (trans* '((1 2 3 4) (a b c d e) (11 12 13 14) (k l m n r s t)))
  4. reset a pitch-sequence on a specific pitch (lowest, highest, middle pitch of the sequence) ;;;; SUB (defun center-position-in-list (list &key (get-value 'nil)) (let ((pos)) (progn (setf pos (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (if (equal get-value 'nil) (append pos) (nth (1- pos) list))))) ;;; MAIN (defun reset-pitch-sequence (pitch-sequence pitch &key (type 'low)) (let ((pitch1 (cond ((equal type 'low) (car (find-ambitus pitch-sequence :t
  5. same with gen-integer-step (defun gen-integer-step* (n intervals &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (setf seq (find-everyother every-x (subseq (gen-integer-step 0 (+ n offset) intervals) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq)))) (gen-integer-step* 20 '(1 -2 3 1)) => (0 1 -1 2 3 4 2 5 6 7 5 8 9 10 8 11 12 13 11 14) (gen-integer-step* 20 '(1 -2 3 1) :every-x 2) => (0 -1 3 2 6 5 9 8 12 11 15 14 18 17 21 20 24 23 27 26) (gen-integer-step* 20 '(1 -2 3 1) :offset 6 :every-x 4 :rev
  6. same with fibonacci (defun fibonacci* (n &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (setf seq (find-everyother every-x (subseq (fibonacci 0 (+ n offset)) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq)))) (fibonacci* 5 :offset 2) => (1 2 3 5 8) (fibonacci* 5 :offset 5 :every-x 2) => (5 13 34 89 233) (fibonacci* 5 :offset 5 :every-x 2 :reverse t) => (233 89 34 13 5) ;;;; in combination with "reading-list-by-steps" (defun reading-list-by-steps (&key steps values (start (car values))) (let
  7. a little prime-function-extension (defun primes* (n &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (progn (setf seq (find-everyother every-x (subseq (primes (+ n offset)) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq))))) (primes* 4 :offset 0) => (2 3 5 7) (primes* 4 :offset 1) => (3 5 7 11) (primes* 6 :offset 8) => (23 29 31 37 41 43) (primes* 5 :offset 5 :every-x 2) => (13 19 29 37 43) (primes* 5 :offset 3 :every-x 4) => (7 19 37 53 71) (primes* 5 :offset 5 :every-x 3 :reverse t) =
  8. new version, for LISTS with different-lengths => compensated ;;; SUB (defun compensate-list-lengths (somelists &key (value 0)) (let ((maxlength (find-max (mapcar 'length somelists)))) (loop for i in somelists when (< (length i) maxlength) collect (append i (loop repeat (- maxlength (length i)) collect value)) else collect i))) ;;; MAIN (defun sum-list-items (somelists &key (each-step nil)) (let ((somelists (compensate-list-lengths somelists)) (lista (car somelist
  9. it's not decimal-to-binary!!! another idea... for example... 6 => 1 0 0 0 0 0 = a "1" and 5 times a "0")
  10. perhaps there's a OM-solution... in this case it's to hard to find... (search-engine?) otherwise... (defun integer-to-binary-lengths* (alist) (loop for i in alist when (> (abs i) 1) append (append (list 1) (loop repeat (- (abs i) 1) collect 0)) else collect 1)) (integer-to-binary-lengths* '(2 2 2 1 1 4 4 4 4)) (integer-to-binary-lengths* '(6 4 8 5 2 1 10 2))
  11. i think a different idea!? in my code: sum first item of all lists sum second... sum third... ... but perhaps i'm wrong
  12. very simple, i used something like this for my work... but is there somthing like this in OM? greetings andré (defun sum-list-items* (somelists &key (each-step nil)) (let ((lista (car somelists)) (firstlist (car somelists))) (progn (setf somelists (loop for x in (rest somelists) collect (setf lista (loop for i in lista for j in x collect (+ i j))))) (if (equal each-step t) (a
  13. here's an example of the combination of gen-symmetrical* + gen-stacc* (length-list-plot (gen-stacc* (gen-length (gen-symmetrical* 8 (reverse (gen-divide 3 (primes 12))) :style 'unique :type 'hierarchic) 1/32) :symmetrical t :possible-stacc-lengths '(2/32 1/32 3/32)))
  14. some extensions to the basic function... greetings andré ;;; SUB (defun rnd-pick* (alist) (if (and (listp (first alist)) (floatp (second (first alist)))) (weighted-random alist) (rnd-pick alist))) (defun weighted-random (list) (loop for item in list with rand-num = (random (loop for x in list sum (second x))) for add = (second item) then (+ add (second item)) when (< rand-num add) return (first item))) ;;; MAIN (defun gen-symmetrical* (n list &key (type 'nil)) (if (equal type 'hierarchic) (progn (let ((alist (
  15. could be interesting for you... an really extend gen-stacc-function greetings andré ;;; SUB (defun center-position-in-list (list &key (get-value 'nil)) (let ((pos)) (progn (setf pos (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (if (equal get-value 'nil) (append pos) (nth (1- pos) list))))) ;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value nil) ;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value t) (defun gen-stacc3 (n-liste liste &key (stacc-chance 1
  16. ;;; alternative function for GEN-SYMMETRICAL: in combination ;;; with FIND-UNIQUE => symmetries with unique items (except ;;; what is generated by symmetry) (defun gen-symmetrical* (n list) (let ((list (rnd-order list)) (newlist (rest list)) (center (car list))) (if (> n (* 2 (length list))) 'list-has-too-few-items (if (evenp n) (progn (setf list (rnd-unique (/ n 2) newlist)) (append list (reverse list))) (progn (setf list (rnd-unique (/ (1- n) 2) (rest newlist))) (append list (list center)
  17. you are right, but it is okay for my use - if someone wants to make it smarter, it is very welcome - but I have to do some other things :-)
  18. ;;; CODE (defun shift-proportions (integer-seq shift &key (type 'primes)) (let ((number-seq)) (progn (setf number-seq (cond ((equal type 'primes) (primes 30)) ((equal type 'fibonacci) (fibonacci 1 20)) ((equal type 'decimal) (gen-integer-step 1 200 1)))) (setf number-seq (append (reverse (neg! number-seq)) number-seq)) (loop for i in integer-seq when (> i 0) collect (nth (+ (car (positio
  19. perhaps something like that? only a sketch... modify it... don't work in all cases... ;;; SUBFUNCTIONS ;;; TAKES A GIVEN TONAILTY AND EXPAND IT FOR X OCTAVES (defun multiple-expand-tonality (&key startpitch octaves tonality) (remove-duplicates (loop repeat octaves with pitch = startpitch with cnt = 0 when (= cnt (length tonality)) do (setq cnt 0) append (expand-tonality (list pitch (nth cnt tonality))) do (incf cnt) do (setq pitch (car (pitch-transpose 12 (list pitch))))))) ;;; EXPAND A TONALITY BY STEPS -> in a sense of schilli
  20. is it possible to do such a (nonsense-function) with mapcar (then with loop)? -> how should i handle the &key (y 1) with mapcar? possible? a function without &key is clear but with &key ....??? thanx for a note (defun testfu (value &key (y 1)) (* (random 10) value y)) (loop for i in '(1 2 3 4 5) for j in '(1 2 3 4 5) collect (testfu i :y j))
  21. i'm interested to see YOUR code :-) greetings
  22. you could work with omn-replace (from OM-library)? ...or some other code... have a look... greetings andré ;;; THREE SIMILAR FUNCTIONS FROM MY USER LIBRARY ;;; recognizes the parameter who has to be replaced (defun omn-component-replace (omn-sequence replace-component) (make-omn :length (if (lengthp (car replace-component)) (append replace-component) (omn :length omn-sequence)) :pitch (if (or (pitchp (car replace-component)) (chordp (car replace-component))) (append replace-component) (omn :p
  23. great... that's a smart solution :-) simpler then mine ...i didn't know how to set "-1" outside the FUNCTION without DEFSTRUCT thanx!! i like it when the program tells me that it has done the job... so i coded a little extension: (let ((i -1)) (defun next (liste &key (stop 'nil) (one-cycle 'nil)) (if (equal stop 't) (if (< i (1- (length liste))) (nth (mod (incf i) (length liste)) liste) (if (equal one-cycle 'nil) (progn (setf i -1) 'nil) 'nil)) (nth (mod (incf i) (length liste)) lis
×
×
  • Create New...

Important Information

Terms of Use Privacy Policy