[Updated Mar 25, 2020:]
Now includes "Shelter-in-place" which shows how effective it is on mitigating the spread of the virus.
[Updated Apr 14, 2020:]
Added max & min travel distance from home. This will remove nomadic movement and simulate communal movement.
Added vacation (long distance travel). This has a huge effect on the virus's long term survival. It can escape from heard immunity.
Added hashing for much faster O time complexity for infection search.
CoronaSim.bas
Code: Select all
'Corona virus (COVID 19) simulator v1.1 by Shawn Grieb
Const WHITE = RGB(255,255,255)
Const GREEN = RGB(0,255,0)
Const RED = RGB(255,0,0)
Const YELLOW = RGB(200,200,0)
Const GREY = RGB(175,175,175)
Const DARKGREY = RGB(100,100,100)
Const HEALTHY = 0
Const INFECTED = 1
Const IMMUNED = 2
Const DEAD = 3
Const MOBILE = 0
Const STAYATHOME = 1
'Hash settings
Const HASHSTACKSIZE = 10
Const HASHMULTIPLYER = 5
'User modifiable constants.
Const NUMOFPEOPLE = 20000
Const SCREENX = 1280
Const SCREENY = 720
Const DEATHRATE = 0.034 'Percent of people who die from complications of the virus. Define in decimal form.
Const SHELTERINPLACE = .25'Percent of people who shelter in place. Define in decimal form.
Const INFDURATION = 500 'Infection duration.
Const IMMDURATION = 5000 'Immunity duration.
Const MAXDISTANCE = 15 'The max distance the most adventurous persons will travel from home. (This is not vacation travel)
Const MINDISTANCE = 10 'The minimum distance to define nonadventurous homebodies.
Const TRAVELDELAYRATE = 5 'Number of program iterations before one person vacation travels (long distance) to a new random point and make it their new home base.
Type person
Dim As Integer homex 'Homex and homey is the person's home base or center of their area of travel in their community.
Dim As Integer homey 'Homex and homey will make the random walk non-nomadic.
Dim As Integer distance 'How far from home the person travels or how adventurous they are.
Dim As Integer x 'X and Y are current position on map
Dim As Integer y
Dim As Integer healthstate
Dim As Integer mobilestate
Dim As Integer durationcount
End Type
'StashTable, the hashing of stacked bins.
type StashTable
declare Constructor(tsize as Integer, stackdepth As integer)
declare destructor()
declare sub push(xkey As Integer, ykey As Integer, id As Integer)
Declare Function setstackdump(xkey As Integer, ykey As Integer) As Integer
Declare Function pop() As Integer
Declare Sub reset()
private:
dim as Integer Ptr Ptr sht
Dim As Integer Ptr tx
Dim As Integer Ptr ty
Dim As Integer Ptr si
Dim as Integer tablesize
Dim As Integer stacksize
Dim As Integer popstackindex
Dim As LongInt poptableindex
End type
constructor StashTable(dimsize as Integer, stackdepth As integer)
this.sht = new Integer Ptr [dimsize+1]
this.tx = New Integer [dimsize+1]
this.ty = New Integer [dimsize+1]
this.si = New Integer [dimsize+1]
For i As Integer = 0 To dimsize
this.sht[i] = New Integer [stackdepth+1]
this.tx[i] = -1
this.si[i] = 0
Next i
this.tablesize = dimsize
this.stacksize = stackdepth
this.popstackindex = -1
this.poptableindex = -1
End constructor
destructor StashTable()
For i As Integer = 0 To this.tablesize
Delete [] This.sht[i]
Next i
Delete [] this.sht
Delete this.tx
Delete this.ty
Delete This.si
End destructor
sub StashTable.push(xkey As Integer, ykey As Integer, idkey As Integer)
dim as LongInt index = (xkey * ykey) mod this.tablesize
dim as Integer hashcount = 0
Do
If This.tx[index] = -1 Then
this.tx[index] = xkey
this.ty[index] = ykey
EndIf
'push key in valid index
If this.tx[index] = xkey And this.ty[index] = ykey Then
If this.si[index] < this.stacksize Then
this.sht[index][this.si[index]] = idkey
this.si[index] = this.si[index] + 1
Exit Do
Else
Print "Push stack overflow!"
Sleep
exit Do
EndIf
Else
index = (index + 1) mod this.tablesize
if hashcount > this.tablesize Then
print "Push hash falure!"
Sleep
end If
hashcount = hashcount + 1
EndIf
loop
end Sub
function StashTable.setstackdump(xkey As Integer, ykey As Integer) As Integer
Dim As LongInt index = (xkey * ykey) Mod this.tablesize
Dim as Integer hashcount = 0
Do
If this.tx[index] = -1 Then
Return 0
ElseIf This.tx[index] = xkey And this.ty[index] = ykey Then
this.poptableindex = index
this.popstackindex = This.si[index] - 1
Return -1
Else
index = (index + 1) mod this.tablesize
if hashcount > this.tablesize Then
print "Setstackdump hash falure!"
Sleep
end If
hashcount = hashcount + 1
EndIf
Loop
End Function
Function StashTable.pop() As Integer
Dim As Integer popkey = -1
If this.poptableindex > -1 Then
popkey = this.sht[this.poptableindex][this.popstackindex]
this.popstackindex = this.popstackindex - 1
If this.popstackindex = -1 Then
this.poptableindex = -1
EndIf
End If
Return popkey
End Function
Sub StashTable.reset()
For t As Integer = 0 To This.tablesize
this.tx[t] = -1
this.si[t] = 0
Next t
this.popstackindex = -1
this.poptableindex = -1
End Sub
Dim As stashtable hash = stashtable(NUMOFPEOPLE * HASHMULTIPLYER, HASHSTACKSIZE)
ScreenRes SCREENX, SCREENY, 32,,0
Dim As Any Ptr backbuffer, mapbuffer
backbuffer = ImageCreate(SCREENX,SCREENY,,32)
mapbuffer = ImageCreate(SCREENX,SCREENY,,32)
Dim As Integer travelstate = 0
Dim As person Ptr p
p = New person [NUMOFPEOPLE+1]
For i As Integer = 1 To NUMOFPEOPLE
p[i].homex = SCREENX * Rnd
p[i].homey = SCREENY * Rnd
p[i].x = p[i].homex
p[i].y = p[i].homey
p[i].distance = (MAXDISTANCE-MINDISTANCE) * Rnd + MINDISTANCE
p[i].healthstate = HEALTHY
P[i].mobilestate = MOBILE
If Rnd < SHELTERINPLACE Then p[i].mobilestate = STAYATHOME
p[i].durationcount = 0
Next
p[1].healthstate = INFECTED 'Start with one person infected.
Do
Dim As Integer direction
hash.reset()
For i As Integer = 1 To NUMOFPEOPLE
If p[i].healthstate <> DEAD Then
If p[i].mobilestate = MOBILE Then
direction = 5 * Rnd
Select Case direction
Case 1'left
If p[i].x > 1 Then
If p[i].x > p[i].homex - p[i].distance Then
p[i].x = p[i].x - 1
End If
EndIf
Case 2'right
If P[i].x < SCREENX-1 Then
If p[i].x < p[i].homex + p[i].distance Then
p[i].x = p[i].x + 1
End If
EndIf
Case 3'up
If p[i].y > 1 Then
If p[i].y > p[i].homey - p[i].distance Then
p[i].y = p[i].y - 1
End If
EndIf
Case 4'down
If p[i].y < SCREENY-1 Then
If p[i].y < p[i].homey + p[i].distance Then
p[i].y = p[i].y + 1
End If
EndIf
End Select
End If
End If
hash.push(p[i].x, p[i].y, i)
Next i
For i As Integer = 1 To NUMOFPEOPLE
'Check for nebors and infect them.
If p[i].healthstate = INFECTED Then
If hash.setstackdump(p[i].x, p[i].y) Then
Dim As Integer index
Do
index = hash.pop()
If index > -1 Then
If p[index].healthstate = HEALTHY Then
p[index].healthstate = INFECTED
End If
Else
Exit Do
End If
Loop
EndIf
End If
'Check infected statecount.
If p[i].healthstate = INFECTED Then
If p[i].durationcount < INFDURATION Then
p[i].durationcount = p[i].durationcount + 1
Else
If Rnd < DEATHRATE Then
p[i].healthstate = DEAD
p[i].durationcount = 0
Else
p[i].healthstate = IMMUNED
p[i].durationcount = 0
EndIf
EndIf
EndIf
'Check immuned statecount.
If p[i].healthstate = IMMUNED Then
If p[i].durationcount < IMMDURATION Then
p[i].durationcount = p[i].durationcount + 1
Else
p[i].healthstate = HEALTHY
p[i].durationcount = 0
EndIf
EndIf
Next
Line backbuffer, (0,0)-(SCREENX-1,SCREENY-1),0,BF'cls
'Move one person for long distance travel. (move or vacation)
If travelstate = 0 Then
Dim As Integer index = (Rnd * NUMOFPEOPLE+1)-1 'Pick a person at random.
If p[index].healthstate <> DEAD Then 'The dead do not go on vacation.
Dim As Integer oldx = p[index].x
Dim As Integer oldy = p[index].y
Dim As Integer newx = Rnd * SCREENX
Dim As Integer newy = Rnd * SCREENY
p[index].homex = newx
p[index].homey = newy
p[index].x = p[index].homex
p[index].y = p[index].homey
'Draw travel vector.
Line backbuffer, (newx,newy)-(oldx,oldy),GREY
End If
End If
travelstate = (travelstate + 1) Mod TRAVELDELAYRATE
'Draw persons and stats.
Dim As Integer healthycount = 0, infectedcount = 0, immunedcount = 0, deadcount = 0
For i As Integer = 1 To NUMOFPEOPLE
Dim As Integer x = p[i].x, y = p[i].y
Dim As Long c
Select Case p[i].healthstate
Case HEALTHY
c = GREEN
healthycount = healthycount + 1
Case INFECTED
c = RED
infectedcount = infectedcount + 1
Case IMMUNED
c = YELLOW
immunedcount = immunedcount + 1
case DEAD
c = WHITE
deadcount = deadcount + 1
End Select
PSet backbuffer, (x,y),c
Next
Draw String backbuffer, (SCREENX/2 -48, 0), "(Corona Sim v1.1)", WHITE,, PSet
Draw String backbuffer, (0, 0), "Healthy: "+Str(healthycount), GREEN,, PSet
Draw String backbuffer, (0, 9), "Infected: "+Str(infectedcount), RED,, PSet
Draw String backbuffer, (0, 19), "Immuned: "+Str(immunedcount), YELLOW,, PSet
Draw String backbuffer, (0, 29), "Dead: "+Str(deadcount), GREY,, PSet
Draw String backbuffer, (SCREENX-180,0), "Shelter-In-Place: "+Str(SHELTERINPLACE*100)+"%", GREY,, PSet
Draw String backbuffer, (SCREENX-180,9), "Death Rate: "+Str(DEATHRATE*100)+"%", GREY,, PSet
ScreenLock
Put (0,0),backbuffer,PSet
ScreenUnLock
Sleep 1
Loop Until InKey <> ""
ImageDestroy(backbuffer)
ImageDestroy(mapbuffer)
Delete [] p