COVID-19 in the University

globals [peopleShapes averageNumberLinksActual averagePContact averagePMask infectionRate networkSpaceColor roomColor ]

breed [people person]

people-own [infected infectedTime immune recoveredTime pContactPerLink pMask pCheck lastInfectionRate schedule testDate quarantined?]

patches-own [load spaceID airTurnover physical? masked?]

to setup
  clear-all
  reset-ticks

  set peopleShapes  ["person business" "person doctor" "person farmer" "person graduate" "person lumberjack"
  "person police" "person service" "person soldier" "person student"]

  set networkSpaceColor 3
  set roomColor 93

  set classCap 10

  ;;initialize patches
  ask patches [set load 0 set spaceID "N/A" set airTurnover 0 set physical? false]

   ;; set up the space
  ask patches with [pxcor < 0] [set spaceID "network" set pcolor networkSpaceColor]
  make-room 2 2 15 15 fracAirTurnover false "dining hall"
  make-room 18 2 5 10 fracAirTurnover true "class 1"
  make-room 24 2 5 10 fracAirTurnover true "class 2"
  make-room 18 20 5 10 fracAirTurnover true "class 3"
  make-room 24 20 5 10 fracAirTurnover true "class 4"
  make-room 2 20 5 10 fracAirTurnover true "class 5"
  make-room 8 20 5 10 fracAirTurnover true "class 6"


  ;;make default schedule (currently in 12 parts - 2h)
  let defaultSchedule (list "network" "network" "network" "network" "network" "network" "network" "network" "network" "network" "network" "network")

  create-people numberPeople [

    go-to-space "network"
    set color green
    set infected false
    set immune false
    set quarantined? false
    set testDate 0

    set pContactPerLink max list 0 random-normal pContactPerLinkPerDay_Mean pContactPerLink_SD
    set pCheck max list 0 random-normal pCheck_mean pCheck_SD

    set lastInfectionRate 0

    set pMask max list 0 random-normal pMask_Initial_Mean pMask_Initial_SD

    set schedule defaultSchedule

    ;;add mealtime to schedule
    if groupLunch? [
      let lunchDraw random-float 1
      if-else lunchDraw < 0.3 [set schedule replace-item 5 schedule "dining hall"] [
        if-else lunchDraw < 0.6 [set schedule replace-item 6 schedule "dining hall"] [
          set schedule replace-item 7 schedule "dining hall"]
      ]
    ]


    ;;assign a shape randomly
    set shape one-of peopleShapes
  ]

  ;;make schedules
  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 1"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 1"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 1"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 1"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 1"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 1"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 1"]

  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 2"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 2"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 2"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 2"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 2"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 2"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 2"]

  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 3"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 3"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 3"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 3"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 3"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 3"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 3"]

  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 4"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 4"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 4"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 4"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 4"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 4"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 4"]

  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 5"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 5"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 5"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 5"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 5"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 5"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 5"]

  ask n-of classCap people with [item 4 schedule = "network"] [set schedule replace-item 4 schedule "class 6"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 5 schedule "class 6"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 6 schedule "class 6"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 7 schedule "class 6"]
  ask n-of classCap people with [item 8 schedule = "network"] [set schedule replace-item 8 schedule "class 6"]
  ask n-of classCap people with [item 9 schedule = "network"] [set schedule replace-item 9 schedule "class 6"]
  ask n-of classCap people with [item 10 schedule = "network"] [set schedule replace-item 10 schedule "class 6"]



  ;;inital infections
  ask n-of initialInfections people [
    set infected true
    set infectedTime ticks
  ]

  ;;create social network links
  let numLinks averageLinksPerAgent * numberPeople / 2
  while [numLinks > 0] [

    ask one-of people [create-link-with one-of other people]
    set numLinks numLinks - 1
  ]


  ;; update global variables
  update-globals
end 

to go


   ask links [
      if (any? both-ends with [infected = true]) and (count both-ends with [quarantined? = false] = 2) and (count both-ends with [physical? = false] = 2) [
        let currentPContact [pContactPerLink] of one-of both-ends * (timeStep / 24) ;;
        let currentPMasks [pMask] of both-ends
        let currentPInfection pInfectionPerContact
        if random-float 1 < item 0 currentPMasks [set currentPInfection currentPInfection / riskReductionFactor_mask ]
        if random-float 1 < item 1 currentPMasks [set currentPInfection currentPInfection / riskReductionFactor_mask ]
        if random-float 1 < currentPInfection * currentPContact [
          ask both-ends [
          if not immune and not infected [set infected true set infectedTime ticks]
          ]
        ]
      ]
    ]

    let numContacts numberRandomContactsPerStep
    while [numContacts > 0] [

      let currentPair n-of 2 people

      if any? currentPair with [infected = true] and (count currentPair with [quarantined? = false] = 2)  and (count currentPair with [physical? = false] = 2) [

        let currentPMasks [pMask] of currentPair
        let currentPInfection pInfectionPerContact
        if random-float 1 < item 0 currentPMasks [set currentPInfection currentPInfection / riskReductionFactor_mask ]
        if random-float 1 < item 1 currentPMasks [set currentPInfection currentPInfection / riskReductionFactor_mask ]

        if random-float 1 < currentPInfection  [
          ask currentPair [
            if not immune and not infected [set infected true set infectedTime ticks]
          ]
        ]

      ]

     set numContacts numContacts - 1
    ]


  ask people [


    ;; move people if they are in the wrong place for this time
    let localTime ticks mod (24 / timeStep)
    set  localTime floor localTime / (24 / timeStep / length schedule)

    if quarantined? = false and [spaceID] of patch-here != item localTime schedule [
      go-to-space item localTime schedule
    ]

    if [physical?] of patch-here = true [
      ;;let people move
      let currentRoom [spaceID] of patch-here
      if random-float 1 < probTurn [facexy [pxcor] of one-of patches with [spaceID = currentRoom] [pxcor] of one-of patches with [spaceID = currentRoom]]
      forward speed

      ;;drop viral load if infected]
      let factor 1
      if infected [
        ask patch-here [
          if masked? = true [set factor factor / riskReductionFactor_mask]
          set load load + viralLoad / factor]]

      ;;test if newly infected
      if (not immune and not infected and random-float 1 < pInfectionPerLoad / factor * load ) [
        set infected true
        set infectedTime ticks
      ]
    ]

    ;;test if died
    if (infected and random-float 1 < caseMortalityRate / (recoveryTimeFromInfection_Days * (24 / timeStep)) ) [

      let currentAgentSet self
      let currentDegrees degreesConsidered
      let currentBump pMaskBump_die
      while [currentDegrees > 0] [
        ask currentAgentSet [
          ask out-link-neighbors [set pMask pMask + currentBump]
        ]
        set currentBump currentBump * (1 - pMaskBumpDecay_degree)
        set currentAgentSet out-link-neighbors
        set currentDegrees currentDegrees - 1
      ]

      die
    ]

    ;;check if recovered
    if (infected and ticks - infectedTime > recoveryTimeFromInfection_Days * (24 / timeStep) ) [
      set infected false
      set immune true
      set recoveredTime ticks
    ]


    ;; test if immunity lost
    if (immune and ticks - recoveredTime > immunityTime_Days * (24 / timeStep) ) [
     set immune false
    ]

    ;;update agent color based on infection
    if infected [set color red]
    if not infected [set color green]
    if immune [set color blue]

    ;;update other visualization parameters
    if seeNetwork? = true [ ask links [set hidden? false]]
    if seeNetwork? = false [ ask links [set hidden? true]]


    ;;update individual parameters
    set pMask pMask * (1 - pMask_decay)
    if random-float 1 < pCheck [
      if infectionRate > lastInfectionRate [
        set pMask pMask + pMaskBump_rise
      ]
      set lastInfectionRate infectionRate
    ]
  ]


  ;;run testing program once per day
  if ticks mod (24 / timeStep) = 0 [
    ask up-to-n-of testingCapacityPerDay people with [testDate < ticks] [
      ifelse infected = true [set quarantined? true go-to-space "network"  ] [set quarantined? false]
      set testDate ticks + testingFrequency * (24 / timeStep)
    ]
  ]

  ;;update physical spaces
  ;;update patch color based on load
  ;;diffuse load diffuseShare
  ask patches with [physical? = false] [set load 0]
  ask patches with [physical? = true] [
    ;;set load load * (1 - 1 / virusLifetime)
    update-virus-in-space

    if-else seeCovid? [

     set pcolor scale-color yellow load 0 viralLoad
    ] [
     set pcolor black
    ]
  ]



  ;; update global variables
  update-globals

  tick
end 

to update-globals

  set averageNumberLinksActual count links / count people
  set averagePContact sum [pContactPerLink] of people / count people
  set averagePMask sum [pMask] of people / count people
  set infectionRate count people with [infected = true] / count people
end 

to make-room [x y h w a m id]
  ask patches with [pxcor >= x and pxcor < x + h and pycor >= y and pycor < y + w] [
    set spaceID id
    set airTurnover a
    set physical? true
    set masked? m
  ]

  draw-box x y h w
end 

to draw-box [x y h w]
  ask patches with [pxcor = x and pycor >= y and pycor < y + w] [
    sprout 1 [set shape "line" set color white set heading 0 set xcor xcor - 0.5 stamp die]
  ]
  ask patches with [pxcor = x + h - 1 and pycor >= y and pycor < y + w] [
    sprout 1 [set shape "line" set color white set heading 0 set xcor xcor + 0.5 stamp die]
  ]
  ask patches with [pycor = y and pxcor >= x and pxcor < x + h] [
    sprout 1 [set shape "line" set color white set heading 90 set ycor ycor - 0.5 stamp die]
  ]
  ask patches with [pycor = y + w - 1 and pxcor >= x and pxcor < x + h] [
    sprout 1 [set shape "line" set color white set heading 90 set ycor ycor + 0.5 stamp die]
  ]
end 

to go-to-space [id]
  let newPatch one-of patches with [spaceID = id]
  setxy [pxcor] of newPatch + (random 1 - 0.25) [pycor] of newPatch + (random 1 - 0.25)
end 

to update-virus-in-space

  ;;let virus diffuse
  let roomNeighbors neighbors with [spaceID = [spaceID] of self]
  let loadOut load * diffuseShare
  ask roomNeighbors [set load load + loadOut / count roomNeighbors]
  set load max (list 0 (load - loadOut))

  ;;let virus decay
  set load load * (1 - 1 / virusLifetime)

  ;;let air flow (flow is always from lower x to higher x, by default
  let movedLoad load * airTurnover
  set load load - movedLoad
  ask patch-at 1 0 [set load load + movedLoad]
end