Post by B+ on Mar 28, 2020 4:17:58 GMT
I just saw this on Internet, the model for the red bump we are all trying to flatten:
' 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
