Plastic Proliferation: Spring, 2023

Microplastics Are Filling the Skies. Will They Affect the Climate?

YaleEnvironment360
By Nicola Jones • February 1, 2023

Source: Our World in Data based on Geyer et al. (2017) and the OECD Global Plastics Outlook

plastics={2000000,2000000,2000000,3000000,3000000,4000000,5000000,5000000,6000000,7000000,8000000,9000000,11000000,13000000,15000000,17000000,20000000,23000000,27000000,32000000,35000000,38000000,44000000,51000000,52000000,46000000,54000000,59000000,64000000,71000000,70000000,72000000,73000000,80000000,86000000,90000000,96000000,104000000,110000000,114000000,120000000,124000000,132000000,137000000,151000000,156000000,168000000,180000000,188000000,202000000,213000000,218000000,231000000,241000000,256000000,263000000,280000000,295000000,281000000,288000000,313000000,325000000,338000000,352000000,367000000,381000000,400050000,420052500,441055125,459745870};
years={1950,1951,1952,1953,1954,1955,1956,1957,1958,1959,1960,1961,1962,1963,1964,1965,1966,1967,1968,1969,1970,1971,1972,1973,1974,1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985,1986,1987,1988,1989,1990,1991,1992,1993,1994,1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019};
data = Transpose[{years,plastics}];
ndata=Length[years];

pp=ListLinePlot[Transpose[{years,plastics/10^6}],PlotLabel->"Global Plastics Production",AxesLabel->{"year","Million Tons"}]

nlm=NonlinearModelFit[data,Exp[a+b*(x-1950)]+c,{a,b,c},x]
fit[x_]=Normal[nlm]
fit[x]
plot=Plot[fit[x]/10^6,{x,1950,2020},PlotStyle->Black,AxesLabel->{"year","Million Tons"}];
Show[pp,plot]

forwardPlastic=plastics[[2;;ndata]];
backwardPlastic=plastics[[1;;(ndata-1)]];
forwardYears=years[[2;;ndata]];
backwardYears=years[[1;;(ndata-1)]];
forwardDiffs=(forwardPlastic-backwardPlastic)/(forwardYears-backwardYears);
pf=ListLinePlot[Transpose[{backwardYears,forwardDiffs}],PlotRange->All,PlotLabel->"Forward Difference Derivative Approximations"]

centeredDiffs =(Rest[ forwardDiffs]+Most[forwardDiffs])/2.0;
centeredYears = Most[Rest[years]];
pc=ListLinePlot[Transpose[{centeredYears,centeredDiffs}],PlotRange->All,PlotLabel->"Centered Difference Derivative Approximations"]

dplot=Plot[fit'[x],{x,1950,2020},PlotStyle->Black,PlotLabel->"Model Derivative Approximations"]
Show[pf,pc,dplot,PlotLabel->"Various Derivative Approximations"]