Jump to content

AM

Members
 View Profile  See their activity

  • Posts

    792

  • Joined

  • Last visited

 Content Type 

Posts posted by AM

    omn-component-replace

    in User Extensions Source Code

    Posted 

    ;;;function which replaces/rewrites the component in OMN-seq

(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 (pitchp (car replace-component))
                     (append replace-component)
                     (omn :pitch omn-sequence))
            :velocity (if (velocityp (car replace-component))
                        (append replace-component)
                        (omn :velocity omn-sequence))
            :articulation (if (articulationp (car replace-component))
                            (append replace-component)
                            (omn :articulation omn-sequence))))

(setf seq1 '(s gs3 ppp tasto q.t cs4 pppp tasto s f4 ppp tasto))
(omn-component-replace seq1 '(5/16 7/16 3/32))

     

    how to install screamer or...? help

    in User Extensions Source Code

    Posted

    dear janusz, stephan.......

     

    i tried to install SCREAMER via quicklisp... quicklisp-thing worked, but for the rest i'm to stupid... :-) coudl anyone help me.... where should i copy folders/files... i have no idea 

    ... i'm only a simple musician who is coding in lisp-OMN (but not more) :-)

     

    i would like i step by step...

     

    thanx

    andré

    pattern match => t / nil

    in User Extensions Source Code

    Posted

    thanks. yes i know it...

    but i'm working different... more "generative" (and not with many OMN-functions)... i have to check in every generation the output  on different parameters, and as a feedback i change when PATTERN-MATCH => T the data-DNA (the production-datas for next gen via (defstruct => make-.... )) or the function which generates something in the generative APP ...  most of the code is in pure LISP. it's great that i can code it like that in OPUSMODUS (very open!)...i can find my own solutions and ways, and it's not necessary to use the "official grammar" (always a problem with music-production-software), but i could i if i want :-)

     

    ... so i have a large personal USER LIBRARY now :-)

     

    thanks for your pracitcal examples how to work on OMN-level - i can learn a lot from them on OMN :-)

    regards

    andré

     

    rnd-split-number

    in User Extensions Source Code

    Posted 

    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;how to split randomly a number into "n-parts"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rnd-split-number (n &key (total-sum 1.0))
  (let ((values))
    (setq values (loop repeat (- n 1)
                   with val-a = total-sum
                   with val-b
                   collect (setq val-b (random val-a))
                   do (setq val-a (- val-a val-b))))
    (append values (list (- total-sum (sum values))))))


;; examples
(rnd-split-number 5 :total-sum 1.8)

=> (0.26645982 1.47964 0.014375878 0.014122969 0.025401235)

(rnd-split-number 3 :total-sum 9.8)

=> (5.1533704 1.7459779 2.900652)

     

    pattern matching + chance

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WHEN PATTERN-MATCH => T
;;; THEN WEIGHETD RANDOM DECIDING THE NEXT VALUE
;;; with :gate/:keyword = extra AND-function
;;; with :evaluate => you could evaluate a function-output directly
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; subfunctions

(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))


(defun test.pm.omn (seq pattern)
  (let ((seq (if (omn-formp seq)
               (cond ((lengthp (car pattern)) (omn :length seq))
                     ((pitchp (car pattern))(omn :pitch seq))
                     ((velocityp (car pattern)) (omn :velocity seq)))
               (append seq))))
    (pattern-match seq pattern)))


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


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

;; mainfunction
                            
(defun test.pm+chance (test.seq pattern values/weights &key keyword gate (evaluate 'nil))
  (let ((out))
    (setf out (if (and (test.pm.omn test.seq pattern) (equal keyword gate)) 
                (weighted-random values/weights)
                (append gate)))
    (if (equal evaluate 't)
      (eval out)
      (append out))))

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


;; example => works also with OMN etc...
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.15) (c 0.375) (d 0.21)))


;; more examples
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.25) (c 0.25)) :gate 'no-entry :keyword 'no-entry) ;; => key correct
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.5)) :gate 'no-entry :keyword 'whatever) ;; key incorrect
              
;; example with :evaluate T
(test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '(((cons 'a 'b) 0.5) ((cons 'c 'd) 0.5)) :evaluate t)

     

    pattern matching + markov

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WHEN PATTERN-MATCH => T 
;;; THEN MARKOV PRODUCES THE NEXT VALUES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; subfunctions

(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))

(defun test.pm.omn (seq pattern)
  (let ((seq (if (omn-formp seq)
               (cond ((lengthp (car pattern)) (omn :length seq))
                     ((pitchp (car pattern))(omn :pitch seq))
                     ((velocityp (car pattern)) (omn :velocity seq)))
               (append seq))))
    (pattern-match seq pattern)))


;; mainfuction

(defun test.pm+markov (seq pattern start-slot transitions &key (size 1))
  (if (test.pm.omn seq pattern)
    (if (= size 1)
      (car (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot)))
      (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot)))
    (append start-slot)))


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

(setf transitions '((a (a 2) (b 1))
                    (b (a 2) (b 1))))

(setq test-omn '(t fs4 pp tasto g4 ppp tasto -s. t e4 pppp tasto -s. t eb4 pp tasto -het - t))

;; examples1
(test.pm+markov test-omn '(pp ppp) 'a transitions) ;; evaluate a few times
(test.pm+markov test-omn '(fs4 g4) 'a transitions) ;; evaluate a few times
(test.pm+markov test-omn '(g2) 'a transitions) ;; evaluate a few times => no match => no new value
(test.pm+markov test-omn '(1/32 -3/32) 'a transitions) ;; evaluate a few times


;; examples2
(test.pm+markov test-omn '(pp) 'a transitions :size 5) ;; evaluate a few times
(test.pm+markov test-omn '(g4 e4) 'a transitions :size 3) ;; evaluate a few times

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

     

    pattern match => t / nil

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PATTERN MATCH FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; i needed some PATTERN_MATCH-FUNCTIONS (also with wildcards) 
;;; in my projects to check sequences
;;; output is t/nil - 
;;; implement it if you whant :-) regards, andré

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



(defun pattern-match (liste pattern) 
  (loop for z in liste
    with cnt = 0
    with pattern_cnt = 0

    when (or (equal  (nth cnt pattern) z)  (equal '? (nth cnt pattern)))
    do (incf pattern_cnt)
    and do (incf cnt)
    else do (setq cnt (setq pattern_cnt 0))

    when (equal pattern_cnt (length pattern))
    collect 't into bag and do (return (car bag))))


(pattern-match '(1 2 3 4 5 6 7 8) '(2 ? 3))
=> nil


(pattern-match '(1 2 3 4 5 6 7 8) '(2 ?))
=> t

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

(defun test.pm.length (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :length seq)
               (append seq))))                 
    (pattern-match seq pattern)))

(defun test.pm.pitch (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :pitch seq)
               (append seq))))                     
    (pattern-match seq pattern)))

(defun test.pm.velocity (seq pattern)
  (let ((seq (if (omn-formp seq)
               (omn :velocity seq)
               (append seq))))                     
    (pattern-match seq pattern)))

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

     

    ASHBY-OPERATOR

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR => some nonsense-sound-examples
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; little function for mapping...

(defun eliminate-repetitions (liste)

  (let ((liste (append liste (list 'nil))))
    (loop repeat (1- (length liste))
      with cnt = 0
      when  (not (equal (nth cnt liste) (nth (+ 1 cnt) liste)))
      collect (nth cnt liste)      
      do (incf cnt))))


;;; some examples

;(setq integers
;      (flatten (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17))))
(setq integers
      (flatten (ashby-operator-1 '( 3 1 4 0 7 8 9 10  5 6 2 11))))
;(setq integers
 ;     (flatten (ashby-operator-1 (gen-sieve '(c4 c7) '(1 2 3)))))


;;; mapping

(setq pitches (eliminate-repetitions (integer-to-pitch integers)))

(def-score example
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch pitches
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
#|

(def-score example-reverse
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch (reverse pitches)
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
|#

     

    ASHBY-OPERATOR

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; i coded somethings special, that i have seen in a book
;;; of HEINZ VON FOERSTER (my favorite writer/philosopher..)
;;; https://en.wikipedia.org/wiki/Heinz_von_Foerster
;;; => i didn't found this ASHBY-algo (he is writing about it)
;;; anywhere else, but for me it was interesting to code it.

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

;;; every list of integers (from 0 to ?) will end with "0"
;;; perhaps you could map it with whatever you want .......

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


(defun ashby-operator-1 (liste)
  (append (list liste)
                (loop 
                  with slot-pos
                  with slot-val
                  with slot-product
                  
                  ;; choose two positions in the list
                  do (setq slot-pos (loop repeat 2
                                      collect (random (length liste))))
                  
                  ;; picks the values from the positions
                  do (setq slot-val (list (nth (first slot-pos) liste) (nth (second slot-pos) liste))
                           ;; gen the product of the two values
                           slot-product (* (first slot-val) (second slot-val)))
                  
                  ;; replace the value of the first pos with the (first (explode slot-product))
                  ;; or when it's < 10 with 0
                  do (setq liste (loop for i in liste
                                   for cnt = 0 then (incf cnt)
                                   
                                   when (= cnt (first slot-pos))
                                   collect (if (> slot-product 9)
                                             (first (explode slot-product))
                                             (append 0))
                                   else collect i))

                  ;; replace the value of the second pos with the (second (explode slot-product))
                  ;; or or when it's < 10 with the slot-product
                  collect (setq liste (loop for i in liste
                                        for cnt = 0 then (incf cnt)
                                        when (= cnt (second slot-pos))
                                        collect (if (> slot-product 9)
                                                  (second (explode slot-product))
                                                  (append slot-product))
                                        else collect i)) 
                  into bag ;; collects all into bag

                  ;; when LISTE only '(0 0 0 0 0 ...) return all generations
                  when (= (sum liste) 0)
                  do (return bag))))



;;;examples

(ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9))

(list-plot
 (flatten 
  (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 11)))
 :point-radius 0.1 :style :fill :line-width 1)

(integer-to-pitch
 (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11)))

(chordize-list
 (integer-to-pitch
  (remove-duplicates
  (ashby-operator-1 '(0 1 2 3 5 8 13)))))

     

    rotate OMN ?

    in OMN Lingo

    Posted

    yes, but... it has some error...

     

    > Error: No length specified before first pitch
    > While executing: (:internal parse-omn-note), in process Listener-1(6).
    > Type cmd-. to abort, cmd-\ for a list of available restarts.
    > Type :? for other options.

     

    only when i do gen-rotate with the sequence

    the sequence works with perhaps (gen-retrograde seq) or...

     

     

    the sequence (produced by rnd-bots) is for example, something like that...

      

    ((et b1 f gettato t f1 ff ord et cs3 mf gettato t fs3 f tasto d5 tasto et g5 mf gettato t eb7 ff ord et a6 f gettato))

     

    and works fine without (gen-rotate

     

    rnd-symm-expand

    in User Extensions Source Code

    Posted

    bad code but nice results... :-)

      

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; rnd-symm-expand => generates rnd-symm transpositions
;;;; in different sequences (intervals, OMN-form,rhythms...
;;;; :chance => 0.0 - 1.0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rnd-symm-expand (seq &key (possible-intervals '(12 -12)) (chance 1))
  (let ((row)
        (firstpart)
        (rev-secondpart)
        (out))
    (setq row (if (pitchp (first seq))
                (pitch-to-midi seq)
                (append seq)))
    (setq firstpart (loop repeat (if (evenp (length row))
                                   (/ (length row) 2)
                                   (/ (1- (length row)) 2))
                      for cnt = 0 then (incf cnt)
                      collect (nth cnt row)))
    (setq rev-secondpart (loop repeat (if (evenp (length row) )
                                        (/ (length row) 2)
                                        (/ (1- (length row)) 2))
                           
                           for cnt = (- (length row) 1) then (decf cnt)
                           collect (nth cnt row)))
    
    (loop 
      for i in firstpart
      for j in rev-secondpart
      with int = 0 
      do (if (prob? chance)
           (setq int (rnd-pick possible-intervals))
           (setq int 0))
      collect (+ i int) into bag1
      collect (+ j (* -1 int)) into bag2
      when (= (length bag2) (if (evenp (length row))
                              (/ (length row) 2)
                              (/ (1- (length row)) 2)))
      do (if (evenp (length row))
           (setq out (append bag1 (reverse bag2)))
           (setq out (append bag1 (list (nth (length firstpart) row)) (reverse bag2)))))
    (if (pitchp (first seq))
      (midi-to-pitch out)
      (append out))))
    
;;;examples

(rnd-symm-expand '(0 0 0 0 0 0 0 0 0 0) :possible-intervals '(4 12 7) :chance 0.5)
(rnd-symm-expand '(1/4 1/4 1/4 1/4 1/4) :possible-intervals '(-1/32 1/32) :chance 0.5)
(rnd-symm-expand '(c1 c2 c3 c4 c5 c6) :possible-intervals '(1 -1) :chance 0.5)

     

    modify-time-signatures

    in User Extensions Source Code

    Posted · Edited by AM
    extended version 2 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; modify time-signatures like '(1 4 3) to (3 4 1),
;;; helps me after (split-tuplet-lengths) to clean up 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; with the :exclude and :threshold
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun modify-time-signature-repetitions (time-signature-seq &key (exclude '((0 0))) (threshold '10/4) (numerator-threshold 20))
  (loop for i in time-signature-seq 
    when (and (> (third i) 1)
              (< (/ (first i) (second i)) threshold)
              (< (* (first i) (third i)) numerator-threshold)
              (not (if (listp (first exclude)) 
                     (loop for x in exclude
                       when (equal (butlast i) x)
                       collect t)
                     (equal (butlast i) exclude))))
    
    collect (list (* (first i) (third i)) (second i) 1)
    else collect i))


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

(setq bars '((5 4 4) (1 4 2) (3 4 2) (1 8 5) (1 32 8)))

(modify-time-signature-repetitions bars)
(modify-time-signature-repetitions bars :exclude '(1 4))
(modify-time-signature-repetitions bars :exclude '((1 4) (1 8)))
(modify-time-signature-repetitions bars :exclude '((1 32)) :threshold '4/4)

(modify-time-signature-repetitions bars :numerator-threshold 7) ;; because i don't want 200/4 - bars :-)


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

     

    length-compensate

    in User Extensions Source Code

    Posted

    VERY NICE CODE... but your function does not do the same as mine 

    ...perhaps a misunderstanding / a different idea!

    ...you compensate EVERY value, my code only compensates when "rhy" is changing

     

    (length-round '(1/16 3/16 2/32 5/7 4/20 6/20 3/20 5/16))

    => (1/16 -3/16 3/16 -1/16 1/16 -3/16 5/7 -1/28 1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16)

    ..after the 1/16 it's not necessary to "round" with -3/16, because -> also with teh other values

     

    here with my code -> i only want to compensate when "denominators" are changing => have a look at markings (bold)

    (length-compensate2  '((1 16) (3 16) (2 32) (5 7) (4 20) (6 20) (3 20) (5 16)))

    => (1/16 3/16       1/16 -3/16      5/7 -1/28    1/5    3/10      3/20 -1/10     5/16 -3/16)

     

    length-compensate

    in User Extensions Source Code

    Posted 

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; a little function to compensate special-rhy-changes
;;; to 1/4-note structure... (or all :compensating-to -values)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; best format-solution was 1/32 => '(1 32) etc... otherwise
;;; i get in trouble with 1/8 = 4/32 - what is mathematicclay 
;;; correct - but bringing BUGS to the output

;;; if anybody could transform things '(2/32) to '(2 32) or
;;; '(3/12) to '(3 12) would be nice, i coudn't code it. this
;;; things are necessary because the function makes decicions
;;; bewtween the denominators, so there sould be constant!!!!

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



(defun length-compensate2 (liste &key (compensating-to '(1 4)))
  (butlast 
   (loop for event in (loop for i in (append liste (list (list (* -1 (first compensating-to)) (/ 1 (second compensating-to)))))
                        collect (list (first i) (/ 1 (second i))))
     with nenner
     with modulo
     with event_stack 
     with add_duration = 0
     with corr_event 
     
     when (or (null event_stack)
              (= (second event_stack) (second event)))
     do (setq add_duration (+ add_duration (abs (first event)))
              event_stack event
              corr_event nil)
     else do (progn 
               (setq nenner (/ (/ 1 (second event_stack)) (second compensating-to))
                     modulo (mod add_duration nenner))
               (if (/= modulo 0)
                 (setq corr_event (* (* -1 (- nenner modulo)) (second event_stack))))
               (setq add_duration (abs (first event))))
     
     when (not (equal corr_event 'nil))
     collect corr_event
     and do (setq corr_event nil)
     
     collect (* (first event) (second event))
     do (setq event_stack event))))



;example-1
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16)))))
;exampl-2
(length-compensate2 (loop repeat 5 
                      collect (rnd-pick '((1 16) (-1 16) (2 32) (5 7) (13 9) (4 20) (6 20) (3 20) (5 16))))
                    :compensating-to '(1 8))

     

    lisp-help needed

    in User Extensions Source Code

    Posted

    i know, but only mathematically!! -> you remember the problem with gen-stacc? => we discussed that with rangarajan?

    for some functions it's necessary that 2/20 will not be "reduced" to 1/20

     

    => https://opusmodus.com/forums/topic/528-gen-stacc-question/#comment-1446

     

    Quote

    Yes, I have also experienced this difficulty, for example, can't distinguish between 4/4 and 2/2 because both reduce to 1! As JP points out, this is a Lisp issue, nothing to do with OM. If we are adventurous, we could implement our own "data type", for example keeping numerator and denominator separately as a cons pair (numerator . denominator) or something similar. We can write a set of functions that operate on this, and then apply reduction when actually needed. More work, of course, but Lisp gives you control.

     

    Regards,

    Rangarajan

     

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy

  I accept