virus outbreak sim

General FreeBASIC programming questions.
bluatigro
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

virus outbreak sim

Postby bluatigro » Mar 17, 2020 11:10

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
Posts: 2057
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: virus outbreak sim

Postby badidea » Mar 17, 2020 12:40

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
Posts: 1228
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: virus outbreak sim

Postby paul doe » Mar 17, 2020 14:58

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

XD
badidea
Posts: 2057
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: virus outbreak sim

Postby badidea » Mar 17, 2020 18:28

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
Posts: 6501
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: virus outbreak sim

Postby dodicat » Mar 17, 2020 20:41

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
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 18, 2020 7:41

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
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 18, 2020 8:18

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
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 18, 2020 8:53

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
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 18, 2020 9:47

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
Posts: 722
Joined: May 05, 2015 5:35
Location: Germany

Re: virus outbreak sim

Postby grindstone » Mar 18, 2020 14:37

bluatigro wrote: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
Posts: 3549
Joined: Jan 01, 2009 7:03

Re: virus outbreak sim

Postby BasicCoder2 » Mar 18, 2020 18:38

Interesting to see such simulations.
https://youtu.be/FsIGn5w0AKQ
bluatigro
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 30, 2020 6:38

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
Posts: 651
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: virus outbreak sim

Postby bluatigro » Mar 31, 2020 6:44

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

Return to “General”

Who is online

Users browsing this forum: No registered users and 8 guests