Lab 5- Geometric and Exponential Population Growth: Gabriela Krochmal
R Script
worldBank <- read.csv( "C:\\Users\\Gabriela Krochmal\\Downloads\\worldbank.csv")
library(reshape)
library(ggplot2)
worldBank$bt <- worldBank$crudeBirthRate / 1000 #creating a new column for bt
worldBank$dt <- worldBank$crudeDeathRate / 1000 #creating a new column for dt
worldBank$Expectedbirths <- worldBank$bt * worldBank$totalPopulation
worldBank$Expecteddeaths <- worldBank$dt * worldBank$totalPopulation
worldBank$R <- worldBank$bt - worldBank$dt
worldBank$lambda <- worldBank$R + 1
worldBank## country year crudeBirthRate crudeDeathRate totalPopulation
## 1 Bulgaria 1985 13.3 12.0 8960547
## 2 Bulgaria 1995 8.6 13.6 8406067
## 3 Bulgaria 2005 9.3 14.8 7658972
## 4 Bulgaria 2015 9.2 15.3 7177991
## 5 Mali 1985 48.9 22.4 7831889
## 6 Mali 1995 48.8 20.0 9604450
## 7 Mali 2005 48.4 15.0 12798763
## 8 Mali 2015 43.2 11.0 17467905
## 9 Italy 1985 10.2 9.7 56593071
## 10 Italy 1995 9.2 9.8 56884303
## 11 Italy 2005 9.6 9.8 57969484
## 12 Italy 2015 8.0 10.7 60730582
## Expecteddeaths Expectedbirths bt dt R lambda
## 1 107526.6 119175.28 0.0133 0.0120 0.0013 1.0013
## 2 114322.5 72292.18 0.0086 0.0136 -0.0050 0.9950
## 3 113352.8 71228.44 0.0093 0.0148 -0.0055 0.9945
## 4 109823.3 66037.52 0.0092 0.0153 -0.0061 0.9939
## 5 175434.3 382979.37 0.0489 0.0224 0.0265 1.0265
## 6 192089.0 468697.16 0.0488 0.0200 0.0288 1.0288
## 7 191981.4 619460.13 0.0484 0.0150 0.0334 1.0334
## 8 192147.0 754613.50 0.0432 0.0110 0.0322 1.0322
## 9 548952.8 577249.32 0.0102 0.0097 0.0005 1.0005
## 10 557466.2 523335.59 0.0092 0.0098 -0.0006 0.9994
## 11 568100.9 556507.05 0.0096 0.0098 -0.0002 0.9998
## 12 649817.2 485844.66 0.0080 0.0107 -0.0027 0.9973options(digits=3) #limits to 3 decimal places in the output
#My data.frame object is named worldBank
#Create long-form data
worldBankLong <- melt(worldBank, id= c("country", "year"))
head(worldBankLong)## country year variable value
## 1 Bulgaria 1985 crudeBirthRate 13.3
## 2 Bulgaria 1995 crudeBirthRate 8.6
## 3 Bulgaria 2005 crudeBirthRate 9.3
## 4 Bulgaria 2015 crudeBirthRate 9.2
## 5 Mali 1985 crudeBirthRate 48.9
## 6 Mali 1995 crudeBirthRate 48.8str(worldBank)## 'data.frame': 12 obs. of 11 variables:
## $ country : Factor w/ 3 levels "Bulgaria","Italy",..: 1 1 1 1 3 3 3 3 2 2 ...
## $ year : int 1985 1995 2005 2015 1985 1995 2005 2015 1985 1995 ...
## $ crudeBirthRate : num 13.3 8.6 9.3 9.2 48.9 48.8 48.4 43.2 10.2 9.2 ...
## $ crudeDeathRate : num 12 13.6 14.8 15.3 22.4 20 15 11 9.7 9.8 ...
## $ totalPopulation: num 8960547 8406067 7658972 7177991 7831889 ...
## $ Expecteddeaths : num 107527 114323 113353 109823 175434 ...
## $ Expectedbirths : num 119175 72292 71228 66038 382979 ...
## $ bt : num 0.0133 0.0086 0.0093 0.0092 0.0489 0.0488 0.0484 0.0432 0.0102 0.0092 ...
## $ dt : num 0.012 0.0136 0.0148 0.0153 0.0224 0.02 0.015 0.011 0.0097 0.0098 ...
## $ R : num 0.0013 -0.005 -0.0055 -0.0061 0.0265 ...
## $ lambda : num 1.001 0.995 0.995 0.994 1.026 ...worldBankGraph <- subset(worldBankLong, variable == "bt" | variable=="dt")
worldBankGraph <- droplevels(worldBankGraph) #removes levels with zero
summary(worldBankGraph)## country year variable value
## Bulgaria:8 Min. :1985 bt:12 Min. :0.0080
## Italy :8 1st Qu.:1992 dt:12 1st Qu.:0.0097
## Mali :8 Median :2000 Median :0.0115
## Mean :2000 Mean :0.0180
## 3rd Qu.:2008 3rd Qu.:0.0165
## Max. :2015 Max. :0.0489p <- ggplot(worldBankGraph, aes(x=year, y=value, color=variable))
p+ theme_classic() +
facet_grid(. ~ country) +
geom_line()
geom_point()## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityhead(worldBank)## country year crudeBirthRate crudeDeathRate totalPopulation
## 1 Bulgaria 1985 13.3 12.0 8960547
## 2 Bulgaria 1995 8.6 13.6 8406067
## 3 Bulgaria 2005 9.3 14.8 7658972
## 4 Bulgaria 2015 9.2 15.3 7177991
## 5 Mali 1985 48.9 22.4 7831889
## 6 Mali 1995 48.8 20.0 9604450
## Expecteddeaths Expectedbirths bt dt R lambda
## 1 107527 119175 0.0133 0.0120 0.0013 1.001
## 2 114323 72292 0.0086 0.0136 -0.0050 0.995
## 3 113353 71228 0.0093 0.0148 -0.0055 0.995
## 4 109823 66038 0.0092 0.0153 -0.0061 0.994
## 5 175434 382979 0.0489 0.0224 0.0265 1.026
## 6 192089 468697 0.0488 0.0200 0.0288 1.029#create a more managable dataframe
model <- worldBank[, c("country", "year", "totalPopulation", "lambda")]
model## country year totalPopulation lambda
## 1 Bulgaria 1985 8960547 1.001
## 2 Bulgaria 1995 8406067 0.995
## 3 Bulgaria 2005 7658972 0.995
## 4 Bulgaria 2015 7177991 0.994
## 5 Mali 1985 7831889 1.026
## 6 Mali 1995 9604450 1.029
## 7 Mali 2005 12798763 1.033
## 8 Mali 2015 17467905 1.032
## 9 Italy 1985 56593071 1.000
## 10 Italy 1995 56884303 0.999
## 11 Italy 2005 57969484 1.000
## 12 Italy 2015 60730582 0.997#model growth: fill in these values for your country
lambda <- 1.000 #lambda at time zero
timeInterval_t <- 30 #time steps to 2015 (years)
No <- 56593071 #population size at time zero
actualPopSize <- 60730582 #actual 2015 population size
#Geometric growth model
Nt <- No * (lambda ^ timeInterval_t)
#Percent error for your estimate
((Nt - actualPopSize) / actualPopSize) * 100## [1] -6.81worldBank## country year crudeBirthRate crudeDeathRate totalPopulation
## 1 Bulgaria 1985 13.3 12.0 8960547
## 2 Bulgaria 1995 8.6 13.6 8406067
## 3 Bulgaria 2005 9.3 14.8 7658972
## 4 Bulgaria 2015 9.2 15.3 7177991
## 5 Mali 1985 48.9 22.4 7831889
## 6 Mali 1995 48.8 20.0 9604450
## 7 Mali 2005 48.4 15.0 12798763
## 8 Mali 2015 43.2 11.0 17467905
## 9 Italy 1985 10.2 9.7 56593071
## 10 Italy 1995 9.2 9.8 56884303
## 11 Italy 2005 9.6 9.8 57969484
## 12 Italy 2015 8.0 10.7 60730582
## Expecteddeaths Expectedbirths bt dt R lambda
## 1 107527 119175 0.0133 0.0120 0.0013 1.001
## 2 114323 72292 0.0086 0.0136 -0.0050 0.995
## 3 113353 71228 0.0093 0.0148 -0.0055 0.995
## 4 109823 66038 0.0092 0.0153 -0.0061 0.994
## 5 175434 382979 0.0489 0.0224 0.0265 1.026
## 6 192089 468697 0.0488 0.0200 0.0288 1.029
## 7 191981 619460 0.0484 0.0150 0.0334 1.033
## 8 192147 754613 0.0432 0.0110 0.0322 1.032
## 9 548953 577249 0.0102 0.0097 0.0005 1.000
## 10 557466 523336 0.0092 0.0098 -0.0006 0.999
## 11 568101 556507 0.0096 0.0098 -0.0002 1.000
## 12 649817 485845 0.0080 0.0107 -0.0027 0.997#Input variables
No <- 100 #inital population size
R <- 0.8 #geometric growth rate
lambda <- R + 1 #calculate lambda (geometric)
r <- 0.8 #continuous growth rate
K <- 50000 #carrying capacity
#build the data frame
comparison <- data.frame(t=0:10)
head(comparison)## t
## 1 0
## 2 1
## 3 2
## 4 3
## 5 4
## 6 5#calculates pop size(geomNt) for the geometric model
comparison$geomNt <- No * (lambda ^ comparison$t)
#calculates pop size(expNT) for the continuous model
comparison$expNT <- No * exp(r * comparison$t)
#calculates pop size(logNt) with carrying capacity for the continuous model
comparison$logNt <- K / (1 + ((K - No)/ No) * exp(-r * comparison$t))
#graphing the data
#long form data
comparisonGraphLong <- melt(comparison, id= c("t"))
comparisonGraph <- subset(comparisonGraphLong, variable == "expNt" | variable== "geomNt")
#plot the data
p <- ggplot(comparisonGraph, aes(x=t, y=value, color=variable))
p+theme_classic() +
geom_line() +
geom_point()
Question 1
Plants and insects are other organisms that follow a geometric growth rate. These organisms typically only live for a single year and reproduce once before dying. The advantages of this kind of growth are that they can reproduce quickly and create many individuals at once. Because of this they don’t have a smooth population curve, it is typically steep step. The disadvantages can be that they die quickly and if there are stress on their larvae or seeds like depredation the populations could start decreasing.
Question 2
For calculating Bt and Dt if you only have per capita rates (bt & dt) and population size at time t, you can use the following equations
Per capita birth rate bt * Nt = Bt
Per capita death rate dt * Nt= Dt
Question 3
Observations I have about my calculated data for Bulgaria is that in the more recent year of 2015 there were more expected deaths than expected births. Mali has more expected births than expected deaths. Lastly, Italy has more expected deaths than expected births. I found this interesting because it makes me think differently about population growth when certain countries actually have more expected deaths than births. I wonder if the increasing deaths is because of the toxins and pollutants we are increasingly being exposed to.
Question 4
#Summary of my Expected Birth and Death Rates
worldBank## country year crudeBirthRate crudeDeathRate totalPopulation
## 1 Bulgaria 1985 13.3 12.0 8960547
## 2 Bulgaria 1995 8.6 13.6 8406067
## 3 Bulgaria 2005 9.3 14.8 7658972
## 4 Bulgaria 2015 9.2 15.3 7177991
## 5 Mali 1985 48.9 22.4 7831889
## 6 Mali 1995 48.8 20.0 9604450
## 7 Mali 2005 48.4 15.0 12798763
## 8 Mali 2015 43.2 11.0 17467905
## 9 Italy 1985 10.2 9.7 56593071
## 10 Italy 1995 9.2 9.8 56884303
## 11 Italy 2005 9.6 9.8 57969484
## 12 Italy 2015 8.0 10.7 60730582
## Expecteddeaths Expectedbirths bt dt R lambda
## 1 107527 119175 0.0133 0.0120 0.0013 1.001
## 2 114323 72292 0.0086 0.0136 -0.0050 0.995
## 3 113353 71228 0.0093 0.0148 -0.0055 0.995
## 4 109823 66038 0.0092 0.0153 -0.0061 0.994
## 5 175434 382979 0.0489 0.0224 0.0265 1.026
## 6 192089 468697 0.0488 0.0200 0.0288 1.029
## 7 191981 619460 0.0484 0.0150 0.0334 1.033
## 8 192147 754613 0.0432 0.0110 0.0322 1.032
## 9 548953 577249 0.0102 0.0097 0.0005 1.000
## 10 557466 523336 0.0092 0.0098 -0.0006 0.999
## 11 568101 556507 0.0096 0.0098 -0.0002 1.000
## 12 649817 485845 0.0080 0.0107 -0.0027 0.997#I compared my expected birth and death rates in 2015 to the ones that were listed on Wikipedia. The calculated crude birth rates for Bulgaria were very similar with a 0.2 difference, while the crude death rates were also very similar with a 0.2 difference as well. The calculated birth rates for Mali were exactly the same with a 43.2 birth rate, while the death rate had a difference of 1.4. The calculated birth rates for Italy were close with just a 0.1 difference and death rates were exactly the same at 10.7. I am surprised at how close my calculated ones were with the actual ones listed on Wikipedia. Question 5
worldBankGraph <- subset(worldBankLong, variable == "bt" | variable=="dt")
worldBankGraph <- droplevels(worldBankGraph) #removes levels with zero
summary(worldBankGraph)## country year variable value
## Bulgaria:8 Min. :1985 bt:12 Min. :0.0080
## Italy :8 1st Qu.:1992 dt:12 1st Qu.:0.0097
## Mali :8 Median :2000 Median :0.0115
## Mean :2000 Mean :0.0180
## 3rd Qu.:2008 3rd Qu.:0.0165
## Max. :2015 Max. :0.0489p <- ggplot(worldBankGraph, aes(x=year, y=value, color=variable))
p+ theme_classic() +
facet_grid(. ~ country) +
geom_line()GG Plot of bt versus dt
geom_point()## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityworldBankGraph2 <- subset(worldBankLong, variable == "Expectedbirths" | variable == "Expecteddeaths")
worldBankGraph2 <- droplevels(worldBankGraph2) #removes levels with zero
summary(worldBankGraph2)## country year variable value
## Bulgaria:8 Min. :1985 Expecteddeaths:12 Min. : 66038
## Italy :8 1st Qu.:1992 Expectedbirths:12 1st Qu.:114080
## Mali :8 Median :2000 Median :287563
## Mean :2000 Mean :342435
## 3rd Qu.:2008 3rd Qu.:556747
## Max. :2015 Max. :754613p2 <- ggplot(worldBankGraph2, aes(x=year, y=value, color=variable))
p2 + theme_classic() +
facet_grid(. ~ country) +
geom_line()
GG Plot of Expected Births versus Expected Deaths
geom_point()## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityworldBankGraph3 <- subset(worldBankLong, variable == "totalPopulation")
worldBankGraph3 <- droplevels(worldBankGraph3) #removes levels with zero
summary(worldBankGraph3)## country year variable value
## Bulgaria:4 Min. :1985 totalPopulation:12 Min. : 7177991
## Italy :4 1st Qu.:1992 1st Qu.: 8262522
## Mali :4 Median :2000 Median :11201606
## Mean :2000 Mean :26007002
## 3rd Qu.:2008 3rd Qu.:56665879
## Max. :2015 Max. :60730582p3 <- ggplot(worldBankGraph3, aes(x=year, y=value, color=variable))
p3 + theme_classic() +
facet_grid(. ~ country) +
geom_line()
GG Plot of Total Population
geom_point()## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityworldBankGraph4 <- subset(worldBankLong, variable == "lambda")
worldBankGraph4 <- droplevels(worldBankGraph4) #removes levels with zero
summary(worldBankGraph4)## country year variable value
## Bulgaria:4 Min. :1985 lambda:12 Min. :0.994
## Italy :4 1st Qu.:1992 1st Qu.:0.997
## Mali :4 Median :2000 Median :1.000
## Mean :2000 Mean :1.009
## 3rd Qu.:2008 3rd Qu.:1.027
## Max. :2015 Max. :1.033p4 <- ggplot(worldBankGraph4, aes(x=year, y=value, color=variable))
p4 + theme_classic() +
facet_grid(. ~ country) +
geom_line()
GG Plot of Lambda
geom_point()## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityWhen comparing the the expected births and death each country differed from each other alto. In Bulgaria there is a steady line for expected deaths with a decrease in births. Italy had a sharp increase in the expected deaths at the same time there was a sharp decrease in the number of births. Mali seems to be the odd one out of the 3 countries because its expected births is skyrocketing, while deaths are at a relate flat line.For total population Bulgaria has the smallest and it is decreasing, while Italy has the largest and it increasing. Lastly, Mali has an increasing population rate that is a bit larger than Bulgaria’s.
Question 6
Percent Error for Mali -1.45 Percent Error for Bulgaria 28.6 Percent Error for Italy -6.81
These values do differ in accuracy. Mali and Italy had negative percent values which means that they had a low estimate of what the population would be, while the actual population size was greater than the estimate. Bulgaria had a positive percent error which means that they estimated a larger population than there actually was.
Question 7
Three reasons per capita birth and death rates could possibility change over time are that there could be an atomic bomb that destroys half of the world, there could be new improvements in medicine and technology that decreases the infant mortality rate. There is also the chance that birth rates can decrease because people don’t have the finical stability to have kids or don’t have the desire. Deaths could also increase because of exposure to harmful chemicals in our environment that lead to increased cancers and diseases.
Question 8
Two organisms that have continuous population growth are E. coli and bunnies. However, they must have proper conditions and enough resources to do so. If not, they will hit carrying capacity.
Question 9
Exponential growth would increase faster because there is constant reproduction throughout the organisms life (thinking of bacteria), if the conditions are right. This is ecologically significant in terms of endangered species because if only the endangered species were able to reproduce so quickly then they wouldn’t be endangered and it wouldn’t take long to reestablish its population. This is ecologically significant in terms of invasive species because if they are growing exponentially they can take over a whole ecosystem and thrive while taking resources away from native vegetation.
Question 10
There is a large difference between the geomNt population growth to the expNt population growth. It looks like the geomNt increases in fragments, while the expNt doubles its number each point along the line.
#Input variables
No <- 100 #inital population size
R <- 0.8 #geometric growth rate
lambda <- R + 1 #calculate lambda (geometric)
r <- 0.8 #continuous growth rate
K <- 50000 #carrying capacity
#build the data frame
comparison <- data.frame(t=0:10)
head(comparison)## t
## 1 0
## 2 1
## 3 2
## 4 3
## 5 4
## 6 5#calculates pop size(geomNt) for the geometric model
comparison$geomNt <- No * (lambda ^ comparison$t)
#calculates pop size(expNT) for the continuous model
comparison$expNT <- No * exp(r * comparison$t)
#calculates pop size(logNt) with carrying capacity for the continuous model
comparison$logNt <- K / (1 + ((K - No)/ No) * exp(-r * comparison$t))
#graphing the data
#long form data
comparisonGraphLong <- melt(comparison, id= c("t"))
comparisonGraph <- subset(comparisonGraphLong, variable == "expNt" | variable == "geomNt")
#plot the data
p <- ggplot(comparisonGraph, aes(x=t, y=value, color=variable))
p+theme_classic() +
geom_line() +
geom_point()
head(comparison)## t geomNt expNT logNt
## 1 0 100 100 100
## 2 1 180 223 222
## 3 2 324 495 491
## 4 3 583 1102 1081
## 5 4 1050 2453 2343
## 6 5 1890 5460 4931Question 11
Comparing the logNt population growth to the expNt population growth they are very similar. There is only a slight different in the data points.