Modelling populations
There are plenty of statistics about population. If we concentrate on birth and death rates of 'cohorts' of males and females, ie those in certain age groups, we can model how the total population changes with time. Then throw in plagues, wars etc at random. Or immigrants arriving as economic migrants, or escaping from war-torn countries. Or introduce compulsory euthanasia at ag 70. Or tax children to limit birth rates. All goo clean fun..
'populater7 8 Feb 2006
'draws and updates population pyramids as cohorts ( 5 year groups)
' are born, die or have children.
'put in real data to watch, or implement your own eugenics
' eg kill everyone off when they reach 40
' or enforce 1 child per family...
'a work-in-progress
'let me know of any ideas to improve it.
nomainwin
dim men( 20), women( 20), drm( 20), drw( 20), brm( 20), brw( 20)
' population, death rates of men & women in each cohort,
' and birth rates of male & female babies (so I can include
' eugenics like choosing male babies as a preference!)
global future, currentpop, delay, deltap
for cohort =0 to 19 ' The start data can easily be changed . . . .
read a: men( cohort) =a 'number of males in cohort
read a: women( cohort) =a 'females
read a: drm( cohort) =a 'death rate for males in cohort
read a: drw( cohort) =a 'females
read a: brm( cohort) =a 'birth rate of male babies to girls in cohort
read a: brw( cohort) =a 'birth rate of female babies
next cohort
' pop pop drm drw brm brw
' num num % % % %
data 50, 50, 2, 2, 0, 0 ' cohort zero ages 0 to 4
data 0, 0, 1, 1, 0, 0 ' cohort one ages 5 to 9
data 0, 0, 1, 1, 2, 2 ' cohort 10 to 14 first fertile cohort
data 0, 0, 1, 1, 7, 7 ' cohort 15 to 19
data 0, 0, 2, 1, 21, 21 ' cohort 20 to 24 men are silly at this age...
data 0, 0, 1, 1, 30, 30 ' cohort 25 to 29 NB I assume equal m/f birth rate- with no selection they are within 3% of each other, females higher
data 0, 0, 1, 1, 33, 33 ' cohort 30 to 34
data 0, 0, 1, 1, 12, 12 ' cohort 35 to 39
data 0, 0, 1, 1, 6, 6 ' cohort 40 to 44
data 0, 0, 1, 1, 1, 1 ' cohort 45 to 49
data 0, 0, 5, 5, 0, 0 ' cohort 50 to 54
data 0, 0, 8, 7, 0, 0 ' cohort 55 to 59 About here death rates start to rise . . .
data 0, 0, 12, 9, 0, 0 ' cohort 60 to 64 but less for women than for men . . . .
data 0, 0, 18, 11, 0, 0 ' cohort 65 to 69
data 0, 0, 28, 15, 0, 0 ' cohort 70 to 74
data 0, 0, 40, 28, 0, 0 ' cohort 75 to 79
data 0, 0, 70, 50, 0, 0 ' cohort 80 to 84
data 0, 0, 80, 65, 0, 0 ' cohort 85 to 89
data 0, 0, 90, 70, 0, 0 ' cohort 90 to 94
data 0, 0, 98, 95, 0, 0 ' cohort 95+
WindowWidth =880
WindowHeight =620
UpperLeftX =INT( ( DisplayWidth -WindowWidth) /2)
UpperLeftY =INT( ( DisplayHeight -WindowHeight) /2)
menu #jf, "&File", "E&xit", [quit]
menu #jf, "&Help", "&About", [about]
graphicbox #jf.g5, 203, 82, 16, 200
graphicbox #jf.g, 10, 70, 400, 220
graphicbox #jf.g2, 10, 310, 400, 204
graphicbox #jf.g3, 520, 10, 50, 50
graphicbox #jf.g4, 10, 300, 400, 8
textbox #jf.t1, 10, 30, 400, 30
textbox #jf.t2, 10, 520, 400, 30
texteditor #jf.t3, 420, 70, 440, 460
button #jf.delayup, "Slower", slower, UR, 380, 34
button #jf.delaydn, "Faster", faster, UR, 380, 8
button #jf.war, "War!", war, UR, 260, 8
button #jf.famine, "Famine!", famine, UR, 180, 8
button #jf.boom, "Baby boom!", boom, UR, 80, 8
button #jf.over, "Boom over!", over, UR, 80, 34
button #jf.plague, "Plague!", plague, UR, 180, 34
open "Population Modeller- 'Populater' JohnF Feb 2006." for window_nf as #jf
print #jf, "trapclose [out]"
print #jf.g, "size 4"
print #jf.t1, "!font courier_new 16 bold"
print #jf.t2, "!font courier_new 8"
print #jf.t1, " Females ... Males"
print #jf.t3, "!font courier_new 8"
open "Malthus.txt" for input as #autoexec
print #jf.t3, "!contents #autoexec";
close #autoexec
delay =50000
deltap = 0
print #jf.g2, "down ; size 2 ; color black ; line 0 198 400 198 ; line 2 198 2 10"
print #jf.g3, "cls ; backcolor yellow ; fill green ; goto 25 25 ; down ; circlefilled "; str$( int( 2 +delay /4000))
cp = 0
for future =0 to 200
cp =currentpop
call update5years 'display current situation
for d =0 to delay 'increase to delay each update
scan
next d
if future =0 then
notice "Just a notice!" + chr$(13) + "Holding start display." +chr$(13) +"Click to proceed!"
end if
century =int( cp /100) ' horizontal every 100 pop'n
print #jf.g2, "down ; size 1 ; color darkgray"
print #jf.g2, "line 0 "; str$( 200- 10 *century); " 400 "; str$( 200 -10 *century); "up"
call generation
scan
deltap =int( currentpop -cp) ' rate of growth
next future
[quit]
print #jf.g, "flush"
print #jf.g, "getbmp pyramid 1 1 399 219"
filedialog "Save pyramid as", "pyramid*.bmp", p$
if p$ <> "" then bmpsave "pyramid", p$
print #jf.g2, "flush"
print #jf.g2, "getbmp graph 1 1 399 203"
filedialog "Save graph as", "graph*.bmp", g$
if g$ <>"" then bmpsave "graph", g$
[out]
confirm "Are you ready to QUIT?"; rv$
'and if No??
close #jf
end
sub update5years
#jf.g, "cls"
'Add a routine to put on cohort ages, so the scale/ ages are obvious.
#jf.g5, "down ; font Times_New_Roman 7"
for m =0 to 95 step 5
#jf.g5, "goto 4 "; str$( int( 2.0 *( 100 -m) -5))
#jf.g5, "\"; str$( m)
next m
type =0
if deltap >10 then type = 1
if deltap <-10 then type =-1
select case type
case 1
#jf.g4 "fill green"
case -1
#jf.g4 "fill red"
case 0
#jf.g4 "fill white"
end select
if abs( ( future *5 /100) -int( future *5 /100)) <0.01 then ' vertical grid every 100 years
print #jf.g2, "down ; size 1 ; color darkgray ; line "; str$( future *2); " 10 "; str$( future *2); " 198"
end if
for cohort =0 to 19
print #jf.g, " down ; color "; str$( cohort/20 *255); " "; str$( cohort/20 *255); " 255"
print #jf.g, "line 210 "; str$( 210 -cohort *10); " "; str$( 210 +2* men( cohort)); " "; str$( 210 -cohort *10)
print #jf.g, "color 255 "; str$( cohort/20 *255); " "; str$( cohort/20 *255); " ; down"
print #jf.g, "line 190 "; str$( 210 -cohort *10); " "; str$( 190 -2*women( cohort)); " "; str$( 210 -cohort *10)
next cohort
end sub
sub generation
currentpop =0
for cohort =19 to 1 step -1 'each cohort moves up and some die
men( cohort) = men( cohort -1) *(100 -drm( cohort -1))/ 100
women( cohort) = women( cohort -1) *(100 -drw( cohort -1))/ 100
next cohort
men( 0) =0
women( 0) =0
for cohort =0 to 19 'and others are born
men( 0) = men( 0) +brm( cohort)/ 100 *women( cohort)
women( 0) =women( 0) +brw( cohort)/ 100 *women( cohort)
currentpop= currentpop +men( cohort) + women( cohort)
next cohort
print #jf.g2, "down ; size 2 ; color blue ; set "; str$( 4 +2 *future); " "; str$( 200 -int( currentpop /10))
print #jf.t2, 5 *( future +1); " years ahead. The population now is "; int( currentpop); " & change "; deltap
end sub
sub faster buttonhandle$
if delay >100 then delay =delay *0.8
print #jf.g3, "cls ; fill green ; goto 25 25 ; down ; circlefilled "; str$( 2 +int( delay /4000))
end sub
sub slower buttonhandle$
if delay <100000 then delay =delay *1.2
print #jf.g3, "cls ; fill red ; goto 25 25 ; down ; circlefilled "; str$( 2 +int( delay /4000))
end sub
sub war buttonhandle$ ' Modern war kills all ages, but especially men 15 to 30
for cohort =0 to 19
men( cohort) = men( cohort) *0.8
women( cohort) =women( cohort) *0.8
next cohort
for cohort =3 to 6
men( cohort) = men( cohort) *0.7
women( cohort) =women( cohort) *0.7
next cohort
end sub
sub famine buttonhandle$
men( 0) = men( 0) *0.1
men( 1) = men( 1) *0.2
women( 0) =women( 0) *0.05 ' girl babies are seen as less important!
women( 1) =women( 0) *0.1
for cohort =2 to 10 ' Parents try to feed children and starve themselves & the old
men( cohort) = men( cohort) *0.6
women( cohort) =women( cohort) *0.6
next cohort
for cohort =11 to 19
men( cohort) = men( cohort) *0.3
women( cohort) =women( cohort) *0.3
next cohort
end sub
sub boom buttonhandle$ ' all birth rates up 50%
for cohort =2 to 10
brm( cohort) =brm( cohort) *1.5
brw( cohort) =brw( cohort) *1.5
next cohort
end sub
sub over buttonhandle$ ' all birth rates down 50%
for cohort =2 to 10
brm( cohort) =brm( cohort) *0.67
brw( cohort) =brw( cohort) *0.67
next cohort
end sub
sub plague buttonhandle$ ' Hits old and young disproportionately
for cohort =0 to 4
men( cohort) = men( cohort) *0.5
women( cohort) =women( cohort) *0.5
next cohort
for cohort =5 to 12
men( cohort) = men( cohort) *0.8
women( cohort) =women( cohort) *0.8
next cohort
for cohort =13 to 19
men( cohort) = men( cohort) *0.5
women( cohort) =women( cohort) *0.5
next cohort