SIR Model of Disease Spread (Just Basic)

Started by bplus, March 28, 2020, 04:40:48

Previous topic - Next topic

bplus

Some GUI from JB:


' SIR Model of Disease Spread.txt for JB v2.0 b+ 2020-03-27
' Numberphile math model of disease spread
' https://www.youtube.com/watch?v=k6nLfCbAzgo

global H$, XMAX, YMAX, S, I, R, Trans, Recov, dt, sq
H$ = "gr"
XMAX = 1020
YMAX = 540
sq = 10 'for "slider knobs"

nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above

graphicbox #gr.gbGraph, 10, 10, 1000, 400
statictext #gr.stTrans, "Transmission Rate:", 10, 421, 780, 18
graphicbox #gr.gbTrans, 10, 440, 780, 30
statictext #gr.stRecov, "Recovery Rate:", 10, 481, 780, 18
graphicbox #gr.gbRecov, 10, 500, 780, 30
button #gr.btGraph, "Clear Graph", clrGraph, UL, 810, 440, 200, 90
open "SIR Model of Disease Spread: S = Susceptible Blue, I = Infected Red, R = Removed (neither S nor I) Green" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr.gbTrans "when leftButtonUp lButtonUpTrans"
#gr.gbRecov "when leftButtonUp lButtonUpRecov"
#gr.gbGraph "down"
#gr.gbTrans "backcolor black"
#gr.gbTrans "down"
#gr.gbRecov "backcolor black"
#gr.gbRecov "down"
#gr.gbGraph "size 2"
Trans = 3.2
Recov = .23
#gr.stTrans, "0.00 - 4.00 Transmission Rate: ";Trans
#gr.gbTrans "line ";10;" ";15;" ";770;" ";15
x = Trans / 4 * 760 + 10
y = 15
#gr.gbTrans "place ";x - sq;" ";y - sq
#gr.gbTrans "boxfilled ";x + sq;" ";y + sq

#gr.stRecov, "0.00 - 1.00 Recovery Rate: ";Recov
#gr.gbRecov "line ";10;" ";15;" ";770;" ";15
x = Recov * 760 + 10
y = 15
#gr.gbRecov "place ";x - sq;" ";y - sq
#gr.gbRecov "boxfilled ";x + sq;" ";y + sq
call graph
wait'

function dSdt (a)
    dSdt = (-1 * Trans * S * I) * dt
end function

function dIdt (a)
    dIdt = (Trans * S * I - Recov * I) * dt
end function

function dRdt (a)
    dRdt = (Recov * I) * dt
end function

sub clrGraph H$
    #gr.gbGraph "color white" 'clear box
    #gr.gbGraph "backcolor white"
    #gr.gbGraph "place ";0;" ";0
    #gr.gbGraph "boxfilled ";1000;" ";400
end sub

sub graph
    t = 0 : S = .99 : I = .001 : R = 0 : dt = .03
    WHILE t < 1000
        newS = S + dSdt(1)
        newI = I + dIdt(1)
        newR = R + dRdt(1)
        #gr.gbGraph "color blue"
        #gr.gbGraph "set ";t;" ";400 - 400 * newS
        #gr.gbGraph "color red"
        #gr.gbGraph "set ";t;" ";400 - 400 * newI
        #gr.gbGraph "color green"
        #gr.gbGraph "set ";t;" ";400 - 400 * newR
        S = newS
        I = newI
        R = newR
        t = t + 1
    WEND
end sub

sub lButtonUpTrans H$, mx, my  'must have handle and mouse x,y
    if mx >= 10 and mx <= 770 then 'mouse over slider
        Trans = 4 * (mx - 10) / 760 'new Trans
        Trans = Int(Trans * 100) / 100
        #gr.gbTrans "color white" 'clear box
        #gr.gbTrans "backcolor white"
        #gr.gbTrans "place ";0;" ";0
        #gr.gbTrans "boxfilled ";780;" ";780
        #gr.gbTrans "color black" 'redraw
        #gr.gbTrans "backcolor black"
        #gr.gbTrans "line ";10;" ";15;" ";770;" ";15
        x = Trans / 4 * 760 + 10
        y = 15
        #gr.gbTrans "place ";x - sq;" ";y - sq
        #gr.gbTrans "boxfilled ";x + sq;" ";y + sq
        #gr.stTrans "0.00 - 4.00 Transmission Rate: ";Trans
        call graph
    end if
end sub

sub lButtonUpRecov H$, mx, my  'must have handle and mouse x,y
    if mx >= 10 and mx <= 770 then 'mouse over slider
        Recov = (mx - 10) / 760 'new Recov
        Recov = Int(Recov * 100) / 100
        #gr.gbRecov "color white" 'clear box
        #gr.gbRecov "backcolor white"
        #gr.gbRecov "place ";0;" ";0
        #gr.gbRecov "boxfilled ";780;" ";780
        #gr.gbRecov "color black" 'redraw
        #gr.gbRecov "backcolor black"
        #gr.gbRecov "line ";10;" ";15;" ";770;" ";15
        x = Recov * 760 + 10
        y = 15
        #gr.gbRecov "place ";x - sq;" ";y - sq
        #gr.gbRecov "boxfilled ";x + sq;" ";y + sq
        #gr.stRecov "0.00 - 1.00 Recovery Rate: ";Recov
        call graph
    end if
end sub

sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub



1 person likes this

bplus

#1
I learned some unpleasant news from this model. If we are successful in slowing the Transmission of the disease, then the "life" of the disease is stretched out over a longer period of time and that's assuming we maintain the conditions that lower transmission rate.

Also this is first time ever I used JB to create an "exe" which turns out to be a RunTime.exe renamed to same as .TKN file name with a number of .DLL's thrown in, BUT it is stand alone (in Windows only I assume).

1 person likes this

Matty

What you are actually wanting to reduce is the area under the curve.....to minimise total cases....

Obviously stretching it out can increase the total area, but you have two considerations:

1. Quantity capable of dealing with at any one time by medical services. Want to stay within this range.
2. Total cases - area under curve.

So you want to arrange the curve so that you get the minimum for 2 given a value for 1.

bplus

#3
Hi Matty,

"Area under the curve" sound like a calculus thing, does not apply here.

The axis going left to right is a time line.

So each vertical line is a snapshot in time as the "life" of the disease (red=infected) rises and then falls off.

The isolation method imposed on us to by the state is to slow the transmission rate so that health care facilities are not overwhelmed with sick. Flatten the red bump is first main goal.

If you move slider bar to left you can see how the red bump flattens out as transmission rate is reduced such that, when reduced enough, a portion of the Susceptible = Blue never get infected as disease dies out.
1 person likes this

bplus

Gotta say, playing around with this model did warn me of a long haul ahead!
1 person likes this