################################################################################### ### Exponential and Quadratic Polynomial fit to selected world Population Data ### Produced by Thomas J. Pfaff for sustainabilitymath.org ### March 2023 ################################################################################### ## URL for the data from sustainabilitymath.org dataURL<-"http://sustainabilitymath.org/excel/World-Population-R.csv" ## Read data from online csv file Data <-read.csv(url(dataURL),header=TRUE) Data ## Define x and y, mostly to save typing xa<-0 xb<-80 ya<-0 yb<-10 x<-Data$Years.since.1950 y<-Data$Population.in.Billions xname<-"Years after 1950" yname<-"Billions of People" GraphTitle<-"World Population" ######################################## ###### Graphs for Word Document ######## ######################################## ## Define some graphing parameters d<-1.25 #dot size 2.25 for webgraph, 1.25 for document l<-2 #line width 5 for webgraph, 2 for document ## Create Plot windows(width=7,height=7) plot(x, y ,type="p", cex=d, pch=10, xlim=c(xa,xb), ylim=c(ya,yb), xlab=xname, ylab=yname, col="black") title(main=GraphTitle) grid (NULL,NULL, lty = 6, col = "gray") mtext("Thomas J. Pfaff || sustainabilitymath.org",1,4,adj=1) ## Create Quadratic fit and add to plot Quad<-lm(y~x+I(x^2)) summary(Quad) Quad.Coef<-coef(Quad) p<-function(x){Quad.Coef[[1]] + Quad.Coef[[2]]*x +Quad.Coef[[3]]*x^2} curve(p, xa,xb, col="red", lwd=l, add=TRUE) ## Function options(digits=10) paste(Quad.Coef[[1]]," + ",Quad.Coef[[2]],"x +",Quad.Coef[[3]],"x^2",sep="") ## Exponentail fit and add to plot Exp<-lm(log(y) ~ x) summary(fit) Exp.Coef<-coef(Exp) World.Exp<-function(x){ exp(Exp.Coef[[1]])*exp(Exp.Coef[[2]]*x)} curve(World.Exp, xa,xb, col="blue", lwd=l, add=TRUE) ## Layer points again points(x, y ,type="p", cex=d, pch=10,col="black") ## Function options(digits=10) paste(exp(Exp.Coef[[1]]),"exp(",Exp.Coef[[2]],"*x)",sep="") ########################################################## ###### Graphs for Web Document ######## ########################################################## ## Define some graphing parameters d<-2.25 #dot size 2.25 for webgraph, 1.25 for document l<-5 #line width 5 for webgraph, 2 for document ## Create Plot windows(width=7,height=7) par(bg = "#b3c0d7") #Blue background for webgraph. plot(x, y ,type="p", cex=d, pch=10, xlim=c(xa,xb), ylim=c(ya,yb), xlab=xname, ylab=yname, col="black") title(main=GraphTitle) grid (NULL,NULL, lty = 6, col = "gray") mtext("Thomas J. Pfaff || sustainabilitymath.org",1,4,adj=1) ## Create Quadratic fit and add to plot Quad<-lm(y~x+I(x^2)) summary(Quad) Quad.Coef<-coef(Quad) p<-function(x){Quad.Coef[[1]] + Quad.Coef[[2]]*x +Quad.Coef[[3]]*x^2} curve(p, xa,xb, col="red", lwd=l, add=TRUE) ## Exponentail fit and add to plot Exp<-lm(log(y) ~ x) summary(fit) Exp.Coef<-coef(Exp) World.Exp<-function(x){ exp(Exp.Coef[[1]])*exp(Exp.Coef[[2]]*x)} curve(World.Exp, xa,xb, col="blue", lwd=l, add=TRUE) ## Layer points again points(x, y ,type="p", cex=d, pch=10,col="black")