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