virus outbreak sim

[bluatigro]

in folowing the corona virus
my stay at home chalence

this is a proof that staing at home is the best option
for lessening the speed of the outbreak

instruction :
type [ 0 - 100 ] when asked

Code: Select all

'' bluatigro 17 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as integer humans = 100
dim shared as long x(humans),y(humans),kl(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((x(i)-x(j))^2+(y(i)-y(j))^2))
end function
dim as string in
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
for i = 0 to humans
  x(i) = dice( scrnw )
  y(i) = dice( scrnh )
  kl(i) = healty
next i
kl(1) = ill
do
  cls
  for i = 0 to humans
    circle(x(i),y(i)),20,kl(i),,,,f
  next i
  for i = 0 to humans
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 20 then
          if kl(i) = ill then kl(j) = ill
        end if
      end if
    next j
    if rnd < activity / 100 then
      select case dice( 4 )
        case 0
          x(i) += 5
        case 1
          x(i) -= 5
        case 2
          y(i) += 5
        case 3
          y(i) -= 5
        case else
      end select
      if x(i) < 0 then x(i) = scrnw
      if x(i) > scrnw then x(i) = 0
      if y(i) < 0 then y(i) = scrnh
      if y(i) > scrnh then y(i) = 0
    end if
  next i
  sleep 40
loop while inkey = ""


[badidea]

You should include recovered persons, which don't spread the virus.
See: https://www.washingtonpost.com/graphics ... simulator/

A more sophisticated version could include:
* Duration of contact / probability of transferring the virus
* Sensitivity to the virus per person
* Disease phases and duration (no symptoms yet, no symptoms but spreading, too ill to move anyway, possible death or recovery)

And screenlock/screenunlock to reduce the flicker.

[paul doe]

And when finished, you can sell it to the CViSB (pronounced “SEE-VIZ-bee”[sic]) for giggles.

XD

[badidea]

Other things that one could simulate is: 1000 individuals, 5 infected. 3 Simulations, for 4 hours:
* All in 1 room
* 100 in 10 rooms
* 10 in 100 rooms
Run several times. What are the differences?
Problem is that reality is often more complicated and that the exact properties of the virus might not be known.

[dodicat]

Thanks bluatigro.
I shall add the worry sim.
Each contact increases anxiety.
The more anxiety the blacker.

Code: Select all

 Type ball
   x As Single    'position x component
   y As Single    'position y component
   dx As Single   'velocity x component
   dy As Single   'velocity y component
   col As Ulong   'colour
    As Long r,m    'radius, mass
    As Single dr   'contact variable
    as long done
End Type

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))   
Screen 20,32
Dim Shared As Integer xres,yres
Dim Shared As Any Ptr row:row=Screenptr
Dim Shared As Integer pitch
Screeninfo xres,yres,,,pitch

Sub _circle(b As ball)
    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    #define onscreen x>=0 And x<xres And y>.0 And y<yres
    #define putpixel(_x,_y,colour)    *Cptr(Ulong Ptr,row+ (_y)*pitch+ (_x) Shl 2)  =(colour)
    Dim As Ulong tc
    For x As Long=b.x-b.r To b.x+b.r
        For y As Long=b.y-b.r To b.y+b.r
            If incircle(b.x,b.y,b.r,x,y) Andalso onscreen Then
                If incircle(b.x,b.y,b.dr,x,y) Then
                    putpixel(x,y,0)
                Else
                    putpixel(x,y,b.col)
                end if
            End If
        Next
    Next
End Sub

Sub MoveAndDraw( b() As ball,Byref e As Long,s as string="",f as boolean,byref h as long=0)
    e=0
   dim as long h2
    For n As Long=Lbound(b) To Ubound(b)
       if f then if b(n).done=0 then s="  Worrying" else h2+=1
        b(n).x+=b(n).dx:b(n).y+=b(n).dy
        _circle(b(n))
        e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)
    Next n
    h=h2
    'if h then s= "  End Phase"
    if h=ubound(b) then s="   DONE"
End Sub

Sub edges(b() As ball,xres As Long,yres As Long,Byref status As Long=0 ) 'get status also
    For n As Long=Lbound(b) To Ubound(b)
        If(b(n).x<b(n).r) Then b(n).x=b(n).r: b(n).dx=-b(n).dx
        If(b(n).x>xres-b(n).r )Then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx
        If(b(n).y<b(n).r)Then b(n).y=b(n).r:b(n).dy=-b(n).dy
        If(b(n).y>yres-b(n).r)Then  b(n).y=yres-b(n).r:b(n).dy=-b(n).dy
        If b(n).x<0 Or b(n).x>xres Then status=0
        If b(n).y<0 Or b(n).y>yres Then status=0
    Next n
End Sub

Function DetectBallCollisions( B1 As ball,B2 As ball) As Single 'avoid using sqr if they are well seperated
    Dim As Long xdiff = B2.x-B1.x
    Dim As Long ydiff = B2.y-B1.y
    If Abs(xdiff) > (B2.r+B1.r) Then Return 0
    If Abs(ydiff) > (B2.r+B1.r) Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(B2.r+B1.r) Then Function=L Else Function=0
End Function


Sub BallCollisions(b() As ball,flag As boolean=0)
    For n1 As Long=Lbound(b) To Ubound(b)-1
        For n2 As Long=n1+1 To Ubound(b)
            Dim As Single  L= DetectBallCollisions(b(n1),b(n2))
            If L Then
                Dim As Single  impulsex=(b(n1).x-b(n2).x)
                Dim As Single  impulsey=(b(n1).y-b(n2).y)
                Dim As Single ln=Sqr(impulsex*impulsex+impulsey*impulsey)
                impulsex/=ln'normalize the impulse
                impulsey/=ln
                'set one ball to nearest non overlap position
                b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex
                b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey
               
                Dim As Single  impactx=b(n1).dx-b(n2).dx
                Dim As Single  impacty=b(n1).dy-b(n2).dy
                Dim As Single  dot=impactx*impulsex+impacty*impulsey
                Dim As Single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)
               
                b(n1).dx-=dot*impulsex*2*mn1
                b(n1).dy-=dot*impulsey*2*mn1
                b(n2).dx+=dot*impulsex*2*mn2
                b(n2).dy+=dot*impulsey*2*mn2
                If flag Then
                    b(n1).dr+=.02*b(n1).r:b(n2).dr+=.02*b(n2).r
                    If b(n1).dr>.95*b(n1).r Then b(n1).dr=.95*b(n1).r:b(n1).done=1
                    If b(n2).dr>.95*b(n2).r Then b(n2).dr=.95*b(n2).r:b(n2).done=1
                End If
            End If
        Next n2
    Next n1
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function


Dim As ball b(1 To 100)
For n As Long=1 To 100
    With b(n)
        .x=range(25,(xres-25))
        .y=range(25,(yres-25))
        .dx=(Rnd-Rnd)*2
        .dy=(Rnd-Rnd)*2
        .r=18+Rnd*4
        .m=.r^2
        .col=Rgb(Rnd*255,Rnd*255,Rnd*255)
    End With
Next n
Dim As Long e,ctr,fps,h,xpos
Dim As boolean f
dim as string msg
Do
    windowtitle "stability  "&e
   if f=0 then ctr+=1
    edges(b(),xres,yres)
    BallCollisions(b(),f)
    Screenlock
    Cls
    Draw String(20,20),Str(fps)+"  fps " + msg
    moveanddraw(b(),e,msg,f,h)
    if h then
    xpos=map(1,ubound(b),h,(.2*xres),(.8*xres))
    line(.2*xres,.9*yres)-(xpos,.92*yres),rgb(0,150,255),bf
    line(.2*xres,.9*yres)-(.8*xres,.92*yres),,b
    end if
    Screenunlock
    Sleep regulate(60,fps)
    if f=0 then If ctr>300 Then f=true' time for balls to seperate
Loop Until Inkey=Chr(27)



[bluatigro]

update :
i have added a notilljet , been_ill and dead color

problem :
i have no idea what i have to do whit the been_ill color
please help

Code: Select all

'' bluatigro 18 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 100
dim shared as long x(humans),y(humans),kl(humans),tijd(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((x(i)-x(j))^2+(y(i)-y(j))^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
for i = 0 to humans
  x(i) = dice( scrnw )
  y(i) = dice( scrnh )
  kl(i) = healty
next i
kl(1) = ill
do
  cls
  for i = 0 to humans
    circle(x(i),y(i)),6,kl(i),,,,f
  next i
  for i = 0 to humans
    if tijd(i) > 0 then tijd(i) -= 1
    if tijd(i) = 0 then
      if kl(i) = ill then
        if rnd < pdead / 100 / time_ill then
          kl(i) = dead
        end if
      end if
      if kl(i) = notilljet then
        kl(i) = ill
        tijd(i) = time_ill
      end if
    end if
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 3 then
          if kl(i) = ill then
            kl(j) = notilljet
            tijd(i) = incu
          end if
        end if
      end if
    next j
    if kl(i) <> dead then
      if rnd < activity / 100 then
        select case dice( 4 )
          case 0
            x(i) += 3
          case 1
            x(i) -= 3
          case 2
            y(i) += 3
          case 3
            y(i) -= 3
          case else
        end select
        if x(i) < 0 then x(i) = scrnw
        if x(i) > scrnw then x(i) = 0
        if y(i) < 0 then y(i) = scrnh
        if y(i) > scrnh then y(i) = 0
      end if
    end if
  next i
  sleep 40
loop while inkey = ""


[bluatigro]

update :
OOP added
humans = 1000

Code: Select all

'' bluatigro 18 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 1000
type thuman
  dim as double x , y '' spot of thuman
  dim as long kl '' color state of thuman
  dim as integer tijd ''counter for keeping time
end type
dim shared as thuman h(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((h(i).x-h(j).x)^2+(h(i).y-h(j).y)^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
for i = 0 to humans
  h(i).x = dice( scrnw )
  h(i).y = dice( scrnh )
  h(i).kl = healty
next i
h(1).kl = ill
do
  cls
  for i = 0 to humans
    circle(h(i).x,h(i).y),6,h(i).kl,,,,f
  next i
  for i = 0 to humans
    if h(i).tijd > 0 then h(i).tijd -= 1
    if h(i).tijd = 0 then
      if h(i).kl = ill then
        if rnd < pdead / 100 / time_ill then
          h(i).kl = dead
        end if
      end if
      if h(i).kl = notilljet then
        h(i).kl = ill
        h(i).tijd = time_ill
      end if
    end if
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 6 then
          if h(i).kl = ill then
            h(j).kl = notilljet
            h(j).tijd = incu
          end if
        end if
      end if
    next j
    if h(i).x <> dead then
      if rnd < activity / 100 then
        select case dice( 4 )
          case 0
            h(i).x += 3
          case 1
            h(i).x -= 3
          case 2
            h(i).y += 3
          case 3
            h(i).y -= 3
          case else
        end select
        if h(i).x < 0 then h(i).x = scrnw
        if h(i).x > scrnw then h(i).x = 0
        if h(i).y < 0 then h(i).y = scrnh
        if h(i).y > scrnh then h(i).y = 0
      end if
    end if
  next i
  sleep 40
loop while inkey = ""

 


[bluatigro]

update :
been_ill state added

REM :
green = healty
yellow = not ill jet
red = ill
blue = been ill
white = dead

smal error :
the dead are moving !!

Code: Select all

'' bluatigro 18 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 1000
type thuman
  dim as double x , y '' spot of thuman
  dim as long kl '' color state of thuman
  dim as integer tijd1 , tijd2 ''counter for keeping time
end type
dim shared as thuman h(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((h(i).x-h(j).x)^2+(h(i).y-h(j).y)^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
for i = 0 to humans
  h(i).x = dice( scrnw )
  h(i).y = dice( scrnh )
  h(i).kl = healty
  h(i).tijd1 = incu '' notilljet time
  h(i).tijd2 = time_ill
next i
h(1).kl = ill
do
  cls
  for i = 0 to humans
    circle(h(i).x,h(i).y),5,h(i).kl,,,,f
  next i
  for i = 0 to humans
      if h(i).kl = ill then
        h(i).tijd2 -= 1
        if h(i).tijd2 <= 0 then h(i).kl = been_ill
        if rnd < pdead / 100 / time_ill then
          h(i).kl = dead
        end if
      end if
      if h(i).kl = notilljet then
        h(i).tijd1 -= 1
        if h(i).tijd1 <= 0 then
          h(i).kl = ill
        end if
      end if
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 10 then
          if h(i).kl = ill then
            h(j).kl = notilljet
          end if
        end if
      end if
    next j
    if h(i).x <> dead then
      if rnd < activity / 100 then
        select case dice( 4 )
          case 0
            h(i).x += 3
          case 1
            h(i).x -= 3
          case 2
            h(i).y += 3
          case 3
            h(i).y -= 3
          case else
        end select
        if h(i).x < 0 then h(i).x = scrnw
        if h(i).x > scrnw then h(i).x = 0
        if h(i).y < 0 then h(i).y = scrnh
        if h(i).y > scrnh then h(i).y = 0
      end if
    end if
  next i
  sleep 40
loop while inkey = ""


[bluatigro]

update :
human stats added

error :
if no ill and no notiljet are there the sim shoot stop
the dead are moving !!

Code: Select all

'' bluatigro 18 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 1000
type thuman
  dim as double x , y '' spot of thuman
  dim as long kl '' color state of thuman
  dim as integer tijd1 , tijd2 ''counter for keeping time
end type
dim shared as thuman h(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((h(i).x-h(j).x)^2+(h(i).y-h(j).y)^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
if activity = 0 then activity = 100
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
for i = 0 to humans
  h(i).x = dice( scrnw )
  h(i).y = dice( scrnh )
  h(i).kl = healty
  h(i).tijd1 = incu '' notilljet time
  h(i).tijd2 = time_ill
next i
h(1).kl = ill
dim as integer done,hdead,hhealty,hbeenill
do
  cls
  for i = 0 to humans
    circle(h(i).x,h(i).y),5,h(i).kl,,,,f
  next i
  for i = 0 to humans
      if h(i).kl = ill then
        h(i).tijd2 -= 1
        if h(i).tijd2 <= 0 then h(i).kl = been_ill
        if rnd < pdead / 100 / time_ill then
          h(i).kl = dead
        end if
      end if
      if h(i).kl = notilljet then
        h(i).tijd1 -= 1
        if h(i).tijd1 <= 0 then
          h(i).kl = ill
        end if
      end if
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 20 then
          if h(i).kl = ill and h(j).kl = healty then
            h(j).kl = notilljet
          end if
        end if
      end if
    next j
    if h(i).x <> dead then
      if rnd < activity / 100 then
        select case dice( 4 )
          case 0
            h(i).x += 3
          case 1
            h(i).x -= 3
          case 2
            h(i).y += 3
          case 3
            h(i).y -= 3
          case else
        end select
        if h(i).x < 0 then h(i).x = scrnw
        if h(i).x > scrnw then h(i).x = 0
        if h(i).y < 0 then h(i).y = scrnh
        if h(i).y > scrnh then h(i).y = 0
      end if
    end if
  next i
  done = 1
  hdead = 0
  hhealty = 0
  hbeenill = 0
  for i = 0 to humans
    if h(i).kl = notilljet or h(i).kl = ill then done = 0
    if h(i).kl = dead then hdead += 1
    if h(i).kl = healty then hhealty += 1
    if h(i).kl = been_ill then hbeenill += 1
  next i
  sleep 40
loop while inkey = "" and not done
locate 10 , 10
cls
print
print
print "   end sim : stats humans :"
print
print "   dead : " + str( hdead )
print
print "   healty : " + str( hhealty )
print
print "   been ill : " + str( hbeenill )
sleep


[grindstone]

the dead are moving !!

Maybe zombies? *grin*

Tip: In FB a TYPE can contain an array of itself:

Code: Select all

type thuman
  dim as double x , y '' spot of thuman
  dim as long kl '' color state of thuman
  dim as integer tijd1 , tijd2 ''counter for keeping time
  Static As thuman human() 'humans array
  Declare Sub act(<optional parameter(s)>)
end type

ReDim As thuman thuman.human(0)

Sub thuman.act(<parameter(s)>)
   'here you can code the behaviour of the object (make it act like an individual person)
   ...
   Dim As UInteger index
   index =  (Cast(UInteger,@This) - Cast(UInteger,@thuman.human(0))) / SizeOf(thuman) 'calculate the own index within the humans array
   '                         |                        |_pointer to the beginning of the humans array
   '                         |__________________________pointer to the actual human
   ...
End Sub



So with a SUB as member of the TYPE you can make every member of the array act like an individual person (although that would be A LOT of work).

Using this principle I coded (the attempt of) a midage battle simulation some years ago and a flight operator simulation.

[BasicCoder2]

Interesting to see such simulations.
https://youtu.be/FsIGn5w0AKQ

[bluatigro]

update :
now whit travelers

{code]
'' bluatigro 30 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 1000
type thuman
dim as double x , y , dx , dy'' spot of thuman
dim as long kl '' color state of thuman
dim as integer tijd1 , tijd2 , isTraveling ''counter for keeping time
end type
dim shared as thuman h(humans)
function dist( i as integer , j as integer ) as integer
return cint(sqr((h(i).x-h(j).x)^2+(h(i).y-h(j).y)^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
if activity = 0 then activity = 100
input "type a % chance on traveling " ; in
dim as double pTravel = val( in )
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
return cint( rnd * x )
end function
function range( low as double , high as double ) as double
return rnd * ( high - low ) + low
end function
for i = 0 to humans
h(i).x = dice( scrnw )
h(i).y = dice( scrnh )
h(i).kl = healty
h(i).tijd1 = incu '' notilljet time
h(i).tijd2 = time_ill
if rnd < pTravel then
h(i).dx = range( -5 , 5 )
h(i).dy = range( -5 , 5 )
h(i).isTraveling = 1
end if
next i
h(1).kl = ill
dim as integer done,hdead,hhealty,hbeenill
do
cls
for i = 0 to humans
circle(h(i).x,h(i).y),5,h(i).kl,,,,f
next i
for i = 0 to humans
if h(i).kl = ill then
h(i).tijd2 -= 1
if h(i).tijd2 <= 0 then h(i).kl = been_ill
if rnd < pdead / 100 / time_ill then
h(i).kl = dead
end if
end if
if h(i).kl = notilljet then
h(i).tijd1 -= 1
if h(i).tijd1 <= 0 then
h(i).kl = ill
end if
end if
for j = 0 to humans
if i <> j then
if dist( i , j ) < 20 then
if h(i).kl = ill and h(j).kl = healty then
h(j).kl = notilljet
end if
end if
end if
next j
if h(i).x <> dead then
if h(i).isTraveling then
h(i).x += h(i).dx
h(i).y += h(i).dy
end if
if rnd < activity / 100 then
select case dice( 4 )
case 0
h(i).x += 3
case 1
h(i).x -= 3
case 2
h(i).y += 3
case 3
h(i).y -= 3
case else
end select
if h(i).x < 0 then h(i).x = scrnw
if h(i).x > scrnw then h(i).x = 0
if h(i).y < 0 then h(i).y = scrnh
if h(i).y > scrnh then h(i).y = 0
end if
end if
next i
done = 1
hdead = 0
hhealty = 0
hbeenill = 0
for i = 0 to humans
if h(i).kl = notilljet or h(i).kl = ill then done = 0
if h(i).kl = dead then hdead += 1
if h(i).kl = healty then hhealty += 1
if h(i).kl = been_ill then hbeenill += 1
next
sleep 40
loop while inkey = "" and not done
locate 10 , 10
cls
print
print
print " end sim :"
print
print " stats humans :"
print
print " dead : " + str( hdead )
print
print " healty : " + str( hhealty )
print
print " been ill : " + str( hbeenill )
sleep


[/code]

[bluatigro]

update :
pTavel is now in %
stats added

error :
the sim shoot stop when no ill and no notjetiil are there

Code: Select all

'' bluatigro 31 mrt 2020
'' virus outbreak sim
screen 18 , 32
const as long healty = rgb( 0 , 255 , 0 )
const as long notilljet = rgb( 255 , 255 , 0 )
const as long ill = rgb( 255 , 0 , 0 )
const as long been_ill = rgb( 0 , 0 , 255 )
const as long dead = rgb( 255 , 255 , 255 )
const as integer humans = 1000
type thuman
  dim as double x , y , dx , dy'' spot of thuman
  dim as long kl '' color state of thuman
  dim as integer tijd1 , tijd2 , isTraveling ''counter for keeping time
end type
dim shared as thuman h(humans)
function dist( i as integer , j as integer ) as integer
  return cint(sqr((h(i).x-h(j).x)^2+(h(i).y-h(j).y)^2))
end function
dim as string in
input "type incubation time [ in day's ] : " ; in
dim as integer incu = val( in )
if incu = 0 then incu = 14 '' corona
input "type time ill [ in day's ] : " ; in
dim as integer time_ill = val( in )
if time_ill = 0 then time_ill = 20 '' corona
input "type % dead [ 0 ... 100 ] : " ; in
dim as double pdead = val( in )
if pdead = 0 then pdead = 3 '' corona
input "type a % chance on activity " ; in
dim as integer activity = val( in ) ,i,j, scrnw , scrnh
if activity = 0 then activity = 100
input "type a % chance on traveling " ; in
dim as double pTravel = val( in )
screeninfo scrnw , scrnh
randomize timer
function dice( x as integer ) as integer
  return cint( rnd * x )
end function
function range( low as double , high as double ) as double
  return rnd * ( high - low ) + low
end function
for i = 0 to humans
  h(i).x = dice( scrnw )
  h(i).y = dice( scrnh )
  h(i).kl = healty
  h(i).tijd1 = incu '' notilljet time
  h(i).tijd2 = time_ill
  if rnd < pTravel / 100 then
    h(i).dx = range( -5 , 5 )
    h(i).dy = range( -5 , 5 )
    h(i).isTraveling = 1
  end if
next i
h(1).kl = ill
dim as integer done,hdead,hhealty,hbeenill
do
  cls
  for i = 0 to humans
    circle(h(i).x,h(i).y),5,h(i).kl,,,,f
  next i
  for i = 0 to humans
      if h(i).kl = ill then
        h(i).tijd2 -= 1
        if h(i).tijd2 <= 0 then h(i).kl = been_ill
        if rnd < pdead / 100 / time_ill then
          h(i).kl = dead
        end if
      end if
      if h(i).kl = notilljet then
        h(i).tijd1 -= 1
        if h(i).tijd1 <= 0 then
          h(i).kl = ill
        end if
      end if
    for j = 0 to humans
      if i <> j then
        if dist( i , j ) < 20 then
          if h(i).kl = ill and h(j).kl = healty then
            h(j).kl = notilljet
          end if
        end if
      end if
    next j
    if h(i).x <> dead then
      if h(i).isTraveling then
        h(i).x += h(i).dx
        h(i).y += h(i).dy
      end if
      if rnd < activity / 100 then
        select case dice( 4 )
          case 0
            h(i).x += 3
          case 1
            h(i).x -= 3
          case 2
            h(i).y += 3
          case 3
            h(i).y -= 3
          case else
        end select
        if h(i).x < 0 then h(i).x = scrnw
        if h(i).x > scrnw then h(i).x = 0
        if h(i).y < 0 then h(i).y = scrnh
        if h(i).y > scrnh then h(i).y = 0
      end if
    end if
  next i
  done = 1
  hdead = 0
  hhealty = 0
  hbeenill = 0
  for i = 0 to humans
    if h(i).kl = notilljet or h(i).kl = ill then done = 0
    if h(i).kl = dead then hdead += 1
    if h(i).kl = healty then hhealty += 1
    if h(i).kl = been_ill then hbeenill += 1
  next
  sleep 40
loop while inkey = "" and not done
locate 10 , 10
cls
print                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     
print
print "   end sim :"
print
print "   activity in % : " + str( activity )
print
print "   traveling in % : " + str( pTravel )
print
print "   stats humans :"
print
print "   dead : " + str( hdead )
print
print "   healty : " + str( hhealty )
print
print "   been ill : " + str( hbeenill )
sleep