Total Pageviews

Tuesday, April 16, 2013

Algorithmic Classical Contemporary Music Composed With (Mx Clojure (or JSR331 core.logic) JMusic)

;http://youtu.be/wCoU6cW2JQs
;Copyright © Oscar Riveros, 2013, Todos los derechos reservados.
(ns mx.clojure.examples.motivic
  (:import [javax.constraints 
            Problem
            ProblemFactory
            Var
            Solver
            Objective])
  (:import [jm.music.data
            Score            
            Part
            Phrase
            Note])
  (:import [jm.music.tools
            Mod])
  (:import [jm JMC])
  (:import [jm.util Write]))

(use 'mx.clojure.pitches)

(def midi-path "/Users/maxtuno/Desktop/mx/")

(def title "Motivic Development Composition by Oscar Riveros")
(def tempo 22.0)
(def key-signature 2)
(def time-signature [4 4])
(def bars 128)

(def problem (ProblemFactory/newProblem title))

(defn notes-on-intervalic-structure 
  [start-note intervalic-structure]
  (if-not (empty? intervalic-structure)
    (concat start-note (notes-on-intervalic-structure (list (+ (first start-note) (first intervalic-structure))) (rest intervalic-structure)))))

(def pentatonic (take 70 (cycle [2 1 4 1 4])))

(def e-pentatonic (notes-on-intervalic-structure (list e) pentatonic))
(def a-pentatonic (notes-on-intervalic-structure (list a) pentatonic))
(def c-pentatonic (notes-on-intervalic-structure (list c) pentatonic))
(def g-pentatonic (notes-on-intervalic-structure (list g) pentatonic))

(defn make-vars
  [prefix l domain min max]
  (let [?list []
        filter-domain (filter (fn[pitch] (and (> pitch min) (< pitch max))) domain)]
        (vec (for [i (range l)]
               (cond ?list (.variable problem (str prefix i) (int-array (count filter-domain) filter-domain)))))))  
    
(defn >+
  [lvar]
    (.postLinear problem lvar ">" lvar)
    lvar) 

(defn >-
  [lvar] 
    (.postLinear problem lvar "<" lvar)
    lvar) 

(def pitch-a (make-vars "a" 8 e-pentatonic 75 93))
(def pitch-b (make-vars "b" 7 e-pentatonic 65 83))
(def pitch-c (make-vars "c" 5 e-pentatonic 58 71))
(def pitch-d (make-vars "d" 7 e-pentatonic 46 66))
(def pitch-f (make-vars "f" 5 e-pentatonic 65 83))
(def pitch-g (make-vars "g" 7 e-pentatonic 46 66))


(.postAllDifferent problem pitch-a)
(.postAllDifferent problem pitch-b)
(.postAllDifferent problem pitch-c)
(.postAllDifferent problem pitch-d)
(.postAllDifferent problem pitch-f)
(.postAllDifferent problem pitch-g)

(def motif-a  {:pitches  pitch-a
               :contour  [>-  >-  >-  >-  >+  >+  >+  >-  >+  >+  >-  >-  >-  >+  >+  >+  >-  >-]               
               :rhythm   [1/1 1/1 1/1 1/1 1/2 1/2 1/2 1/2 1/1 1/1 1/1 1/1 1/1 1/2 1/2 1/2 1/2 1/1]
               :velocity [64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64]})

(def motif-b  {:pitches  pitch-b
               :contour  [>-  >-  >-  >+  >+  >+  >-  >+  >+  >-  >-  >-  >+  >+  >+  >-  >+  >-]               
               :rhythm   [1/1 1/1 1/2 1/2 1/1 1/1 1/4 1/4 1/1 1/1 1/1 1/2 1/2 1/1 1/1 1/4 1/4 1/1]
               :velocity [64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64  64]})

(def motif-c  {:pitches  pitch-c
               :contour  [>-  >-  >+  >+  >+  >-  >+  >+  >-  >-  >+  >+  >-  >-]               
               :rhythm   [1/1 1/1 1/2 1/2 1/2 1/2 1/2 1/2 1/1 1/2 1/2 1/2 1/2 1/1]
               :velocity [64  64  64  64  64  64  64  64  64  64  64  64  64  64]})

(def motif-d  {:pitches  pitch-d
               :contour  [>-  >+  >+  >+  >-  >+  >+  >-  >- ]               
               :rhythm   [1/1 1/1 1/2 1/2 1/2 1/2 1/2 1/2 1/1]
               :velocity [80  64  64  64  64  64  64  64  64]})

(def motif-f  {:pitches  pitch-f
               :contour  [>-  >-  >+  >+  >+  >-  >+  >+  >-  >-  >+  >+  >-  >-]               
               :rhythm   [1/2 1/2 1/2 1/4 1/4 1/1 1/1 1/1 2/1 2/1 1/4 1/4 1/4 1/4]
               :velocity [64  64  64  64  64  64  64  64  64  64  64  64  64  64]})

(def motif-g  {:pitches  pitch-g
               :contour  [>-  >+  >+  >+  >-  >+  >+  >-  >- ]               
               :rhythm   [2/1 2/1 2/1 1/1 1/1 1/1 1/1 1/1 2/1]
               :velocity [80  64  64  64  64  64  64  64  64]})

(def size (/ bars (apply + (motif-a :rhythm))))

(def voice-1 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-a :contour))) (take size (cycle (motif-a :pitches))))
          (take bars (cycle (motif-a :rhythm)))
          (take bars (cycle (motif-a :velocity)))]))

(def voice-2 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-b :contour))) (take size (cycle (motif-b :pitches))))
          (take bars (cycle (motif-b :rhythm)))
          (take bars (cycle (motif-b :velocity)))]))

(def voice-3 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-c :contour))) (take size (cycle (motif-c :pitches))))
          (take bars (cycle (motif-c :rhythm)))
          (take bars (cycle (motif-c :velocity)))]))

(def voice-4 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-d :contour))) (take size (cycle (motif-d :pitches))))
          (take bars (cycle (motif-d :rhythm)))
          (take bars (cycle (motif-d :velocity)))]))    

(def voice-5 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-f :contour))) (take size (cycle (motif-f :pitches))))
          (take bars (cycle (motif-f :rhythm)))
          (take bars (cycle (motif-f :velocity)))]))

(def voice-6 
  (apply map vector
         [(map #(%1 %2) (take size (cycle (motif-g :contour))) (take size (cycle (motif-g :pitches))))
          (take bars (cycle (motif-g :rhythm)))
          (take bars (cycle (motif-g :velocity)))])) 

(defn scale-material
  [note min max]
  note)

(defn make-music
  []
  (let [score        (new Score  title tempo)                  
        piano-part-1 (new Part   "Violin 1" JMC/VIOLIN 0)       
        phrase-1     (new Phrase "Phrase 1" 0.0)
        piano-part-2 (new Part   "Violin 2" JMC/VIOLIN 1)       
        phrase-2     (new Phrase "Phrase 2" 0.0)
        piano-part-3 (new Part   "Viola  3" JMC/VIOLA 2)       
        phrase-3     (new Phrase "Phrase 3" 0.0)
        piano-part-4 (new Part   "Cello  4" JMC/CELLO 3)       
        phrase-4     (new Phrase "Phrase 4" 0.0)
        piano-part-5 (new Part   "PianoR 5" JMC/PIANO 4)       
        phrase-5     (new Phrase "Phrase 5" 0.0)
        piano-part-6 (new Part   "PianoL 6" JMC/PIANO 4)       
        phrase-6     (new Phrase "Phrase 6" 0.0)        
        solver            (.getSolver problem)
        solution-iterator (.solutionIterator solver)]
                
    (try
      
      (.log problem "Before Constraint Posting")
      (.log problem (.getVars problem))
      
      (.log problem "After Constraint Posting")
      (.log problem (.getVars problem))
      
      (.log problem "=== Find Solution:")
      
      (while (.hasNext solution-iterator)
        (let [next-solution (.next solution-iterator)]    
          
          (.setTimeSignature score (first time-signature) (second time-signature))
          (.setKeySignature score key-signature)
          
          (doseq [note voice-1]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]        
              (.addNote phrase-1   (new Note (int pitch) (double rhythm) (int velocity))))) 
          
          (doseq [note voice-2]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]          
              (.addNote phrase-2   (new Note (int pitch) (double rhythm) (int velocity))))) 
          
          (doseq [note voice-3]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]          
              (.addNote phrase-3   (new Note (int pitch) (double rhythm) (int velocity))))) 
          
          (doseq [note voice-4]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]          
              (.addNote phrase-4   (new Note (int pitch) (double rhythm) (int velocity))))) 
          
          (doseq [note voice-5]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]          
              (.addNote phrase-5   (new Note (int pitch) (double rhythm) (int velocity))))) 
                    
          (doseq [note voice-6]      
            (let [pitch    (.getValue next-solution (.getName (first  note)))
                  rhythm   (second note)
                  velocity (last   note)]          
              (.addNote phrase-6   (new Note (int pitch) (double rhythm) (int velocity))))) 
          
          (Mod/repeat phrase-1 10)
          (.setStartTime phrase-1 12.0)
          (Mod/repeat phrase-2 10)
          (.setStartTime phrase-2 8.0)
          (Mod/repeat phrase-3 8)
          (.setStartTime phrase-3 4.0)
          (Mod/repeat phrase-4 12)
          (.setStartTime phrase-4 0.0)   
          (Mod/repeat phrase-5 12)
          (.setStartTime phrase-5 4.0)
          (Mod/repeat phrase-6 8)
          (.setStartTime phrase-4 8.0) 
          
          (.addPhrase piano-part-1 phrase-1)    
          (.addPart   score piano-part-1)   
          
          (.addPhrase piano-part-2 phrase-2)    
          (.addPart   score piano-part-2)
          
          (.addPhrase piano-part-3 phrase-3)    
          (.addPart   score piano-part-3)
          
          (.addPhrase piano-part-4 phrase-4)    
          (.addPart   score piano-part-4)

          (.addPhrase piano-part-5 phrase-5)    
          (.addPart   score piano-part-5)
          
          (.addPhrase piano-part-6 phrase-6)    
          (.addPart   score piano-part-6)
          
          (Write/midi score (str midi-path title " " (new java.util.Date) ".mid"))
          
          (.log next-solution)))
          
      (.log problem "After Search")
      (.log problem (.getVars problem))
      
      (catch Exception exception
        (.log problem (.getMessage exception))))))

(make-music)

3 comments:

  1. Very cool! I've been messing with AI ways of generating music in Clojure:
    https://github.com/josephwilk/musical-creativity. Inspired by David Copes work and books: http://mitpress.mit.edu/books/computer-models-musical-creativity

    ReplyDelete
  2. Having lived in Palm Beach Florida for several years, listening to the 97.9 WRMF has become a daily ritual for me. I start my day off with a healthy breakfast and tune in to 97.9. ’The WRMF Morning Show’ with Jennifer Ross, Deena Lang and Joe Raineri makes it the hottest show ever. Tune in today or stream online at www.wrmf.com

    ReplyDelete