DanielJean Posted August 12 Share Posted August 12 Hi, ;given pattern in c-major (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) ; required pattern: modified given pattern with notes only being part of a-major, no other pitch shifting : -> (cs4 d4 e4 fs4 gs4 a4 b4 cs5) . pattern remains more or less in the same pitch range, only notes are modified not being part of a-major ;test: (tonality-map '(major :root 'a4) test-pattern-c-major) ; result: (a4 b4 cs5 d5 e5 fs5 gs5 gs5) : a-major ok, but pitch shifting of entire pattern This result is not what I am looking for. I tried several tonality-map operation with different parameters without success. I do not seem to find the correct parameter setting of tonality-map calls, or there is no such solution with tonality map for my requirement. Otherwise I will have to program it myself; to be avoided if possible Thanks for any help, Daniel P.S. ChatGPC for opusmodus proposes the following: (tonality-map '(a-major) test-pattern-c-major), which would be a super solution; too bad it does not work for opusmodus: error: a-major not found Quote Link to comment Share on other sites More sharing options...
jesele Posted August 12 Share Posted August 12 Try this: (defun scale-from-ambitus (root tonality &optional (offset 0) (ambitus '(c0 c9))) (let* ((scl (expand-tonality (list root tonality :rotate offset) :type :integer)) (len (length scl)) (trs (gen-integer-step -84 15 12)) (amb (ambitus-form ambitus)) (out (remove-if (lambda (x) (or (< x (car amb)) (> x (cadr amb)))) (loop for tr in trs nconc (x+b scl tr))))) (values out len amb)) ) (defun change-tonality1 (lst from-root from-tonality to-root to-tonality &key (offset 0) (invert nil)) (labels ((invert-add (lst n) (loop for x in lst collect (if (listp x) (invert-add x n) (+ (- x) n))))) (let* ((equal-from-to (and (equal from-root to-root) (equal from-tonality to-tonality))) (ft (scale-from-ambitus from-root from-tonality 0 '(c0 c9))) (tt (if equal-from-to ft (scale-from-ambitus to-root to-tonality 0 '(c0 c9)))) (st1 (car (pitch-to-integer (list (car lst))))) (st (if (listp st1) (car st1) st1)) (start-offset (+ offset (- (position-if (lambda (y) (>= y st)) tt) (position-if (lambda (y) (>= y st)) ft)))) (mat (if invert (invert-add (pitch-to-integer lst) (* 2 st)) (pitch-to-integer lst))) (res (loop for x in mat collect (if (listp x) (loop for y in x collect (nth (+ start-offset (position-if (lambda (z) (>= z y)) ft)) tt)) (nth (+ start-offset (position-if (lambda (z) (>= z x)) ft)) tt))))) (cdr (integer-to-pitch (cons 0 res))))) ) (defun change-tonality (lst from-root from-tonality to-root to-tonality &key (offset 0) (invert nil)) (let* ((omnp (omn-formp lst)) (mat (if omnp (omn :pitch lst) lst)) (res (if (atom (car mat)) (change-tonality1 mat from-root from-tonality to-root to-tonality :offset offset :invert invert) (mapcar (lambda (x) (change-tonality1 x from-root from-tonality to-root to-tonality :offset offset :invert invert)) mat)))) (if omnp (omn-replace :pitch res lst) res)) ) (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) (change-tonality test-pattern-c-major 'c4 'major 'a4 'major :offset 0 :invert nil) (setf test-pattern-c-major2 '(f3a3c4 d4 e4 b3d4f4 g4 a4 b4 f4a4c5)) (change-tonality test-pattern-c-major2 'c4 'major 'a4 'major :offset 0 :invert nil) Jesper JulioHerrlein 1 Quote Link to comment Share on other sites More sharing options...
DanielJean Posted August 12 Author Share Posted August 12 Hi Jesper, Wow, thank you so much for your code, which works perfectly!! You have been faster than me :-). I assume you are a professional? I programmed C++ for years for the semiconductor industry, but I am not really fit in lisp yet. May I ask you, what your background is? Its so nice to help one another. Have a nice day and thanks again. Greetings to Sweden from Switzerland Cheers Daniel Quote Link to comment Share on other sites More sharing options...
jesele Posted August 12 Share Posted August 12 Hi Daniel. It was some code I already had. I have a bunch of stuff that hopefully can be included in OM later on when/if I finally can get started with documentation. No, I'm far from a professional. I did a bunch of Lisp some 25 years ago but I'm not very good. I was a professional percussion player/drummer for 20 years, switching to composing. Also worked as a studio manager for 20 years. Jesper Quote Link to comment Share on other sites More sharing options...
Stephane Boussuge Posted August 13 Share Posted August 13 Very interesting, here's another solution in a different style based on pitch class replacement. (defun pitch-class-replace (old new sequence &key section exclude omn) (do-verbose ("pitch-class-replace") (labels ((pitch-class-replace-1 (old new sequence) (let* ((integers (pitch-to-integer sequence)) (mod (modus integers)) (sub (replace-map (matrix-transpose (list old new)) mod))) (octave-map sequence (integer-to-pitch sub)))) (pitch-class-replace-ls (old new sequence) (loop for i in sequence for n in (gen-trim (length sequence) (if (listp (car new)) new (list new))) for o in (gen-trim (length sequence) (if (listp (car old)) old (list old))) collect (pitch-class-replace-1 o n i))) (pitch-class-replace* (old new sequence) (if (listsp sequence) (pitch-class-replace-ls old new sequence) (pitch-class-replace-1 old new sequence)))) (disassembling-omn ((sequence plist) sequence :pitch :span :length) (let ((len (length sequence))) (maybe-omn-decode omn (if exclude (maybe-section (lambda (x) (pitch-class-replace* old new x)) sequence (num-exclude len exclude)) (maybe-section (lambda (x) (pitch-class-replace* old new x)) sequence section)))))))) (pitch-class-replace '(0 2 4 7) '(4 5 0 11) '(e c3 p d4 e4 f4 q g5 stacc)) (pitch-class-replace '(0 2 4 7) '(4 5 0 11) '((e c3 p d4 - - q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc))) (pitch-class-replace '(0 2 4 7) '(4 5 0 11) '((e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc)) :section '(0 2)) (pitch-class-replace '(0 2 4 7) '(4 5 0 11) '((e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc)) :exclude '(0 2)) (pitch-class-replace '((0 2 7)(0 2 7)) '((2 4 6)(3 5 11)) '((e c3 p d4 e4 f4 q g5 stacc) (e c3 p d4 e4 f4 q g5 stacc))) ;; ------------------ Your example: (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) (pitch-class-replace '(0 5 7) '(1 6 8) test-pattern-c-major) S. jesele 1 Quote Link to comment Share on other sites More sharing options...
jesele Posted August 13 Share Posted August 13 Great Stephane. The scale-from-ambitus function above can be useful for things like this also. (loop for ton in '(locrian altered-dominant lydian altered-dominant) and root in '(d4 g4 c4 a3) collect (integer-to-pitch (scale-from-ambitus root ton 0 '(c4 g5)))) Jesper JulioHerrlein and Stephane Boussuge 1 1 Quote Link to comment Share on other sites More sharing options...
DanielJean Posted August 13 Author Share Posted August 13 Interesting! Thanks too Stephane! danielwidler.com Quote Link to comment Share on other sites More sharing options...
JulioHerrlein Posted August 13 Share Posted August 13 This is very good, Jesper Certainly, a function that could be implemented at the core functions of Opusmodus. Janusz ? Best, Julio Quote Link to comment Share on other sites More sharing options...
jesele Posted August 13 Share Posted August 13 Thanks, Julio, it's already there but in a slightly different version without offset that's not doing anything anyway. It's used by infinity-series. Ambitus has to be integers so you can use ambitus-form to convert. Try like this without evaluating the function above. (integer-to-pitch (scale-from-ambitus 'a4 'major (ambitus-form '(c4 g5)))) (loop for ton in '(locrian altered-dominant lydian altered-dominant) and root in '(d4 g4 c4 a3) collect (integer-to-pitch (scale-from-ambitus root ton (ambitus-form '(c4 g5))))) Jesper But change-tonality is not there yet. I have contact with Janusz. it's the problem of writing documentation And fixing bugs. I have some jazz-voicing stuff etc, but they are rather complex and my eyes are not what they used to be, so I can only work short periods at the time. JulioHerrlein 1 Quote Link to comment Share on other sites More sharing options...
JulioHerrlein Posted August 13 Share Posted August 13 Thanks, but the change-tonality you provided here seems better. Best ! Julio Quote Link to comment Share on other sites More sharing options...
jesele Posted August 13 Share Posted August 13 Yes, scale-from-ambitus is mostly a sub-function for some other functions. Use the one above for now, and I will send Janusz all the stuff when I'm done. It helps with my motivation that someone likes it. Jesper JulioHerrlein and Stephane Boussuge 1 1 Quote Link to comment Share on other sites More sharing options...
DanielJean Posted August 14 Author Share Posted August 14 I also prefer Jaspers implementation. However, in the definition of defun change-tonality (lst from-root from-tonality to-root to-tonality &key (offset 0) (invert nil)) ,are the input parameters from-root and from-tonality really necessary? The given tonality of the pattern to be modified is not always easy to determine, especially if it is auto-generated. Daniel Quote Link to comment Share on other sites More sharing options...
jesele Posted August 14 Share Posted August 14 In my updated map-to-tonality function you can write like this. (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) (map-to-tonality test-pattern-c-major 'a4 'major :follow 'm :step nil) => (cs4 d4 e4 fs4 gs4 a4 b4 cs5) Sent it to Janusz now so let's see. I still have a lot of unfinished/undocumented stuff for later. Jesper On 8/14/2024 at 3:50 PM, DanielJean said: are the input parameters from-root and from-tonality really necessary? No, maybe not but you do get another result if you write: (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) (change-tonality test-pattern-c-major 'c4 'chromatic 'a4 'major :offset 0 :invert nil) Jesper Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
DanielJean Posted August 15 Author Share Posted August 15 Yes, I already could confirm the different results with different from-root, from-tonality. So lets see, what Janusz can do with this (map-to-tonality test-pattern-c-major 'a4 'major). That would be great!! I would also be interested in the version-nr of opusmodus with this feature implemented. Daniel Quote Link to comment Share on other sites More sharing options...
jesele Posted August 15 Share Posted August 15 I just sent an updated version to Janusz so unless he has objections maybe in the next update. Jesper JulioHerrlein 1 Quote Link to comment Share on other sites More sharing options...
Stephane Boussuge Posted August 23 Share Posted August 23 ;;; The good way to process is to not think as tonalities ;;; but more as pitch collections, more or less kind of pitch class sets. (setf test-pattern-c-major '(c4 d4 e4 f4 g4 a4 b4 c5)) (setf set1 '((1 2 4 6 8 9 11) :closest 'up :map 'octave)) (tonality-map set1 test-pattern-c-major) opmo 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.