GenJam-Mixed

extensions [ sound ]

globals [
 chromosomes-duple ;; list of all possible duple chromosomes
 chromosomes-triple ;; list of all possible triple chromosomes
 random-whos ;; keeps a shuffled list for pretty-ness
 generations ;; number of generations we've seen
]

turtles-own [
  my-chromosomes my-pattern ;; lists to hold the chromosomes and hit-pattern of a drummer
  my-velocity my-instrument ;; the (int) velocity value and (string) MIDI instrument for that turtle
  mutation-rate ;; variables to control "reproduction"
  hits ;; counts the number of drum hits for a turtle
  hits-since-evolve ;; the number of hits since a mutation or evolution
]

breed [ low-drums low-drummer ]
breed [ med-drums med-drummer ]
breed [ high-drums high-drummer ]

to setup
  ca
  ;; Make the view big enough to show 16 lines and however many 'beats'
  resize-world 0 ((num-chromosomes / 3 * 7) - 1) 0 15
  set-globals
  set-initial-turtle-variables
  reset-ticks
  update-view
end 

;; Method to play a pattern without any evolution

to go-no-evolve
  ask turtles [
    play ;; includes end of life
  ]
  update-view
  tick
  wait 60 / TEMPO-BPM / 7
end 

;; Method to play a pattern with evolution

to go
  ask turtles [
   play
  ]
  ;; If we've reached the end of a pattern, do some evolution!
  if (ticks mod (num-chromosomes / 3 * 7) = 0) and (ticks != 0) [
    set generations generations + 1
    go-evolve
  ]
  update-view
  tick
  wait 60 / TEMPO-BPM / 7   ;; This roughly sets temp
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLAY FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to play-my-drum ;; turtle proceudre
  let temp my-velocity
  if sound? [
    if solo? [ ;; If you're a soloer, play out! Otherwise, SHHHH.
      ifelse who = soloer [
        set temp my-velocity + 50
      ]
      [
        set temp my-velocity - 50
      ]
   ]
    sound:play-drum my-instrument temp
  ]
end 

to play ;; turtle procedure
  if is-low-drummer? self [
    if item (ticks mod (num-chromosomes / 3 * 7)) my-pattern = 1 [
      play-my-drum
      set hits hits + 1
      set hits-since-evolve hits-since-evolve + 1
    ]
  ]

  if is-med-drummer? self [
    if item (ticks mod (num-chromosomes / 3 * 7)) my-pattern = 1 [
      play-my-drum
      set hits hits + 1
      set hits-since-evolve hits-since-evolve + 1
    ]
  ]

  if is-high-drummer? self [
    if item (ticks mod (num-chromosomes / 3 * 7)) my-pattern = 1 [
      play-my-drum
      set hits hits + 1
      set hits-since-evolve hits-since-evolve + 1
    ]
  ]
end 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; END PLAY FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EVOLUTION FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to go-evolve
  ;; If there isn't a soloist, ask 2 of each type to evolve
  ifelse not solo? [
    ask n-of 2 low-drums [
      evolve
    ]
    ask n-of 2 med-drums [
      evolve
    ]
    ask n-of 2 high-drums [
      evolve
    ]
    ;; If a drummer hasn't changed in a while, mutate
    ask turtles with [hits-since-evolve > hit-limit] [
      mutate
      set hits-since-evolve 0
    ]
  ] [ ;; If there is a soloist, do the same, but don't include the soloer
   ask n-of 2 low-drums with [who != soloer] [
      evolve
    ]
    ask n-of 2 med-drums with [who != soloer] [
      evolve
    ]
    ask n-of 2 high-drums with [who != soloer]  [
      evolve
    ]
    ;; If a drummer hasn't changed in a while, mutate
    ask turtles with [hits-since-evolve > hit-limit and who != soloer] [
      mutate
      set hits-since-evolve 0
    ]
  ]
end 

to evolve ;; turtle procedure
 let mate nobody
 let list-of-fitnesses []
 let search-fitness 0
 if is-low-drummer? self [
   set list-of-fitnesses [fitness] of other breed
   set search-fitness select-random-weighted-fitness list-of-fitnesses
   set mate one-of other breed with [fitness = search-fitness]
 ]

 if is-med-drummer? self [
   set list-of-fitnesses [fitness] of turtles with [breed != [breed] of myself]
   set search-fitness select-random-weighted-fitness list-of-fitnesses
   set mate one-of turtles with [(breed != [breed] of myself) and (fitness = search-fitness)]
 ]

 if is-high-drummer? self [
   set list-of-fitnesses [fitness] of other breed
   set search-fitness select-random-weighted-fitness list-of-fitnesses
   set mate one-of other breed with [fitness = search-fitness]
 ]

 let offspring-chromosomes reproduce-with mate

 ask min-one-of other breed with [who != soloer] [fitness] [
   set my-chromosomes offspring-chromosomes
   update-pattern
   set hits-since-evolve 0
 ]
end 

;; This is where the basic genetic algorithm comes in

to-report reproduce-with [mate] ;; turtle procedure
  ;; ASKER IS 1st Parent MATE is 2nd parent
  ;;; my-chromosomes
  let her-chromosomes [my-chromosomes] of mate

  ;; Pick a random cross-over point
  let crossover-point random length my-chromosomes

  ;; Combine the chromosomes
  let baby-chromosomes sentence (sublist my-chromosomes 0 crossover-point) (sublist her-chromosomes crossover-point length her-chromosomes)

  ;; Do a little mutation
  let mutation-chance 0
  if is-low-drummer? self [
    set mutation-chance 50
  ]
  if is-med-drummer? self [
    set mutation-chance 25
  ]
  if is-high-drummer? self [
    set mutation-chance 10
  ]

  ;; Maybe actually mutate
  if random 100 > mutation-chance [
    set baby-chromosomes mutate-chromosomes baby-chromosomes
  ]
  report baby-chromosomes
end 


;; FITNESS FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependent on breed, because you can lose fitness or gain fitness by fitting to your particular proclivities

to-report fitness ;; turtle procedure
  ;; Arbirtrary 10% window around target density
  let my-fitness 0

  ;; Want to be under the hit-density and be on the downbeats
  if is-low-drummer? self [
    set my-fitness downbeat-fitness
    if my-density-fitness > (hit-density-modifier - 10) [
      set my-fitness my-fitness / 1.5
    ]
  ]

  ;; Want to be at the hit-density and be on the off-beats
  if is-med-drummer? self [
    set my-fitness offbeat-fitness
    if (my-density-fitness < hit-density-modifier - 10) or (my-density-fitness > hit-density-modifier + 10) [
      set my-fitness my-fitness / 2
    ]
  ]

  ;; Want to be above the hit-density and have lots o' clusters
  if is-high-drummer? self [
    set my-fitness offbeat-fitness
    if my-density-fitness < hit-density-modifier + 10 [
      set my-fitness my-fitness / 2
    ]
  ]
;; use add 1 smoothing
report my-fitness + 1
end 

to-report my-density-fitness ;; turtle procedure
  report sum my-pattern / length my-pattern * 100
end 

to-report cluster-fitness ;; turtle procedure
 ;; window size at 3
 let i 4
 let cluster-count 0
 while [i <= length my-pattern] [
   if (sum sublist my-pattern (i - 4) i) = 3 [
     set cluster-count cluster-count + 1
   ]
 ]
 ;; Lots of clusters relative to the notes I play
 report cluster-count / sum my-pattern * 100
end 

to-report offbeat-fitness ;; turtle procedure
 let offbeat-count 0
 foreach n-values length my-pattern [?] [
  if member? (? mod 7) [1 3 5 6] [
    if item ? my-pattern = 1 [
      set offbeat-count offbeat-count + 1
    ]
   ]
 ]
 if offbeat-count = 0 [ report 0 ]
 ;; You want more off-beats and less down-beats
 report offbeat-count / sum my-pattern * 100
end 

to-report downbeat-fitness ;; turtle procedure
 let downbeat-count 0
 foreach n-values length my-pattern [?] [
  if member? (? mod 7) [0 2 4] [
    if item ? my-pattern = 1 [
      set downbeat-count downbeat-count + 1
    ]
   ]
 ]
 if downbeat-count = 0 [ report 0 ]
 ;; In other words, you want lots of downbeats in comparison to your other notes
 report downbeat-count / sum my-pattern * 100
end 

to mutate ;; turtle procedure
  set my-chromosomes mutate-chromosomes my-chromosomes
  update-pattern
end 

;; Method to mutate a chromosome

to-report mutate-chromosomes [the-chromosomes]
  ;; basically picks a chromosome, mutates it, returns a new set
  let new-chromosomes the-chromosomes
  repeat num-mutations [
    let temp random num-chromosomes
    ifelse (temp + 1) mod 3 != 0 [

      set new-chromosomes replace-item temp new-chromosomes ((round (random-normal (item temp new-chromosomes) mutation-strength)) mod 4)
    ;; DUPLE CHROMOSOME
    ] [
       set new-chromosomes replace-item temp new-chromosomes ((round (random-normal (item temp new-chromosomes) mutation-strength)) mod 8)
    ]
  ]
  report new-chromosomes
end 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; END EVOLUTION FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPER FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Called after a chromosome update in order to redefine that turtle's pattern

to update-pattern ;; turtle method
  set my-pattern []
  let i 0
  foreach my-chromosomes [
   ifelse (i + 1) mod 3 != 0 [
    ;; DUPLE
       set my-pattern sentence my-pattern (get-duple-chromosome ?)
   ] [
    ;; TRIPLE
       set my-pattern sentence my-pattern (get-triple-chromosome ?)
   ]
   set i i + 1
  ]
end 

to set-globals
  set generations 0
  set random-whos n-values 16 [?]
  ;; this is just for looks.
  if shuffle-parts? [
    set random-whos shuffle random-whos
    set random-whos shuffle random-whos
  ]

  ;; CHROMOSOME LIBRARY
  let c0 [0 0 0]
  let c1 [1 0 0]  let c2  [0 1 0] let c3 [0 0 1]
  let c4 [1 0 1]  let c5  [1 1 0] let c6 [0 1 1]
  let c7 [1 1 1]
  set chromosomes-triple (list c0 c1 c2 c3 c4 c5 c6 c7)

  set c0 [0 0]
  set c1 [1 0] set c2 [0 1]
  set c3 [1 1]
  set chromosomes-duple (list c0 c1 c2 c3)
  ;; END CHROMOSOME LIBRARY
end 

to set-initial-turtle-variables
  create-low-drums 6 [
    set my-instrument "LOW CONGA"
    set my-velocity 85
    set color red
    set mutation-rate 64
  ]

  create-med-drums 5 [
    set my-instrument "Bass Drum 1"
    set color green
    set my-velocity 85
    set mutation-rate 32
  ]

  create-high-drums 5 [
    set my-instrument "Closed Hi Hat"
    set color blue
    set my-velocity 85
    set mutation-rate 16
  ]

  ask turtles [
    set my-pattern []
    set my-chromosomes (n-values num-chromosomes [1])
    ht
    update-pattern
    set hits 0
  ]
end 

;; Method to update the view (simplified music notation)

to update-view
 ask turtles [
   let temp 0
   let row item who random-whos
   foreach my-pattern [
     ifelse ? = 1 [
       ifelse solo? and (soloer = who) [
         ask patch temp row [set pcolor white]
       ] [
         ask patch temp row [set pcolor [color] of myself]
       ]
     ] [
     ask patch temp row [set pcolor black]
     ]
     set temp temp + 1
   ]
 ]
 ask patches with [pxcor = (ticks mod (num-chromosomes / 3 * 7))] [set pcolor yellow]
end 

;; Method to get a triple chromosomes pattern from the library

to-report get-triple-chromosome [index]
  report item index chromosomes-triple
end 

;; Method to get a duple chromosomes pattern from the library

to-report get-duple-chromosome [index]
  report item index chromosomes-duple
end 


;; This is my version picking a weighted random turtle

to-report select-random-weighted-fitness [theList]
   let weighted-list []
   foreach theList [
     ;; add one smoothing
     let temp ?
     foreach n-values round ((? / sum theList * 100) + 1) [?] [
       set weighted-list fput temp weighted-list
     ]
   ]
   report item (random length weighted-list) weighted-list
end 

;;; OLD CODE
;breed [ low-drums low-drummer ]
;;; Atsimevu
;;; 64 Low Conga
;;; 63 Open Hi Conga
;;; 52 Mute Hi Conga
;;;  open-hand open-fingers slap-fingers slap-two-fingers ;; Options for hit
;
;;; Sogo or Kidi
;;; MIDI INSTRUMENT 117. Taiko Drum
;breed [ med-drums med-drummer ]
;
;;; Kagan
;;; 65. Hi Timbale
;breed [ high-drums high-drummer ]