STI

globals [
  %gay              ;; Percent of homosexual people in the population (set by slider)
  %bi               ;; Percent of bisexual people in the population (determined by slider)
  
  max-coupling-factor       ;; Maximum coupling tendency value
                            ;; Used as an upper bound for generating random chance of coupling
                            ;; (default is scale 0 - 10)
  max-condom-factor         ;; Maximum condom use value
                            ;; Used as an upper bound for generating random chance of using a condom
                            ;; (default is scale 0 - 10)
                            
  average-coupling-tendency ;; Average tendency of a person to couple with another person
  average-commitment        ;; Number of ticks a couple will stay together, on average
  ;average-condom-use       ;; Average frequency that a person uses protection (set by slider)
  
  slider-check-1    ;; Temporary variable to use to check for slider adjustments
                    ;; during the simulation and adjust model appropriately
  infection-chance ;; The chance out of 100 that an infected person will transmit infection during one week of couplehood
  ]

turtles-own [
  male?              ;; true or false for genders M or F
  orientation        ;; gay straight or bi
  
  infected?          ;; If true, the person is infected.
                     
  coupled?           ;; If true, the person is in a sexually active couple.
  partner            ;; The person that is our current partner in a couple.
  couple-length      ;; How long the person has been in a couple.
  
  commitment         ;; How long the person will stay in a couple-relationship.
  coupling-tendency  ;; How likely the person is to join a couple.
  condom-use         ;; The percent chance a person uses protection
                     ;; (determined by slider & normal distribution)
]

;;;
;;; SETUP PROCEDURES
;;;

to setup
  clear-all
  setup-globals
  setup-people
  reset-ticks
end 

to setup-globals
  
  set max-coupling-factor 10.0
  set max-condom-factor 11.0
  
  set slider-check-1 average-condom-use
  
  ;; In the AIDS model, these variables are set with sliders
  ;; For simplicity, we set them to predetermined values
  ;; Individual values in each turtle are still set using 
  ;; a random value following a normal distribution
  
  set average-coupling-tendency 5 ;should be less than max-coupling-factor
  set average-commitment 20
  set infection-chance 50 ;; %50 chance of being infected by having unprotected sex with infected partner
end 

to setup-people
  crt initial-people       ;; create the specified initial number of people
    [ 
      set male? true                ;; default person straight male... just like society -_-
      set orientation "straight"    ;; set sexual orientation
      setxy random-xcor random-ycor ;; place every person in a random position
      set coupled? false
      set partner nobody
      set infected? false 

      ;; The below variables may be different in each turtle, and the values
      ;; follow an approximately normal distribution
      assign-commitment
      assign-coupling-tendency
      assign-condom-use
      ]
    
   ;; set gender of turtles to be 50% male, 50% female
   
   ask n-of (initial-people / 2) turtles [set male? false ]
   
   ;; set orientations of turtles based on slider values
   
   set %gay (100 - %straight) * (%gay-in-pop / 100)
   set %bi (100 - %straight) * (1 - %gay-in-pop / 100)
  
   ask n-of (initial-people * (%bi / 100)) turtles [set orientation "bi"] 
   ;; when setting the second orientation, make sure to change only formerly straight turtles
   ask n-of (initial-people * (%gay / 100)) turtles with [orientation = "straight"] [set orientation "gay"]
  
   
   ask turtles [
     assign-color    ;; color is determined by orientation
     assign-shape    ;; shape is determined by gender and sick status
     set size 1.5
     ]
end 


;; Color of turtle indicates their mate gender preference
;; i.e. likes men is blue, likes women is pink, both is purple

to assign-color  ;; turtle procedure
  if likesboys? [ set color blue]
  if likesgirls? [ set color pink]
  if likesboys? and likesgirls? [set color violet]
end 


 ;; Set shape based on gender (male or female)
 ;; and whether or not infected (includes a red dot)

to assign-shape ;; turtle procedure
  ifelse infected?
  [ ifelse male?
    [set shape "male sick"]
    [set shape "female sick"]
  ]
  [ ifelse male?
    [set shape "male"]
    [set shape "female"]
  ]
end 



;;;
;;; SELECT PROCEDURE
;;;
;; User chooses an initial patient zero

to select
  let picked? false
   if mouse-down? [
    let candidate min-one-of turtles [distancexy mouse-xcor mouse-ycor]
    if [distancexy mouse-xcor mouse-ycor] of candidate < 1 [
        ask candidate [ 
          set shape word shape " sick"
          display
          set picked? true
          set infected? true ] ] ]
  if picked?
  [stop]
end  


;; People move about the simulation at random.

to move  ;; turtle procedure
  rt random-float 360
  fd 1
end 


;;;
;;; GO PROCEDURES
;;;

to go
  ;; stop when % of infected people reaches specified limit
  ;; allows user to examine what genders/orientations are last to be infected
  if (%infected > stop%) [ stop ] 
     
  check-sliders ;; check if any sliders impacting behavior have been changed
  
  ask turtles
    [ ifelse coupled?
        [ set couple-length couple-length + 1 ]
        [ move ] ;; move if not coupled
    ]

   ;; Any turtle can initiate mating if they are not coupled
   ;; (and random chance permits)
  ask turtles
    [ if not coupled? and (random-float max-coupling-factor < coupling-tendency)
        [ couple ] ]
  ask turtles [ uncouple ]
  ask turtles [ infect ]
  tick
end 



;; On each tick a check is made to see if sliders have been changed.
;; If one has been, the corresponding turtle variable is adjusted

to check-sliders
  
  if (slider-check-1 != average-condom-use)
    [ ask turtles [ assign-condom-use ]
      set slider-check-1 average-condom-use ]
end 


;; The following procedure assigns core turtle variables.  They use
;; the helper procedure RANDOM-NEAR so that the turtle variables have an
;; approximately "normal" distribution around the average values.

to assign-commitment  ;; turtle procedure
  set commitment random-near average-commitment
end 

to assign-coupling-tendency  ;; turtle procedure
  set coupling-tendency random-near average-coupling-tendency
end 

to assign-condom-use  ;; turtle procedure
  set condom-use random-near average-condom-use
end 


;; Helper procedure to approximate a "normal" distribution
;; around the given average value

;; Generate many small random numbers and add them together.
;; This produces a normal distribution of tendency values.
;; A random number between 0 and 100 is as likely to be 1 as it is to be 99.
;; However, the sum of 20 numbers between 0 and 5 is much more likely to be 50 than it is to be 99.

to-report random-near [center]  ;; turtle procedure
  let result 0
  repeat 40
    [ set result (result + random-float center) ]
  report result / 20
end 



;;;
;;; COUPLING/UNCOUPLING/INFECTING PROCEDURES
;;;


;; People have a chance to couple depending on their orientation,
;; their tendency to couple/have sex, and if they meet.
;; To better show that coupling has occurred, the patches below
;; the couple turn gray.

to couple  ;; turtle procedure 
  let potential-partner one-of (turtles-at -1 0) with [not coupled?] 
  if potential-partner != nobody
    [ 
      ;; check for sexual orientation compatibility 
      
      if ( ((male? and [likesboys?] of potential-partner) or 
            (not male? and [likesgirls?] of potential-partner ))      ;; if the partner is willing to mate
        and ( (likesboys? and [male?] of potential-partner) or 
              (likesgirls? and not [male?] of potential-partner ) ) ) ;; if the person in question is willing to mate
      [ 
      ;; normal coupling probability
      
      if random-float max-coupling-factor < [coupling-tendency] of potential-partner
      [ set partner potential-partner
        set coupled? true
        ask partner [ set coupled? true ]
        ask partner [ set partner myself ]
        ask partner [ set pcolor gray - 3]
        move-to patch-here ;; move to center of patch
        ask partner [move-to patch-here] ;; partner moves to center of patch
        set pcolor gray - 3 ]]
      ]
end 

;; If two persons are together for longer than either person's 
;; commitment variable allows, the couple breaks up.

to uncouple  ;; turtle procedure
  if coupled? 
    [ if (couple-length > commitment) or
         ([couple-length] of partner) > ([commitment] of partner)
        [ set coupled? false
          set couple-length 0
          ask partner [ set couple-length 0 ]
          set pcolor black
          ask partner [set pcolor black]
          ask partner [ set partner nobody ]
          ask partner [ set coupled? false ]
          set partner nobody ] ]
end 


;; Note that for condom use to occur, both people must want to use one.  If
;; either person chooses not to use a condom, infection is possible.  Changing the
;; primitive to AND in the third line will make it such that if either person
;; wants to use a condom, infection will not occur.

to infect  ;; turtle procedure
  if coupled? and infected? 
    [ if random-float max-condom-factor > condom-use or
         random-float max-condom-factor > ([condom-use] of partner)
        [ if random-float 100 < infection-chance
            [ ask partner [ set infected? true
                assign-shape
                ]  ]  ]  ]
end 



;;;
;;; REPORTER PROCEDURES
;;;

;; turtle procedures

to-report likesboys?
  ifelse ( (male? and orientation = "straight")
           or (not male? and orientation = "gay") )
  [report false] ;; straight men and lesbians don't like men
  [report true]  ;; everyone else likes men
end 

to-report likesgirls?
  ifelse ( (male? and orientation = "gay")
           or (not male? and orientation = "straight") )
  [report false] ;; gay men and straight women don't like women
  [report true]  ;; everyone else likes women
end 



;;;
;;; MONITOR PROCEDURES
;;;

to-report %infected
  ifelse any? turtles
    [ report (count turtles with [infected?] / count turtles) * 100 ]
    [ report 0 ]
end 

to-report %straight-infected
  ifelse any? turtles with [orientation = "straight"]
  [ report 100 * (count turtles with [infected? and orientation = "straight"]) / (count turtles with [orientation = "straight"]) ]
  [ report 0 ]
end 

to-report %bi-infected
  ifelse any? turtles with [orientation = "bi"]
  [ report 100 * (count turtles with [infected? and orientation = "bi"]) / (count turtles with [orientation = "bi"]) ]
  [ report 0 ]
end 

to-report %gay-infected
  ifelse any? turtles with [orientation = "gay"]
  [ report 100 * (count turtles with [infected? and orientation = "gay"]) / (count turtles with [orientation = "gay"]) ]
  [ report 0 ]
end 

to-report %F-infected
  ifelse any? turtles with [not male?]
  [ report 100 * count turtles with [infected? and not male?] / count turtles with [not male?] ]
  [ report 0 ]
end 

to-report %M-infected
  ifelse any? turtles with [male?]
  [ report 100 * count turtles with [infected? and male?] / count turtles with [male?] ]
  [ report 0 ]
end 


;;
;; Reporters for each combination of male/female gay/straight/bi
;; Not currently on display in the model (to avoid information overload),
;; but readily available if the user wishes to add monitors
;; to view additional demographic information
;;

to-report %M-straight-infected
  ifelse any? turtles with [male? and orientation = "straight"]
  [ report 100 * count turtles with [infected? and male? and orientation = "straight"] / count turtles with [male? and orientation = "straight"]]
  [ report 0 ]
end 

to-report %F-straight-infected
  ifelse any? turtles with [not male? and orientation = "straight"]
  [ report 100 * count turtles with [infected? and not male? and orientation = "straight"] / count turtles with [not male? and orientation = "straight"]]
  [ report 0 ]
end 

to-report %M-bi-infected
  ifelse any? turtles with [male? and orientation = "bi"]
  [ report 100 * count turtles with [infected? and male? and orientation = "bi"] / count turtles with [male? and orientation = "bi"]]
  [ report 0 ]
end 

to-report %F-bi-infected
  ifelse any? turtles with [not male? and orientation = "bi"]
  [ report 100 * count turtles with [infected? and not male? and orientation = "bi"] / count turtles with [not male? and orientation = "bi"]]
  [ report 0 ]
end 

to-report %M-gay-infected
  ifelse any? turtles with [male? and orientation = "gay"]
  [ report 100 * count turtles with [infected? and male? and orientation = "gay"] / count turtles with [male? and orientation = "gay"]]
  [ report 0 ]
end 

to-report %F-gay-infected
  ifelse any? turtles with [not male? and orientation = "gay"]
  [ report 100 * count turtles with [infected? and not male? and orientation = "gay"] / count turtles with [not male? and orientation = "gay"]]
  [ report 0 ]
end