#Copyright ©, 2020, Technische Universität Berlin, Chair of Circular Economy and Recycling Technology, Paul Martin Mählitz #**************************************************************************************************************** ##### ******* TABLE OF CONTENT ******* ###### #**************************************************************************************************************** #load packages #read data set from .csv #extract code lists from dataframe #define parameters, colors, etc. #Dataframe: descriptive statistics for battery mass share (BMS) per UNUkey-BATTkey #Bootstrap simulation and bootstrap confidence interval #MSS-NPA: Minimum Sample Size Nonparamtetric approach #Figure 1: Nonparametric approach (NPA) to approximate the minimum sample size with data-driven simulations. a) Simulated bootstrap population, b) sub-sampling from datasets with increasing sample size and 1,000 repetitions, c) coverage of sub-sample results in percent lying within the population 95% CI*.---- #Figure 2: The proportion of WEEE devices (UNUkeys) with and without battery compartment (a) and proportion of WEEE with a battery compartment in which batteries remained or were missing (b). ---- #Figure 3: Battery mass (a), battery mass share (b), and WEEE mass (c) differentiated according to their chemical systems (BATTkey). ---- #Figure 4: Appearance and count of battery types (BATTkeys) in UNUkeys. ---- #Figure 5: Mass (a) and mass share (b) of batteries remained in WEEE classified as UNUkeys and distinguished by their chemical system (BATTkey). ---- #Figure 6: Histogram and density distribution for the battery mass share (BMS) of LiRecharge and NiMH for mobile phones UNUkey 0306. Original data (a, d), log-transformed data (b, e), and bootstrap sample means with B=5,000 (c, f). ---- #Figure 7: NPA: Simulation of the minimum number of samples with bootstrap samples. The proportion of sub-samples within the 95% CI* based on 1,000 bootstrap samples (y-axis) with an increasing number of samples n (x-axis). A coverage of 90% is considered acceptable to achieve representable results with the given sample size (dashed line) #**************************************************************************************************************** ##### ******* R SCRIPT ******* ###### #**************************************************************************************************************** #---- load packages ---- library("dplyr", lib.loc="~/R/win-library/3.5") library("ggplot2", lib.loc="~/R/win-library/3.5") library("ggthemes", lib.loc="~/R/win-library/3.5") library("ggpubr") #Publication Ready Plots, http://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/ library("patternplot", lib.loc="~/R/win-library/3.5.3") # https://cran.r-project.org/web/packages/patternplot/ library("Hmisc", lib.loc="~/R/win-library/3.5") library("readxl", lib.loc="~/R/win-library/3.5")#excel datein einlesen library("stats", lib.loc="C:/Program Files/R/R-3.5.2/library") library("GGally", lib.loc="~/R/win-library/3.5") library("scales", lib.loc="~/R/win-library/3.5")#logarithm. Skalen: to access break formatting functions library("e1071", lib.loc="~/R/win-library/3.5")#calculation skewness and kurtosis kurtosis(), library("outliers", lib.loc="~/R/win-library/3.5")#Grubbs Outlier test library(readr) #---- read data set from .csv ---- df.WEEE.BATT <- read_csv("SI.samplingRawData.subKey-level.csv")#load sampling data file df.WEEEwBATT.remained <- df[df$batteryDriven=="wBATT"& # define dataframe for WEEE with battery compartment and battery remaining df$battRemoved=="No",] df_BATTshare <- read_csv("SI.BATTmassShare.UNUKey-level.csv")#load file with battery share data per UNUkey #----extract code lists from dataframe ---- UNUkey <- unique(na.omit(df$UNUkey))#UNU keys subKey <- unique(na.omit(df$subKey))#UNU subKeys EU-10 <- unique(na.omit(df$EU-10))#WEEE category according to WEEE Directive 2012/19/EC Annex III BATTkey <- unique(na.omit(df$BATTkey))#Battery keys #----define parameters, colors, etc. ----- #gridnet for logarithmic scales in plots breaks <- 10^(-10:10)#defines gridnet breaks for logarithmic axis minor_breaks <- rep(1:9, 21)*(10^rep(-10:10, each=9))#https://stackoverflow.com/questions/28709331/logarithmic-grid-for-plot-with-ggplot2 #**************************************************************************************************************** ##### ******* Descriptive statistics, Bootstrapping, Minimum sample size ******* ###### #**************************************************************************************************************** #------------------------------------------------------------------------------------------ #----Dataframe: descriptive statistics for battery mass share (BMS) per UNUkey-BATTkey ---- #------------------------------------------------------------------------------------------ #Explanation: Claulation o descriptives statics for all combinations of UNUkeys and BATTkeys in a for-loop #create dataframe tbl_BMS_UNUkey <- data.frame(matrix(vector(), 0, 18, dimnames=list(c(), c("UNUkey",#UNUkey 0xxx "BATTkey",#battery key "n_BATT",#count of batteries "mean",#arithmetic mean of BMS "median",# median of BATTmassShare "SD",#standard deviation assuming normal distribution "VC",#coefficient of variation "MAD",#median absolute deviation "q2.5",#2.5th quantile "q97.5",#97.5th quantile "skew",#skewness (e1071). Negative values for kurtosis and skewness mean thin-tailed and left-skewed distributions, whereas positive values stand for fat-tailed and right-skewed "kurt",#kurtosis (e1071). "p",# original data, p-value of Shapiro Wilk test "ND",#original data, normally distributed data Y/N "log.p",#log-transformed, p-value of Shapiro Wilk test "log.ND",#log-transformed, normally distributed data Y/N "log.skew",#skewness "log.kurt"#kurtosis )))) tbl.BATTkey.BMS.descrStat#show tbl in console j=1#set counter to 1 #create for-loop for (k in UNUkey){#for each k in the vector "UNUkey" repeat the following loop commands for(bk in BATTkey){#for each Battery Key bk in the vector BATTkey, repeat the following command BMS <- na.omit(df.WEEE.BATT$BATTmassShare[df.WEEE.BATT$key== k&#select battery mass share BMS for respective k and bk df.WEEE.BATT$BATTkey==bk]) log.BMS <- log10(BMS)#log-transformation tbl_BMS_UNUkey[j,"UNUkey"] <- print(k)#print in tbl tbl_BMS_UNUkey[j,"BATTkey"] <- print(bk)#print in tbl tbl_BMS_UNUkey[j,"n_BATT"] <- length(na.omit(BMS))#calculate length of vector (equals number of observations) if (length(na.omit(BMS)) > 3 & sum(na.omit(BMS)) > 0){#number of non-missing values must be between 3 and 5000 tbl_BMS_UNUkey[j,"mean"] <- round(mean(BMS, na.rm=T), digits=2)#calcualte arithmetic mean tbl_BMS_UNUkey[j,"median"] <- round(median(BMS, na.rm=T), digits=2)#calulate median tbl_BMS_UNUkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2)#calcualte standard deviation tbl_BMS_UNUkey[j,"MAD"] <- round(mad(BMS, na.rm=T), digits=2)#calculate median absolute deviation MAD tbl_BMS_UNUkey[j,"q2.5"] <- round(quantile(BMS, 0.025, na.rm=T), digits=2)#2.5th quantile tbl_BMS_UNUkey[j,"q97.5"] <- round(quantile(BMS, 0.975, na.rm=T), digits=2)#97.5th quantile tbl_BMS_UNUkey[j,"skew"] <- round(skewness(BMS, na.rm=T), digits=2)#skewness tbl_BMS_UNUkey[j,"kurt"] <- round(kurtosis(BMS, na.rm=T), digits=2)#kurtosis o.sw <- shapiro.test(na.omit(BMS))#Shapiro Wilk test on orignal data log.sw <- shapiro.test(na.omit(log.BMS))#Shapiro Wilk test on log-transformed data tbl_BMS_UNUkey[j,"log.skew"] <- round(skewness(log.BMS, na.rm=T), digits=2)#skewness of log-transformed data tbl_BMS_UNUkey[j,"log.kurt"] <- round(kurtosis(log.BMS, na.rm=T), digits=2)#kurtosis of log-transformed data tbl_BMS_UNUkey[j, "p"] <- round(o.sw$p.value, digits=3)#print p-value of Shaprio-Wilok test of original data tbl_BMS_UNUkey[j, "ND"] <- if (o.sw$p.value < 0.05){print("No")} else {print("Yes")}#if p <0.05, not normally distributed tbl_BMS_UNUkey[j, "log.p"] <- round(log.sw$p.value, digits=3)#print p-value of Shaprio-Wilok test of log-transformed data tbl_BMS_UNUkey[j, "log.ND"] <- if (log.sw$p.value < 0.05){print("No")} else {print("Yes")}#if p <0.05, not normally distributed }else{ tbl_BMS_UNUkey[j, "n_BATT"] <- length(na.omit(BMS))#print length of vector to allow later selction of n>=3 } j=j+1 }} tbl_BMS_UNUkey <- tbl_BMS_UNUkey[tbl_BMS_UNUkey$n_BATT>3,]#select all rows with n_BATT > 3 View(tbl_BMS_UNUkey)#show tbl write.csv(tbl_BMS_UNUkey,file="BMS_BATTkey_UNUkey_descriptiveStatistics.csv", row.names = FALSE)#save results in csv file #------------------------------------------------------------------------------------------ #---- Bootstrap simulation and bootstrap confidence interval ---- #------------------------------------------------------------------------------------------ #bootstrap simulation from original data file. Example of battery mass share (BMS). The simulation can be adapted for other characteristics like WEEE mass (mass) oder battery mass (BATTmass) #create table with headings to store bootstrap data tbl.bootstrap.BMS.UNUkey.BATTkey <- data.frame(matrix(vector(), 0, 15,dimnames=list(c(), #colnames(Ergebnis.df) <- c("element", "sample", "prep", "det", "t", "p", "mean_diff", "mean_diff_rel") c("UNUkey", "BATTkey", #UNUkey 0xxx "B", "n", "m", "SD", "md", "MAD", "CI_2.5", "CI_97.5", "boot.m", #mean "boot.SD", "boot.md",#median "boot.CI_2.5", "boot.CI_97.5" )))) tbl.bootstrap.BMS.UNUkey.BATTkey #show table headings in console j=1 #set iteration j to 1 nboot = 5000 #set repetitions B to 5,000 for (u in UNUkey){#outer loop for UNUkeys for (bk in BATTkey){#inner loop for battery keys BMS <- na.omit(df.WEEE.BATT$BATTmassShare[df.WEEE.BATT$UNUkey == u&#UNU key df.WEEE.BATT$BATTkey==bk])#BMS = battery mass share n <- length(na.omit(BMS))#calculate number of observations in data vector if (n > 0 & mean(BMS)>0){#check length of vector > 0 and whether all values are 0 (mean >0?) for(B in 1:nboot){#start bootstrapping with B repetitions tbl.bootstrap.BMS.UNUkey.BATTkey[j,"BATTkey"] <- print(bk)#print battery key tbl.bootstrap.BMS.UNUkey.BATTkey[j,"UNUkey"] <- print(u)#print UNU key tbl.bootstrap.BMS.UNUkey.BATTkey[j,"B"] <- print(B)#print repetition number tbl.bootstrap.BMS.UNUkey.BATTkey[j,"n"] <- n#print lengh of vector tbl.bootstrap.BMS.UNUkey.BATTkey[j,"m"] <- round(mean(BMS, na.rm=T), digits=2)#calculate arithmetic mean tbl.bootstrap.BMS.UNUkey.BATTkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2)#calculate standard deviation tbl.bootstrap.BMS.UNUkey.BATTkey[j,"md"] <- round(median(BMS, na.rm = T), digits=2)#calculate median tbl.bootstrap.BMS.UNUkey.BATTkey[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2)#calculate median absolute deviation tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2)#2.5% quantile tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2)#97.5% quantile j=j+1 } } else { tbl.bootstrap.BMS.UNUkey.BATTkey[j, "B"] <- print("notEnoughData")#print "not enough data" in case of too few datapoints } j=j+1 }} tbl.bootstrap.BMS.UNUkey.BATTkey_min15 <- tbl.bootstrap.BMS.UNUkey.BATTkey[tbl.bootstrap.BMS.UNUkey.BATTkey$n>14,]#select all conbinations of UNUkey-BATTkey with at leaste 15 data points in the original dataset write.csv(tbl.bootstrap.BMS.UNUkey.BATTkey_min15, file="tbl.bootstrap.BMS.UNUkey.BATTkey_min15.csv", row.names = FALSE)#save file as csv #------------------------------------------------------------------------------------------ #---- MSS-NPA: Minimum Sample Size Nonparamtetric approach ---- #------------------------------------------------------------------------------------------ #Bootstrapping was used to resample from the original dataset randomly but with smaller sample numbers starting from ni = 5 and increasing ni to the original number of samples norig. For each subsample of ni, 1,000 subsamples (B=1,000) were drawn, and the arithmetic mean (bootstrap mean x_i^*) was calculated . #Further, we checked whether each bootstrap mean x_i^* lies within the 95% CI* of the simulated population distribution. The proportion of 1,000 bootstrap means x_i^* per ni within the 95% CI* was defined as “coverage”. #create table with headings tbl.minN.BMS.BATTkey.UNUkey <- data.frame(matrix(vector(), 0, 12, dimnames=list(c(), #colnames(Ergebnis.df) <- c("element", "sample", "prep", "det", "t", "p", "mean_diff", "mean_diff_rel") c("UNUkey",#UNUkey "BATTkey", #Battery key "B",#number of bootstrap repetitions "n",#number of observations "i",#iterations "boot.m",#mean value of bootstrap samples "boot.CI2.5",#2.5th quantile of bootstrap sample "boot.CI97.5",#97.5th quantile of bootstrap sample "boot.sub.m"#mean value of bootstrap sub-sample (out of 1000 subsamples per n) "boot.sub.CI_2.5",#2.5th quantile of bootstrap sub-sample "boot.sub.CI_97.5"#97.5th quantile of bootstrap sub-sample "mWithinCI95"#test whether sub-sample mean value lies within 95% confidence interval of bootstrap sample )))) tbl.minN.BMS.BATTkey.UNUkey#show table headings in console j=1 nboot = 1000#number of bootstrap sub-samples UNUkeyEx <-c("0401", "0302", "0306", "0301") #selection of UNUkeys selected from bootstrap data file for (u in UNUkeyEx){#exemplary UNUkeys u for(bk in BATTkey){#battery described as battery key BMS <- na.omit(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$BATTkey == bk&#differentiated data set according to UNUkeys and BATTkeys and give out vector about batter mass share df.WEEEwBATT.remained$UNUkey == u])#BMS = battery mass share boot.m <- na.omit(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey==bk&#differentiate tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey == u]) n <- length(na.omit(BMS)) tbl.minN.BMS.BATTkey.UNUkey[j,"BATTkey"] <- print(bk) tbl.minN.BMS.BATTkey.UNUkey[j,"UNUkey"] <- print(u) if (n > 14 & sum(BMS, na.rm = T)>0){#bootstrapping starts with at least 15 data points per UNUkey-BATTkey and if value not all values are 0 for (i in 5:n){#starting from 5 data points start to increase the number o sub-samples taken up to the original number of samples n for(B in 1:nboot){#repeat bootstrap 100-times tbl.minN.BMS.BATTkey.UNUkey[j,"BATTkey"] <- print(bk)#print BATTkey tbl.minN.BMS.BATTkey.UNUkey[j,"UNUkey"] <- print(u)#print UNUkey #generate bootstrap sub-samples boot.sub.samp <- sample(BMS, i, replace = T) # sample with replacement tbl.minN.BMS.BATTkey.UNUkey[j,"B"] <- print(B)#print bootstrap number tbl.minN.BMS.BATTkey.UNUkey[j,"n"] <- n#print original number of data points in sample tbl.minN.BMS.BATTkey.UNUkey[j,"i"] <- i#print iterater boot.CI2.5 <- quantile(boot.m, 0.025, na.rm=T)#calculate 2.5th quantile of bootstrap sample tbl.minN..BMS.BATTkey.UNUkey[j,"boot.CI2.5"] <- boot.CI2.5 #print 2.5th quantile of bootstrap sample boot.CI97.5 <- quantile(boot.m, 0.975, na.rm=T)#calculate 97.5th quantile of bootstrap sample tbl.minN.BMS.BATTkey.UNUkey[j,"boot.CI97.5"] <- boot.CI97.5#print 97.5th quantile of bootstrap sample boot.sub.m <- round(mean(boot.sub.samp), digits=2)#write the mean value of the sub-sample in the Bth row of the table tbl.minN.BMS.BATTkey.UNUkey[j, "boot.sub.m"] <- boot.sub.m #mean value of bootstrap sub-sample (out of 1000 subsamples per n) tbl.minN.BMS.BATTkey.UNUkey[j, "boot.sub.CI_2.5"] <- round(quantile(boot.sub.samp, 0.025, na.rm = T), digits=2)#2.5th quantile of bootstrap sub-sample tbl.minN.BMS.BATTkey.UNUkey[j, "boot.sub.CI_97.5"] <- round(quantile(boot.sub.samp, 0.975, na.rm = T), digits=2)#97.5th quantile of bootstrap sub-sample tbl.minN.BMS.BATTkey.UNUkey[j, "boot.m"] <- round(mean(boot.m, na.rm=T), digits=2)#mean value of bootstrap samples tbl.minN.BMS.BATTkey.UNUkey[j, "mWithinCI95"] <- if ((boot.sub.m >= boot.CI2.5) & (boot.sub.m <= boot.CI97.5)){print("Yes")} else {print("No")}#test whether sub-sample mean value lies within 95% confidence interval of bootstrap sample j=j+1 }} } else { tbl.minN.BMS.BATTkey.UNUkey[j, "B"] <- print("notEnoughData")#print "not enough data" in case of too few datapoints } j=j+1 }} tbl.minN.BMS.BATTkey.UNUkey <- tbl.minN.BMS.BATTkey.UNUkey[!is.na(tbl.minN.BMS.BATTkey.UNUkey$n)&#eliminates rows with no valid values in column n !is.na(tbl.minN.BMS.BATTkey.UNUkey$UNUkey),]#eliminates NAs in column UNUkey #**************************************************************************************************************** ##### ******* FIGURE 2 ******* ###### #**************************************************************************************************************** #The proportion of WEEE devices (UNUkeys) with and without battery compartment (a) and proportion of WEEE with a battery #compartment in which batteries remained or were missing (b). #------------------------------------------------------------------------------------------ #Figure 2 (a) #------------------------------------------------------------------------------------------ plt_BATTshare1 <- ggplot(NULL) + geom_bar(data=df_BATTshare[df_BATTshare$UoM =="%" & df_BATTshare$WEEE =="all",], aes(x=key, y=value, fill=batteryDriven),stat="identity")+ geom_text(data = df_BATTshare[df_BATTshare$batteryDriven=="total" & df_BATTshare$UoM =="n",], aes(x = key, y = 3, label = value), colour = "#FFFFFF", size=2.5)+ scale_y_continuous(expand=c(0,0))+ scale_fill_manual(labels = c("without", "with"), values=c('#61B7CF','#025167'))+#change color of legend text geom_hline(yintercept = 25, linetype="dashed", color = "darkgrey", size=0.5)+ geom_hline(yintercept = 50, linetype="dashed", color = "darkgrey", size=0.5)+ geom_hline(yintercept = 75, linetype="dashed", color = "darkgrey", size=0.5)+ theme_bw()+ theme(legend.background = element_rect(fill="white"), legend.position = c(0.08, 0.83), legend.text = element_text(size=9), legend.title = element_text(size=9), axis.text = element_text(size=9), axis.text.x = element_text(angle = 45, hjust=1), axis.title = element_text(size=9, face="bold"), strip.text.x = element_text(size = 9), strip.text.y = element_text(size = 9))+ labs(x="UNU key", y="WEEE with battery compartment [%]",#axis label fill = "Battery compartment") #------------------------------------------------------------------------------------------ #Figure 2 (b) #------------------------------------------------------------------------------------------ plt_BATTshare2 <- ggplot(NULL) + geom_bar(data=df_BATTshare[df_BATTshare$UoM =="%" & df_BATTshare$WEEE =="WEEEwBATT",], aes(x=key, y=value, fill=battRemoved),stat="identity")+ geom_text(data = df_BATTshare[df_BATTshare$batteryDriven=="wBATT" & df_BATTshare$WEEE =="all" & df_BATTshare$UoM =="n",], aes(x = key, y = 3, label = value), colour = "#FFFFFF", size=2.5)+ scale_y_continuous(expand=c(0,0))+ scale_fill_manual(labels = c("remained", "missing"), values=c('#24577B','#3E94D1'))+#farbe anpassen geom_hline(yintercept = 25, linetype="dashed", color = "darkgrey", size=0.5)+ geom_hline(yintercept = 50, linetype="dashed", color = "darkgrey", size=0.5)+ geom_hline(yintercept = 75, linetype="dashed", color = "darkgrey", size=0.5)+ theme_bw()+ theme(legend.background = element_rect(fill="white"), legend.position = c(0.06, 0.83), legend.text = element_text(size=9), legend.title = element_text(size=9), axis.text = element_text(size=9), axis.text.x = element_text(angle = 45, hjust=1), axis.title = element_text(size=9, face="bold"), strip.text.x = element_text(size = 9), strip.text.y = element_text(size = 9))+ labs(x="UNU key", y="Batteries remained / missing [%]",#axis label fill = "Battery") ggsave("BATTshare_remainedRemoved_UNUkey.png", width = 32, height = 17, units = c("cm")) #------------------------------------------------------------------------------------------ #arrange figures #------------------------------------------------------------------------------------------ ggarrange(plt_BATTshare1 + rremove("xlab") + rremove("x.text"), plt_BATTshare2,# nrow = 2, ncol=1, heights = c(0.85,1), common.legend = F, labels = c("(a)", "(b)"),#Label hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "v")#vertical alignment af axies ggsave("BATTshare_UNUkey.png", width = 25, height = 15, units = c("cm")) #**************************************************************************************************************** ##### ******* FIGURE 3 ******* ###### #**************************************************************************************************************** #Battery mass (a), battery mass share (b), and WEEE mass (c) differentiated according to their chemical systems (BATTkey). #calculate number of observations per BATTkey tbl_BATT_WEEEwBATT.remained <- group_by(df.WEEEwBATT.remained, BATTkey)%>% summarise(count = n()) #------------------------------------------------------------------------------------------ #Figure 3(a): boxplot of battery mass per battery key in logarithmic scale #------------------------------------------------------------------------------------------ BM_boxplot.logScale_vs.BATTkey <- ggplot(df.WEEEwBATT.remained, aes(x=BATTkey, y=BATTmass, fill=BATTkey))+#, fill=samplID, color=samplID))+ stat_boxplot(geom ='errorbar', width = 0.2)+#define error bar width geom_boxplot()+#add boxplot stat_summary(fun.y = "mean", geom = "point", shape = 22, size = 3, fill = "white")+ #add mean value geom_text(data = tbl_BATT_WEEEwBATT.remained, aes(x = BATTkey, y = 80000, label = count), size=3)+ #add number of observations to chart scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, #adapt logarithmic scale limits=c(1, 100000),expand = c(0, 0), labels = trans_format("log10", math_format(10^.x)))+ scale_x_discrete(labels=c("battLiPrim" = "LiPrim", "battLiRecharge" = "LiRecharge", #change labels "battNiCd" = "NiCd", "battNiMH" = "NiMH", "battPb" = "Pb", "battZn" = "Zn"))+ scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#adjust color theme_bw()+ #theme black and white theme(legend.position="none") + #no legend labs(x="BATTkey", #x label y="Battery mass [g]",#y label title=element_blank(),#chart title ylab=element_text(size=2))#y axis label size BM_boxplot.logScale_vs.BATTkey#display chart #------------------------------------------------------------------------------------------ #Figure 3 (b): boxplot of battery mass share per battery key #------------------------------------------------------------------------------------------ BMS_boxplot_vs.BATTkey <- ggplot(df.WEEEwBATT.remained, aes(x=BATTkey, y=BATTmassShare, fill=BATTkey))+#, fill=samplID, color=samplID)) + stat_boxplot(geom ='errorbar', width = 0.2)+#define error bar width geom_boxplot()+#add boxplot stat_summary(fun.y = "mean", geom = "point", shape = 22, size = 3, fill = "white")+ #add mean value geom_text(data = tbl_BATT_WEEEwBATT.remained, aes(x = BATTkey, y = 97, label = count), size=3)+ #add number of observations to chart scale_y_continuous(limits = c(0,100), expand=c(0,0))+#adapt y axis scale_x_discrete(labels=c("battLiPrim" = "LiPrim", "battLiRecharge" = "LiRecharge", #change labels "battNiCd" = "NiCd", "battNiMH" = "NiMH", "battPb" = "Pb", "battZn" = "Zn"))+ scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+##adjust color theme_bw()+ #theme black and white labs(x="BATTkey", y="Battery mass share [%]", title=element_blank(), ylab=element_text(size=2))#y axis label size BMS_boxplot_vs.BATTkey #display chart #------------------------------------------------------------------------------------------ #Figure 3 (c): boxplot of WEEE mass share per battery key #------------------------------------------------------------------------------------------ WM_boxplot_vs.BATTkey <- ggplot(df.WEEEwBATT.remained, aes(x=BATTkey, y=mass, fill=BATTkey))+#, fill=samplID, color=samplID)) + stat_boxplot(geom ='errorbar', width = 0.2)+#define error bar width geom_boxplot()+ stat_summary(fun.y = "mean", geom = "point", shape = 22, size = 3, fill = "white")+ #add mean value geom_text(data = tbl_BATT_WEEEwBATT.remained, aes(x = BATTkey, y = 80000, label = count), size=3)+ #scale_y_continuous(limits = c(0,25000), expand=c(0,0))+ scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, limits=c(10, 100000),expand = c(0, 0), labels = trans_format("log10", math_format(10^.x)))+ scale_x_discrete(labels=c("battLiPrim" = "LiPrim", "battLiRecharge" = "LiRecharge", "battNiCd" = "NiCd", "battNiMH" = "NiMH", "battPb" = "Pb", "battZn" = "Zn"))+ scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen theme_bw()+ #theme black and white labs(x="BATTkey", y="WEEE mass [g]", title=element_blank(), ylab=element_text(size=2))#labeling of axis WM_boxplot_vs.BATTkey #------------------------------------------------------------------------------------------ #arrange Figure 3 (a) - (c) #------------------------------------------------------------------------------------------ ggarrange(BM_boxplot.logScale_vs.BATTkey, BMS_boxplot_vs.BATTkey, WM_boxplot_vs.BATTkey, nrow = 1, ncol=3,# one row and three columns legend = "none",#no legend labels = c("(a)", "(b)", "(c)"),#Label hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "h")#vertical alignment ggsave("BM_BMS_WM_boxplot_vs.BATTkey.png", width = 30, height = 10, units = c("cm"))#save figure #**************************************************************************************************************** ##### ******* FIGURE 4 ******* ###### #**************************************************************************************************************** #Appearance and count of battery types (BATTkeys) in UNUkeys. ggplot(df.count.subKey.BATTkey, aes(x=subKey, y=BATTkey)) + geom_point(aes(size=count))+ scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=9), legend.title=element_text(size=9), axis.text = element_text(size=9), axis.text.x = element_text(angle = 45, hjust=1), axis.title=element_text(size=9, face="bold"), strip.text.x = element_text(size = 9), strip.text.y = element_text(size = 9))+ labs(x="subKey", y="BATTkey")#labeling of axis ggsave("count_subKey-BATTkey.png", width = 30, height = 7, units = c("cm")) #**************************************************************************************************************** ##### ******* FIGURE 5 ******* ###### #**************************************************************************************************************** #Mass (a) and mass share (b) of batteries remained in WEEE classified as UNUkeys and distinguished by their chemical system (BATTkey). #------------------------------------------------------------------------------------------ #Figure 5 (a) #------------------------------------------------------------------------------------------ BM_boxplot_vs.BATTkey <- ggplot(df.WEEEwBATT.rem, aes(y = massOfAllBatteries, x = key)) + stat_boxplot(geom ='errorbar', width = 0.2)+#define error bar width geom_boxplot(varwidth = F)+ stat_summary(fun.y = "mean", geom = "point", shape = 22, size = 3, fill = "white")+ #add mean value geom_point(position="jitter", aes(color=BATTkey, fill=BATTkey), alpha = 0.8, shape=23) +#, shape=prep scale_color_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen geom_text(data = df.WEEEwBATT.rem.summary, aes(x = key, y = 8500, label = count), colour = "black", size=4, face="bold")+ scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, limits=c(1, 10000),expand = c(0, 0), labels = trans_format("log10", math_format(10^.x)))+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=10), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.text.x = element_text(angle = 45, hjust=1), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="UNUkey", y="Battery mass [g]") #------------------------------------------------------------------------------------------ #Figure 5 (b) #------------------------------------------------------------------------------------------ BMS_boxplot_vs.BATTkey <- ggplot(df.WEEEwBATT.rem, aes(y = BATTmassShare, x = key)) + stat_boxplot(geom ='errorbar', width = 0.2)+#define error bar width geom_boxplot()+ #varwidth = F stat_summary(fun.y = "mean", geom = "point", shape = 22, size = 3, fill = "white")+ #add mean value geom_point(position="jitter", aes(color=BATTkey, fill=BATTkey), alpha = 0.8, shape=23) + scale_color_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiCd", "NiMH", "Pb", "Zn", "unspecified"), values=c('#ff9b40','#a65000', "#562781", "#a168d5", "#015965", "#03899c", "darkgrey"))+#farbe anpassen scale_y_continuous(limits = c(0,100), expand=c(0,0))+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), #legend.position = c(0.2, 0.9), legend.text=element_text(size=10), legend.title=element_text(size=12), axis.text = element_text(size=12), #axis.text.x = element_text(angle = 45, hjust=1), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="UNUkey", y="Battery mass share [%]") BMS_boxplot_vs.BATTkey #------------------------------------------------------------------------------------------ #arrange Figure 5 (a) and 8b) #------------------------------------------------------------------------------------------ ggarrange(BM_boxplot_vs.BATTkey + rremove("xlab") + rremove("x.text"), BMS_boxplot_vs.BATTkey,) nrow = 2, ncol=1, heights = c(1,0.95), common.legend = T, legend = "bottom", labels = c("(a)", "(b)"), hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "v")#vertical alignment of axes ggsave("ggarrange_BMS_BM_boxplot_vs.BATTkey.png", width = 30, height = 25, units = c("cm")) #**************************************************************************************************************** ##### ******* FIGURE 6 ******* ###### #**************************************************************************************************************** #Histogram and density distribution for the battery mass share (BMS) of LiRecharge and NiMH for mobile phones UNUkey 0306. #Original data (a, d), log-transformed data (b, e), and bootstrap sample means with B=5,000 (c, f). #------------------------------------------------------------------------------------------ # Figure 6 (a) #------------------------------------------------------------------------------------------ key0306.BMS.all <- ggplot(df.WEEEwBATT.remained[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey),], aes(x=BATTmassShare), position="dodge")+ annotate("rect", xmin = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T), xmax = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .2)+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=1, position="dodge")+ geom_density(alpha=.4)+ scale_x_continuous(limits=c(0,50), expand=c(0,0))+#, scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'), expand=c(0,0), limits=c(0,0.5))+ #limits=c(0,0.0005), stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"], na.rm = TRUE), sd = sd(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"], na.rm = TRUE)))+ annotate(geom = "text", label='bold("original data")', size = 4.5, x=1, y=0.47, hjust = 'left', parse = TRUE)+ annotate(geom = "text", label="n(BATT)=93", size = 4, x=3, y=0.44, hjust = 'left')+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # Figure 6 (b) #------------------------------------------------------------------------------------------ key0306.log.BMS.all <- ggplot(df.WEEEwBATT.remained[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey),], aes(x=log10(BATTmassShare), position="dodge"))+ annotate("rect", xmin = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T)), xmax = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T)), ymin = 0, ymax = 5, alpha = .2)+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=0.05, position="dodge")+ geom_density(alpha=.4)+ scale_x_continuous(limits=c(0,2),expand=c(0,0))+ scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'),expand=c(0,0), limits=c(0,5))+ #limits=c(0,0.0005), stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"]), na.rm = TRUE), sd = sd(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"]), na.rm = TRUE)))+ annotate(geom = "text", label='bold("log-transformation")', size = 4.5, x=0.05, y=4.7, hjust = 'left', parse = TRUE)+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # Figure 6 (d) #------------------------------------------------------------------------------------------ key0306.BMS <- ggplot(df.WEEEwBATT.remained[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey),], aes(x=BATTmassShare, fill=BATTkey), position="dodge")+ annotate("rect", xmin = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battNiMH" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T), xmax = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battNiMH" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .2, fill ='#a168d5')+#confidence intervall area annotate("rect", xmin = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battLiRecharge" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T), xmax = quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battLiRecharge" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .2, fill ='#a65000')+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=1, position="dodge")+ geom_density(alpha=.4)+ scale_fill_manual(labels = c("LiRecharge", "NiMH"), values=c('#a65000', "#a168d5"))+ scale_x_continuous(limits=c(0,50), expand=c(0,0))+ scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'), expand=c(0,0), limits=c(0,0.5))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battLiRecharge"], na.rm = TRUE), sd = sd(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battLiRecharge"], na.rm = TRUE)))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battNiMH"], na.rm = TRUE), sd = sd(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battNiMH"], na.rm = TRUE)))+ annotate(geom = "text", label='bold("original data")', size = 4.5, x=1, y=0.47, hjust = 'left', parse = TRUE)+ annotate(geom = "text", label=" n(LiRecharge)=69 \n n(NiMH)=24",size = 4, x=3, y=0.40, hjust = 'left')+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # Figure 6 (e) #------------------------------------------------------------------------------------------ key0306.log.BMS <- ggplot(df.WEEEwBATT.remained[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey!="unspecified" & !is.na(df.WEEEwBATT.remained$BATTkey),], aes(x=log10(BATTmassShare), fill=BATTkey))+ annotate("rect", xmin = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battNiMH" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T)), xmax = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battNiMH" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T)), ymin = 0, ymax = 5, alpha = .2, fill ='#a168d5')+#confidence intervall area annotate("rect", xmin = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battLiRecharge" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.025, na.rm = T)), xmax = log10(quantile(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306"& df.WEEEwBATT.remained$BATTkey=="battLiRecharge" & !is.na(df.WEEEwBATT.remained$BATTkey)], 0.975, na.rm = T)), ymin = 0, ymax = 5, alpha = .2, fill ='#a65000')+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=0.05,position="dodge")+ geom_density(alpha=.3)+ scale_fill_manual(labels = c("LiRecharge", "NiMH"), values=c('#a65000', "#a168d5"))+ scale_x_continuous(limits=c(0,2), expand=c(0,0))+ scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'), expand=c(0,0), limits=c(0,5))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battLiRecharge"]), na.rm = TRUE), sd = sd(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battLiRecharge"]), na.rm = TRUE)))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" & df.WEEEwBATT.remained$BATTkey=="battNiMH"]), na.rm = TRUE), sd = sd(log10(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key=="0306" &df.WEEEwBATT.remained$BATTkey=="battNiMH"]), na.rm = TRUE)))+ annotate(geom = "text", label='bold("log-transformation")',size = 4.5, x=0.05, y=4.7, hjust = 'left', parse = TRUE)+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # Figure 6 (f) #------------------------------------------------------------------------------------------ key0306.boot.BMS <- ggplot(tbl.bootstrap.BMS.UNUkey.BATTkey[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey!="unspecified" & !is.na(tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey),], aes(x=boot.m, fill=BATTkey))+ annotate("rect", xmin = quantile(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battLiRecharge" & !is.na(tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey)], 0.025, na.rm = T), xmax = quantile(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battLiRecharge" & !is.na(tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey)], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .4, fill ='#a65000')+#confidence intervall area annotate("rect", xmin = quantile(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battNiMH" & !is.na(tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey)], 0.025, na.rm = T), xmax = quantile(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battNiMH" & !is.na(tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey)], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .4, fill ='#a168d5')+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=1,position="identity")+ geom_density(alpha=.3)+ scale_fill_manual(labels = c("LiRecharge", "NiMH"), values=c('#a65000', "#a168d5"))+ scale_x_continuous(limits=c(0,50), expand=c(0,0))+ scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'),expand=c(0,0), limits=c(0,0.5))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battLiRecharge"], na.rm = TRUE), sd = sd(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battLiRecharge"], na.rm = TRUE)))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" & tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battNiMH"], na.rm = TRUE), sd = sd(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey=="0306" &tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey=="battNiMH"], na.rm = TRUE)))+ annotate(geom = "text", label='bold("bootstrap simulation")', size = 4.5, x=1, y=0.47, hjust = 'left', parse = TRUE)+ annotate(geom = "text", label="B=5,000", size = 4, x=3, y=0.44, hjust = 'left')+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # Figure 6 (c) #------------------------------------------------------------------------------------------ key0306.boot.BMS.all <- ggplot(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey=="0306",],aes(x=boot.m))+ annotate("rect", xmin = quantile(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$boot.m[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey=="0306"], 0.025, na.rm = T), xmax = quantile(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$boot.m[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey=="0306"], 0.975, na.rm = T), ymin = 0, ymax = 0.5, alpha = .2)+#confidence intervall area geom_histogram(aes(y=..density..), colour="black", binwidth=1, position="dodge")+ geom_density(alpha=.3)+ scale_fill_manual(labels = c("LiRecharge", "NiMH"), values=c('#a65000', "#a168d5"))+ scale_x_continuous(limits=c(0,50), expand=c(0,0))+ scale_y_continuous(labels = scales::number_format(accuracy = 0.01, decimal.mark = '.'), expand=c(0,0), limits=c(0,0.5))+ stat_function(fun = dnorm, colour = "darkred", size = 1, args = list( mean = mean(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$boot.m[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey=="0306"], na.rm = TRUE), sd = sd(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$boot.m[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey=="0306"], na.rm = TRUE)))+ annotate(geom = "text", label='bold("bootstrap simulation")', size = 4.5, x=1, y=0.47, hjust = 'left', parse = TRUE)+ annotate(geom = "text", label="B=5,000", size = 4, x=3, y=0.44, hjust = 'left')+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.text=element_text(size=12), legend.title=element_text(size=12), axis.text = element_text(size=12), axis.title=element_text(size=12, face="bold"), strip.text.x = element_text(size = 11), strip.text.y = element_text(size = 11))+ labs(x="BMS for UNU key 0306 [%]", y="Density")#labeling of axis #------------------------------------------------------------------------------------------ # arrange Figure 6 (a)-(f) #------------------------------------------------------------------------------------------ ggarrange(key0306.BMS.all + rremove("xlab") + rremove("x.text"), key0306.log.BMS.all + rremove("ylab") + rremove("xlab")+ rremove("x.text"), key0306.boot.BMS.all + rremove("ylab") + rremove("xlab")+ rremove("x.text"), key0306.BMS, key0306.log.BMS + rremove("ylab"),# key0306.boot.BMS + rremove("ylab"),# nrow = 2, ncol=3, widths = c(0.9, 1,1), common.legend = T, legend = "bottom", labels = c("(a)", "(b)", "(c)", "(d)", "(e)", "(f)"),#Label hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "v")#vertical alignment af axies ggsave("BMS_UNUkey0306_original.log.bootstrap.png", width = 34, height = 17, units = c("cm")) #**************************************************************************************************************** ##### ******* FIGURE 7 ******* ###### #**************************************************************************************************************** #NPA: Simulation of the minimum number of samples with bootstrap samples. The proportion of sub-samples within the 95% CI* #based on 1,000 bootstrap samples (y-axis) with an increasing number of samples n (x-axis). A coverage of 90% is considered #acceptable to achieve representable results with the given sample size (dashed line). #------------------------------------------------------------------------------------------ #Figure 7 (a) #------------------------------------------------------------------------------------------ #Step 1: create bootstrap confidence interval (95% CI*) for graph tbl.bootstrap.BMS.BATT.UNUkey <- data.frame(matrix(vector(), 0, 14,dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "m", "SD", "MAD", "CI_2.5", "CI_97.5", "boot.m", #mean "boot.SD", "boot.CI_2.5", "boot.CI_97.5" )))) tbl.bootstrap.BMS.BATT.UNUkey j=1 nboot = 5000 for (u in UNUkeyEx){#UNUkeywBATT #for (bk in BATTkey){ BMS <- na.omit(df.WEEE.BATT$BMS[df.WEEE.BATT$UNUkey == u]) n <- length(na.omit(BMS)) if (n > 0 & mean(BMS)>0){ for(B in 1:nboot){ tbl.bootstrap.BMS.BATT.UNUkey[j,"BATTkey"] <- print("BATT") tbl.bootstrap.BMS.BATT.UNUkey[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.BATT.UNUkey[j,"B"] <- print(B) tbl.bootstrap.BMS.BATT.UNUkey[j,"n"] <- n tbl.bootstrap.BMS.BATT.UNUkey[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) boot.samp <- sample(BMS, n, replace = TRUE) # sample with replacement tbl.bootstrap.BMS.BATT.UNUkey[j, "boot.m"] <- round(mean(boot.samp), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j, "boot.SD"] <- round(sd(boot.samp), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j, "boot.CI_2.5"] <- round(quantile(boot.samp, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j, "boot.CI_97.5"] <- round(quantile(boot.samp, 0.975, na.rm = T), digits=2) j=j+1 } } else { tbl.bootstrap.BMS.BATT.UNUkey[j,"BATTkey"] <- print("BATT") tbl.bootstrap.BMS.BATT.UNUkey[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.BATT.UNUkey[j,"n"] <- n tbl.bootstrap.BMS.BATT.UNUkey[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"SEM"] <- round(sd(BMS)/sqrt(n), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) tbl.bootstrap.BMS.BATT.UNUkey[j, "B"] <- print("notEnoughData") } j=j+1 }#} ##Step 2: plot the results of values that lie within the 95% CI* as geom_lineapproximate minimum sample size by bootstrapping subsamples from the original data set and test whether each mean value of the sub-sample with n_i fits withing the 95% CI* tbl.minN.BMS.BATT.UNUkey <- data.frame(matrix(vector(), 0, 12, dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "i", "boot.m", "boot.CI2.5", "boot.CI97.5", "boot.sub.m", "boot.sub.CI_2.5", "boot.sub.CI_97.5", "mWithinCI95" )))) tbl.minN.BMS.BATT.UNUkey j=1 nboot = 1000 UNUkeyEx <-c("0301", "0302", "0306", "0401") for (u in UNUkeyEx){# BMS <- na.omit(df.WEEE.BATT$BATTmassShare[df.WEEE.BATT$UNUkey == u])#BMS = battery mass share boot.m <- na.omit(tbl.bootstrap.BMS.BATT.UNUkey$boot.m[tbl.bootstrap.BMS.BATT.UNUkey$UNUkey == u]) n <- length(na.omit(BMS)) tbl.minN.BMS.BATT.UNUkey[j,"BATTkey"] <- print("BATT")#print(bk) tbl.minN.BMS.BATT.UNUkey[j,"UNUkey"] <- print(u) if (n > 14 & sum(BMS, na.rm = T)>0){#bootstrapping starting when at least 15 data points for (i in 5:n){ for(B in 1:nboot){ tbl.minN.BMS.BATT.UNUkey[j,"BATTkey"] <- print("BATT")#print(bk) tbl.minN.BMS.BATT.UNUkey[j,"UNUkey"] <- print(u) #generate bootstrap samples boot.sub.samp <- sample(BMS, i, replace = T) # sample with replacement tbl.minN.BMS.BATT.UNUkey[j,"B"] <- print(B) tbl.minN.BMS.BATT.UNUkey[j,"n"] <- n tbl.minN.BMS.BATT.UNUkey[j,"i"] <- i boot.CI2.5 <- quantile(boot.m, 0.025, na.rm=T) tbl.minN.BMS.BATT.UNUkey[j,"boot.CI2.5"] <- boot.CI2.5 boot.CI97.5 <- quantile(boot.m, 0.975, na.rm=T) tbl.minN.BMS.BATT.UNUkey[j,"boot.CI97.5"] <- boot.CI97.5 boot.sub.m <- round(mean(boot.sub.samp), digits=2) tbl.minN.BMS.BATT.UNUkey[j, "boot.sub.m"] <- boot.sub.m boot.sub.tm <- round(mean(boot.sub.samp, trim=0.2), digits=2) boot.sub.md <- round(median(boot.sub.samp), digits=2) tbl.minN.BMS.BATT.UNUkey[j, "boot.sub.CI_2.5"] <- round(quantile(boot.sub.samp, 0.025, na.rm = T), digits=2) tbl.minN.BMS.BATT.UNUkey[j, "boot.sub.CI_97.5"] <- round(quantile(boot.sub.samp, 0.975, na.rm = T), digits=2) tbl.minN.BMS.BATT.UNUkey[j, "boot.m"] <- round(mean(boot.m, na.rm=T), digits=2) tbl.minN.BMS.BATT.UNUkey[j, "mWithinCI95"] <- if ((boot.sub.m > boot.CI2.5) & (boot.sub.m < boot.CI97.5)){print("Yes")} else {print("No")}#alpha 0.01 j=j+1 }} } else { tbl.minN.BMS.BATT.UNUkey[j, "B"] <- print("notEnoughData") } j=j+1 } #Step 3: plot the results of values that lie within the 95% CI* as geom_lineCalculate the proportion of results per n_i that lie within the 95% CI* df.minN.BMS.BATT.UNUkey <- group_by(tbl.minN.BMS.BATT.UNUkey, UNUkey, i, mWithinCI95) %>% summarise( count = n(), proportion = count/10 ) ##Step 4: plot the results of values that lie within the 95% CI* as geom_lineplot the results of values that lie within the 95% CI* as geom_line minN.incl0 <- ggplot(df.minN.BMS.BATT.UNUkey[df.minN.BMS.BATT.UNUkey$mWithinCI95=="Yes"& (df.minN.BMS.BATT.UNUkey$UNUkey=="0301"| df.minN.BMS.BATT.UNUkey$UNUkey=="0302"| df.minN.BMS.BATT.UNUkey$UNUkey=="0306"| df.minN.BMS.BATT.UNUkey$UNUkey=="0401")& !is.na(df.minN.BMS.BATT.UNUkey$UNUkey), ,])+ geom_hline(yintercept = 90, linetype="dashed", color='black', na.rm=T)+ geom_line(aes(x= i, y=proportion, color=UNUkey), size = 1)+ scale_x_continuous(limits=c(0,650), expand = c(0,0), breaks = seq(0, 650, 50))+ scale_y_continuous(limits=c(0,105), expand = c(0,0), breaks = seq(0, 105, 10))+ scale_color_manual(labels = c("0301", "0306", "0401"), values=c('#AD009F', "#1A1EB2", "#4D1F00"))+ scale_fill_manual(labels = c("0301", "0306", "0401"), values=c('#AD009F', "#1A1EB2", "#4D1F00"))+ theme_bw()+ theme(legend.background = element_rect(fill="transparent"), legend.position = "right",#c(0.2, 0.8), legend.text=element_text(size=9), legend.title=element_text(size=9, face="bold"), axis.text = element_text(size=9, face="bold"), axis.text.x = element_text(angle = 45, hjust=1), axis.title=element_text(size=9,face="bold"))+ annotate(geom="text", x=400, y= 70, label="0301: n=626, VC=5.70 \n0302: n=222, VC=3.00 \n0306: n=117, VC=0.65 \n0401: n=392, VC=1.77", hjust = "left", vjust="top")+ ggtitle(label="BATT: all WEEE (w & w/o battery compartments)")+ labs(x = "Sample size n", y = "Coverage (B=1,000) [%]") minN.incl0 #------------------------------------------------------------------------------------------ #---- Figure 7 (b) ---- #------------------------------------------------------------------------------------------ #Step 1: create bootstrap confidence interval (95% CI*) for graph tbl.bootstrap.BMS.UNUkey.BATTex0 <- data.frame(matrix(vector(), 0, 13,dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "m", "SD", "MAD", "CI_2.5", "CI_97.5", "boot.m", #mean "boot.SD", "boot.CI_2.5", "boot.CI_97.5" )))) tbl.bootstrap.BMS.UNUkey.BATTex0 j=1 nboot = 5000 UNUkeyEx <- c("0301", "0302", "0306", "0401") for (u in UNUkeyEx){ BMS <- na.omit(df.WEEEwBATT.remained$BMS[df.WEEEwBATT.remained$key == u]) n <- length(na.omit(BMS)) if (n > 0 & mean(BMS, na.rm=T)>0){ for(B in 1:nboot){ tbl.bootstrap.BMS.UNUkey.BATTex0[j,"BATTkey"] <- print("BATT") tbl.bootstrap.BMS.UNUkey.BATTex0[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"B"] <- print(B) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"n"] <- n tbl.bootstrap.BMS.UNUkey.BATTex0[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) boot.samp <- sample(BMS, n, replace = TRUE) # sample with replacement tbl.bootstrap.BMS.UNUkey.BATTex0[j, "boot.m"] <- round(mean(boot.samp), digits=2)#schreibt den Mittelwert des bootstrap in die B-te Zeile des Vektors tbl.bootstrap.BMS.UNUkey.BATTex0[j, "boot.SD"] <- round(sd(boot.samp), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j, "boot.CI_2.5"] <- round(quantile(boot.samp, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j, "boot.CI_97.5"] <- round(quantile(boot.samp, 0.975, na.rm = T), digits=2) j=j+1 } } else { tbl.bootstrap.BMS.UNUkey.BATTex0[j,"BATTkey"] <- print("BATT") tbl.bootstrap.BMS.UNUkey.BATTex0[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"n"] <- n tbl.bootstrap.BMS.UNUkey.BATTex0[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTex0[j, "B"] <- print("notEnoughData") } j=j+1 } #Step 2: approximate minimum sample size by bootstrapping subsamples from the original data set and test whether each mean value of the sub-sample with n_i fits withing the 95% CI* tbl.minN.BMS.BATT.UNUkeyex0 <- data.frame(matrix(vector(), 0, 12, dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "i", "boot.m", "boot.CI2.5", "boot.CI97.5", "boot.sub.m", "boot.sub.CI_2.5", "boot.sub.CI_97.5", "mWithinCI95", )))) tbl.minN.BMS.BATT.UNUkeyex0 j=1 nboot = 1000#nur 1000 subsamples?! UNUkeyEx <-c("0301", "0302", "0306", "0401") for (u in UNUkeyEx){ BMS <- na.omit(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key == u])#BMS = battery mass share boot.m <- na.omit(tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$boot.m[tbl.bootstrap.BATTmassShare.UNUkey.BATTex0$UNUkey == u]) n <- length(na.omit(BMS)) tbl.minN.BMS.BATT.UNUkeyex0[j,"BATTkey"] <- print("BATT")#print(bk) tbl.minN.BMS.BATT.UNUkeyex0[j,"UNUkey"] <- print(u) if (n > 14 & sum(BMS, na.rm = T)>0){ for (i in 5:n){# for(B in 1:nboot){ tbl.minN.BMS.BATT.UNUkeyex0[j,"BATTkey"] <- print("BATT") tbl.minN.BMS.BATT.UNUkeyex0[j,"UNUkey"] <- print(u) #generate bootstrap samples boot.sub.samp <- sample(BMS, i, replace = T) # sample with replacement tbl.minN.BMS.BATT.UNUkeyex0[j,"B"] <- print(B) tbl.minN.BMS.BATT.UNUkeyex0[j,"n"] <- n tbl.minN.BMS.BATT.UNUkeyex0[j,"i"] <- i boot.CI2.5 <- quantile(boot.m, 0.025, na.rm=T) tbl.minN.BMS.BATT.UNUkeyex0[j,"boot.CI2.5"] <- boot.CI2.5 boot.CI97.5 <- quantile(boot.m, 0.975, na.rm=T) tbl.minN.BMS.BATT.UNUkeyex0[j,"boot.CI97.5"] <- boot.CI97.5 boot.sub.m <- round(mean(boot.sub.samp), digits=5) tbl.minN.BMS.BATT.UNUkeyex0[j, "boot.sub.m"] <- boot.sub.m boot.sub.md <- round(median(boot.sub.samp), digits=2) tbl.minN.BMS.BATT.UNUkeyex0[j, "boot.sub.CI_2.5"] <- round(quantile(boot.sub.samp, 0.025, na.rm = T), digits=2) tbl.minN.BMS.BATT.UNUkeyex0[j, "boot.sub.CI_97.5"] <- round(quantile(boot.sub.samp, 0.975, na.rm = T), digits=2) tbl.minN.BMS.BATT.UNUkeyex0[j, "boot.m"] <- round(mean(boot.m, na.rm=T), digits=2) tbl.minN.BMS.BATT.UNUkeyex0[j, "mWithinCI95"] <- if ((boot.sub.m > boot.CI2.5) & (boot.sub.m < boot.CI97.5)){print("Yes")} else {print("No")}#alpha 0.01 j=j+1 }}#} } else { tbl.minN.BMS.BATT.UNUkeyex0[j, "B"] <- print("notEnoughData") } j=j+1 }#} #Step 3: Calculate the proportion of results per n_i that lie within the 95% CI* df.minN.BMS.BATT.UNUkeyex0 <- group_by(tbl.minN.BMS.BATT.UNUkeyex0, UNUkey, i, mWithinCI95) %>% summarise( count = n(), proportion = count/10 ) #Step 4: plot the results of values that lie within the 95% CI* as geom_line minN.excl0 <- ggplot(df.minN.BMS.BATT.UNUkeyex0[df.minN.BMS.BATT.UNUkeyex0$mWithinCI95=="Yes",])+ geom_hline(yintercept = 90, linetype="dashed", color='black', na.rm=T)+ geom_line(aes(x= i, y=proportion, color=UNUkey), size = 1)+ scale_x_continuous(limits=c(0,150), expand = c(0,0), breaks = seq(0, 150, 10))+ scale_y_continuous(limits=c(0,105), expand = c(0,0), breaks = seq(0, 105, 10))+ scale_color_manual(labels = c("0301", "0302", "0306", "0401"), values=c('#AD009F','#FFD340', "#1A1EB2", "#4D1F00"))+ scale_fill_manual(labels = c("0301", "0302", "0306", "0401"), values=c('#AD009F','#FFD340', "#1A1EB2", "#4D1F00"))+ theme_bw()+ annotate(geom="text", x=90, y= 70, label="0301: n=51, VC=1.32 \n0302: n=118, VC=1.84 \n0306: n=93, VC=0.36 \n0401: n=121, VC=0.52", hjust = "left", vjust="top")+ ggtitle(label="BATT: WEEE with batteries remaining")+ theme(legend.background = element_rect(fill="transparent"), legend.position = "right",#c(0.2, 0.8), legend.text=element_text(size=9), legend.title=element_text(size=9, face="bold"), axis.text = element_text(size=9, face="bold"), axis.text.x = element_text(angle = 45, hjust=1), axis.title=element_text(size=9,face="bold"))+ labs(x = "Sample size n", y = "Coverage (B=1,000) [%]") minN.excl0 #------------------------------------------------------------------------------------------ #---- Figure 7 (c) ---- #------------------------------------------------------------------------------------------ #Step 1: create bootstrap confidence interval (95% CI*) for graph tbl.bootstrap.BMS.UNUkey.BATTkey <- data.frame(matrix(vector(), 0, 13,dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "m", "SD", "MAD", "CI_2.5", "CI_97.5", "boot.m", #mean "boot.SD", "boot.CI_2.5", "boot.CI_97.5" )))) tbl.bootstrap.BMS.UNUkey.BATTkey j=1 nboot = 5000 UNUkeyEx <-c("0401", "0302", "0306", "0301") for (u in UNUkeyEx){ for (bk in BATTkey){ BMS <- na.omit(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$key == u& df.WEEEwBATT.remained$BATTkey==bk]) n <- length(na.omit(BMS)) if (n > 0 & mean(BMS)>0){# for(B in 1:nboot){ tbl.bootstrap.BMS.UNUkey.BATTkey[j,"BATTkey"] <- print(bk) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"B"] <- print(B) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"n"] <- n tbl.bootstrap.BMS.UNUkey.BATTkey[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) boot.samp <- sample(BMS, n, replace = TRUE) # sample with replacement tbl.bootstrap.BMS.UNUkey.BATTkey[j, "boot.m"] <- round(mean(boot.samp), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j, "boot.SD"] <- round(sd(boot.samp), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j, "boot.CI_2.5"] <- round(quantile(boot.samp, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j, "boot.CI_97.5"] <- round(quantile(boot.samp, 0.975, na.rm = T), digits=2) j=j+1 } } else { tbl.bootstrap.BMS.UNUkey.BATTkey[j,"BATTkey"] <- print(bk) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"UNUkey"] <- print(u) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"n"] <- n tbl.bootstrap.BMS.UNUkey.BATTkey[j,"m"] <- round(mean(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"SD"] <- round(sd(BMS, na.rm=T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"MAD"] <- round(mad(BMS, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_2.5"] <- round(quantile(BMS, 0.025, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j,"CI_97.5"] <- round(quantile(BMS, 0.975, na.rm = T), digits=2) tbl.bootstrap.BMS.UNUkey.BATTkey[j, "B"] <- print("notEnoughData") } j=j+1 }} #Step 2: approximate minimum sample size by bootstrapping subsamples from the original data set and test whether each mean value of the sub-sample with n_i fits withing the 95% CI* tbl.minN.BMS.BATTkey.UNUkey.rem <- data.frame(matrix(vector(), 0, 12, dimnames=list(c(), c("UNUkey", "BATTkey", "B", "n", "i", "boot.m", "boot.CI2.5", "boot.CI97.5", "boot.sub.m", "boot.sub.CI_2.5", "boot.sub.CI_97.5", "mWithinCI95" )))) tbl.minN.BMS.BATTkey.UNUkey.rem j=1 nboot = 1000 UNUkeyEx <-c("0401", "0302", "0306","0301") for (u in UNUkeyEx){ for(bk in BATTkey){ BMS <- na.omit(df.WEEEwBATT.remained$BATTmassShare[df.WEEEwBATT.remained$BATTkey == bk& df.WEEEwBATT.remained$key == u])#BMS = battery mass share boot.m <- na.omit(tbl.bootstrap.BMS.UNUkey.BATTkey$boot.m[tbl.bootstrap.BMS.UNUkey.BATTkey$BATTkey==bk&#B=5000 tbl.bootstrap.BMS.UNUkey.BATTkey$UNUkey == u]) n <- length(na.omit(BMS)) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"BATTkey"] <- print(bk) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"UNUkey"] <- print(u) if (n > 14 & sum(BMS, na.rm = T)>0){ for (i in 5:n){# for(B in 1:nboot){ tbl.minN.BMS.BATTkey.UNUkey.rem[j,"BATTkey"] <- print(bk) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"UNUkey"] <- print(u) boot.sub.samp <- sample(BMS, i, replace = T) # sample with replacement tbl.minN.BMS.BATTkey.UNUkey.rem[j,"B"] <- print(B) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"n"] <- n tbl.minN.BMS.BATTkey.UNUkey.rem[j,"i"] <- i boot.CI2.5 <- quantile(boot.m, 0.025, na.rm=T) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"boot.CI2.5"] <- boot.CI2.5 boot.CI97.5 <- quantile(boot.m, 0.975, na.rm=T) tbl.minN.BMS.BATTkey.UNUkey.rem[j,"boot.CI97.5"] <- boot.CI97.5 boot.sub.m <- round(mean(boot.sub.samp), digits=2) tbl.minN.BMS.BATTkey.UNUkey.rem[j, "boot.sub.m"] <- boot.sub.m tbl.minN.BMS.BATTkey.UNUkey.rem[j, "boot.sub.CI_2.5"] <- round(quantile(boot.sub.samp, 0.025, na.rm = T), digits=2) tbl.minN.BMS.BATTkey.UNUkey.rem[j, "boot.sub.CI_97.5"] <- round(quantile(boot.sub.samp, 0.975, na.rm = T), digits=2) tbl.minN.BMS.BATTkey.UNUkey.rem[j, "boot.m"] <- round(mean(boot.m, na.rm=T), digits=2) tbl.minN.BMS.BATTkey.UNUkey.rem[j, "mWithinCI95"] <- if ((boot.sub.m >= boot.CI2.5) & (boot.sub.m <= boot.CI97.5)){print("Yes")} else {print("No")}#alpha 0.01 j=j+1 }} } else { tbl.minN.BMS.BATTkey.UNUkey.rem[j, "B"] <- print("notEnoughData") } j=j+1 }} #Step 3: Calculate the proportion of results per n_i that lie within the 95% CI* df.minN.BMS.BATTkey.UNUkey.CI.m <- group_by(tbl.t.test.BMS.BATTkey.UNUkey.rem, UNUkey, BATTkey, i, mWithinCI95) %>% summarise( count = n(), proportion = count/10 ) #Step 4: plot the results of values that lie within the 95% CI* as geom_line plot.minN.CI.m_select <- ggplot(df.minN.BMS.BATTkey.UNUkey.CI.m[df.minN.BMS.BATTkey.UNUkey.CI.m$mWithinCI95=="Yes"& (df.minN.BMS.BATTkey.UNUkey.CI.m$UNUkey=="0301"| df.minN.BMS.BATTkey.UNUkey.CI.m$UNUkey=="0302"| df.minN.BMS.BATTkey.UNUkey.CI.m$UNUkey=="0306"| df.minN.BMS.BATTkey.UNUkey.CI.m$UNUkey=="0401") ,])+ geom_hline(yintercept = 90, linetype="dashed", color='black', na.rm=T)+ geom_line(aes(x= i, y=proportion, color=BATTkey), size = 1)+ scale_x_continuous(limits=c(0,150), expand = c(0,0), breaks = seq(0, 150, 15))+ scale_y_continuous(limits=c(0,105), expand = c(0,0), breaks = seq(0, 105, 10))+ scale_color_manual(labels = c("LiPrim", "LiRecharge", "NiMH", "Zn"), values=c('#ff9b40','#a65000', "#a168d5", "#03899c"))+#farbe anpassen "Pb", , "#015965" scale_fill_manual(labels = c("LiPrim", "LiRecharge", "NiMH", "Zn"), values=c('#ff9b40','#a65000', "#a168d5", "#03899c"))+#farbe anpassen"#015965","Pb", theme_bw()+ ggtitle(label="BATTkey: WEEE with batteries remaining")+ theme(legend.background = element_rect(fill="transparent"), legend.position = "right",#c(0.2, 0.8), legend.text=element_text(size=9), axis.text.x = element_text(angle = 45, hjust=1), legend.title=element_text(size=9, face="bold"), axis.text = element_text(size=9, face="bold"), axis.title=element_text(size=9,face="bold"))+ labs(x = "Sample size n", y = "Coverage (B=1,000) [%]")# Proportion cases within 95% confidence interval plot.minN.CI.m_select <- plot.minN.CI.m_select+facet_grid(.~UNUkey) plot.minN.CI.m_select ggsave("minN_bootstrap_lineplot_CI95.m_UNUkey0301,0302,0303,0401_B1000.png", width = 35, height = 10, units = c("cm")) #------------------------------------------------------------------------------------------ #Figure 7 (a) - (c) #------------------------------------------------------------------------------------------ #create first plot with (a) and (b) plot1 <- ggarrange(minN.incl0, minN.excl0, ncol = 2, nrow=1, widths = c(1, 1), common.legend = F, legend = "top", labels = c("(a)", "(b)"),#Label hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "h")#horizontale Ausrichtung der Achsen) #arrange graphs (a) and (b) with (c) ggarrange(plot1, plot.minN.CI.m_select, ncol = 1, nrow = 2, common.legend = T, legend = "bottom", heights = c(1,0.9), labels = c("", "(c)"),#Label hjust = 0.0,#default -0.5. More negative values move the label further to the right on the plot canvas vjust = 1.0,#default 1.5 align = "v" ) ggsave("minN_bootstrap_lineplot_ggarrange.png", width = 28, height = 20, units = c("cm"))