###Code file for Biochar effect on nutrient cycle of sandy-textured soils ### # Publication title: Biochar improves the nutrient cycle in sandy-textured soils and increases crop yield: A Systematic Review ################################################################################# # Author: Madina Bekchanova, Hasselt University # Co-author: Luca Campion, Stephan Bruns, Tom Kuppens, Johannes Lehmann, Marijke Jozefczak, # Ann Cuypers, Robert Malina # Description: This R file contains all of the necessary code to replicate the # procedure undertaken by the authors in the aforementioned # publication. A description of variable names and .xlxs file can # be found in the accompanying document "Additional File 9.xlsx". ################################################################################# ### Required Packages ### # Load packages below library(metafor) library(tidyverse) library(robumeta) library(clubSandwich) library(esc) library(BMS) library(stabs) library(glmnet) library(corrplot) library(gridGraphics) # Note: Set a working directory or file path for each .xlxs file where indicated in annotations setwd("~/Library//META ANALYSIS") metadata = readxl::read_excel("Additional file 9. Data-extraction sheet.xlsx", na = "NA") %>% mutate(woody_biomass = case_when( woody_biomass=="Yes" ~"Woody", woody_biomass=="No" ~ ""), manure_digestate = case_when( manure_digestate=="Yes" ~"Manure|digestate", manure_digestate=="No" ~ ""), agricultural_residue = case_when( agricultural_residue=="Yes" ~"Agricultural residue", agricultural_residue=="No" ~ ""), feedstock_rename = case_when(woody_biomass=="Woody" ~"Woody", manure_digestate=="Manure|digestate" ~"Manure|digestate", agricultural_residue=="Agricultural residue" ~"Agricultural residue"), Biochar_app_rate = cut(application_rate, breaks = c(0, 10, 30, 50, 250), labels = c("0-10", "10-30", "30-50", "50-210")), fertilizer_app_rate = as.numeric(fertilizer_app_rate), Fertilizer_app_rate = cut(fertilizer_app_rate, breaks = c(0, 30, 120, 250, 600), labels = c("0-30", "30-120", "120-250", "250-600"))) # Fix column classes metadata$treatment_sd <- as.numeric(metadata$treatment_sd) metadata$control_sd <- as.numeric(metadata$control_sd) # Filter abundance data metadata_TNPK <- metadata %>% filter(measurement_n == "Soil total NPK") # Needed for metafor to make model equivalent to MCMCglmm metadata_TNPK$ES_ID<-as.factor(seq(1, nrow(metadata_TNPK), 1)) metadata_TNPK = metadata_TNPK %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_TNPK = metadata_TNPK %>% mutate(unique_id = row_number()) # to create a unique ID ################################################################### ################### FUNCTIONS USED ############################### #' @title cv_avg #' @description Calculates the weighted average CV^2 within a study and the weighted average CV^2 across a study #' @param x Mean of an experimental group #' @param sd Standard deviation of an experimental group #' @param n The sample size of an experimental group #' @param group Study, grouping or cluster variable one wishes to calculate the within and between weighted CV^2. In meta-analysis this will most likely be 'study'. #' @param data The dataframe containing the mean, sd, n and grouping variables #' @param label A character string specifying the label one wishes to attach to columns to identify the treatment. Otherwise, if not specified it will default to the variable name for x #' @param sub_b A logical indicating whether the between study CV^2 (b_CV2) should be appended to the data only ('TRUE') or whether both within study CV^2 (w_CV2), mean sample size (n_mean) and between study CV^2 (b_CV2) should all be appended to the data only ('FALSE') #' @param cv2 A logical indicating whether one should take the weighted average of CV2 or the weighted average of CV followed by squaring this average. Default to FALSE. #' @example \dontrun{ #' # test data for cv_avg function #' library(tidyverse) #' set.seed(76) #' x1 = rnorm(16, 6, 1) #' x2 = rnorm(16, 6, 1) #' test_dat <- data.frame(stdy = rep(c(1,2,3,4), each = 4),x1 = x1,sd1 = exp(log(x1)*1.5 + rnorm(16, 0, #' sd = 0.10)),n1 = rpois(16, 15),x2 = x2,sd2 = exp(log(x2)*1.5 + rnorm(16, 0, sd = 0.10)),n2 = rpois(16, 15)) #' rm(list = c("x1", "x2")) #' # # Now generate some missing data #' t2 <- gen.miss(test_dat, "sd1", "sd2", 6) #' t2_cv2 <- cv_avg(x = x1, sd = sd1, n = n1, stdy, data = t2, sub_b = FALSE, cv2 = TRUE) #' t2_cv2 <- cv_avg(x2, sd2, n2, stdy, label = "2", data = t2_cv, sub_b = FALSE) #' # Check calculations are correct. All match what is expected #' test <- t2_cv %>% filter(stdy == "1") #' # Within #' mean(test$n1) # Matches 14.75 #' mean(test$n2) # Matches 14 #' # CV^2 #' weighted.mean((test$sd1 / test$x1)^2, test$n1, na.rm = T) #' weighted.mean((test$sd2 / test$x2)^2, test$n2, na.rm = T) #' # mean(CV)^2 #' t2_cv <- cv_avg(x = x1, sd = sd1, n = n1, stdy, data = t2, sub_b = FALSE, cv2 = FALSE) #' weighted.mean((test$sd1 / test$x1), test$n1, na.rm = T)^2 #' # Between #' wCV1 = unique(t2_cv2$w_CV2_x1) #' w_nt1 = c(59,58,58,50) #' weighted.mean(wCV1, w_nt1) #' wCV2 = unique(t2_cv2$w_CV2_2) #' w_nt2 = c(56, 56, 72, 63) #' weighted.mean(wCV2, w_nt2) #' } cv_avg <- function(x, sd, n, group, data, label = NULL, sub_b = TRUE, cv2=FALSE){ # Check if the name is specified or not. If not, then assign it the name of the mean, x, variable input in the function. https://stackoverflow.com/questions/60644445/converting-tidyeval-arguments-to-string if(is.null(label)){ label <- purrr::map_chr(enquos(x), rlang::as_label) } # Calculate between study CV. Take weighted mean CV within study, and then take a weighted mean across studies of the within study CV. Weighted based on sample size and pooled sample size. b_grp_cv_data <- data %>% dplyr::group_by({{group}}) %>% dplyr::mutate( w_CV2 = weighted_CV({{sd}}, {{x}}, {{n}}, cv2=cv2), n_mean = mean({{n}}, na.rm = TRUE)) %>% dplyr::ungroup(.) %>% dplyr::mutate(b_CV2 = weighted.mean(w_CV2, n_mean, na.rm = TRUE), .keep = "used") # Make sure that label of the calculated columns is distinct from any other columns names(b_grp_cv_data) <- paste0(names(b_grp_cv_data), "_", label) # Append these calculated columns back to the original data and return the full dataset. if(sub_b){ b_grp_cv_data <- b_grp_cv_data %>% dplyr::select(grep("b_", names(b_grp_cv_data))) dat_new <- cbind(data, b_grp_cv_data) } else { dat_new <- cbind(data, b_grp_cv_data) } return(data.frame(dat_new)) } #' @title weighted_CV #' @description Calculates the weighted average CV^2 or CV followed by squaring within a study and the weighted averages CV^2 across a studies #' @param sd Standard deviation of an experimental group #' @param x Mean of an experimental group #' @param n The sample size of an experimental group #' @param cv2 Logical indicating whether the weighted average of CV^2 or CV should be taken (followed by squaring weighted average CV). Defaults to weighted average of CV. weighted_CV <- function(sd, x, n, cv2=FALSE){ if(cv2){ weighted.mean(na_if((sd / x)^2, Inf), n, na.rm = TRUE) }else{ weighted.mean(na_if((sd / x), Inf), n, na.rm = TRUE)^2 } } #' @title get_est #' @description Extracts estimates from rma.mv and rma model objects #' @param model The rma.mv model object get_est <- function(model){ est <- coef(model) ci.lb <- model$ci.lb ci.ub <- model$ci.ub se <- model$se return(data.frame(Est. = est, SE=se, "95% LCI" = ci.lb, "95% UCI" = ci.ub, check.names = FALSE)) } #' @title lnrr_laj #' @description Calculates log response ratio based on Taylor expansion from Jajeunesse 2011 #' @param m1 Mean of treatment group 1 #' @param m2 Mean of treatment group 2 #' @param cv1_2 Coefficient of variation squared (CV^2) for treatment group 1 #' @param cv2_2 Coefficient of variation squared (CV^2) for treatment group 2 #' @param n1 Sample size for treatment group 1 #' @param n2 Sample size for treatment group 2 #' lnrr_laj <- function(m1, m2, cv1_2, cv2_2, n1, n2){ log(m1 / m2) + 0.5*((cv1_2 / n1) - (cv2_2 / n2)) } #' @title v_lnrr_laj #' @description Calculates the sampling variance for log response ratio based on second order Taylor expansion proposed by Lajeunesse 2011 #' @param cv1_2 Coefficient of variation squared (CV^2) for treatment group 1 #' @param cv2_2 Coefficient of variation squared (CV^2) for treatment group 2 #' @param n1 Sample size for treatment group 1 #' @param n2 Sample size for treatment group 2 v_lnrr_laj <- function(cv1_2, cv2_2, n1, n2){ ((cv1_2) / n1) + ((cv2_2) / n2) + ((cv1_2)^2 / (2*n1)^2) + ((cv2_2)^2 / (2*n2)^2) } #' @title tree_checks #' @description A function for checking species names in a phylogenetic tree and dataframe to ensure they match. #' @param data The dataframe containing the mean, sd, n and grouping variables along with species name #' @param tree A phylogenetic tree #' @param species_name_col A character string specifying the column name describing the species in the dataframe #' @param type Type of method to be implemented. 'checks' will compare teh data and tree and identify 1) how many species are in the tree and data, 2) which species are in the data but not tree and 3) which species are in the tree but not the data. 'prune' can be used to prune the phylogenetic tree down to the species that exist within the dataframe. tree_checks <- function(data, tree, species_name_col, type = c("checks", "prune")){ type = match.arg(type) # How many unique species exist in data and tree Numbers <- matrix(nrow = 2, ncol = 1) Numbers[1,1] <- length(unique(data[,species_name_col])) Numbers[2,1] <- length(tree$tip.label) rownames(Numbers)<- c("Species in data:", "Species in tree:") # Missing species or species not spelt correct species_list1= setdiff(sort(tree$tip.label), sort(unique(data[,species_name_col]))) species_list2= setdiff(sort(unique(data[,species_name_col])), sort(tree$tip.label) ) if(type == "checks"){ return(list(SpeciesNumbers = data.frame(Numbers), Species_InTree_But_NotData=species_list1, Species_InData_But_NotTree=species_list2)) } if(type == "prune"){ if(length(species_list2) >=1) stop("Sorry, you can only prune a tree when you have no taxa existing in the data that are not in the tree") return(ape::drop.tip(tree, species_list1)) } } #' @title gen.miss #' @description Generates random missing data in two columns of a meta-analytic dataset #' @param data The dataframe containing the mean, sd, n and grouping variables #' @param missVar A character string specifying the first column one wishes to have missing data. Example, "sd1" column. #' @param missCol2 A character string specifying the second column one wishes to have missing data. Example, "sd2" column. #' @param n_miss The number of missing data (NA) one wishes to introduce to the missVar and missCol2 gen.miss <- function(data, missVar, missCol2, n_miss){ data[sample(rownames(data), n_miss), missVar] <- NA data[is.na(data[,missVar]), missCol2] <- NA return(data) } ############################################################################# # Calculate CV metadata_TNPK <- metadata_TNPK %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_TNPK <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_TNPK) metadata_TNPK <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_TNPK) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_TNPK <- metadata_TNPK %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_TNPK <- metadata_TNPK %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_TNPK <- metadata_TNPK %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_TNPK = metadata_TNPK %>% mutate(se = sqrt(v_lnrr_1A) ) ################## Funnel plot to check the outliers in the data ################################## ################## This funnel plot has been applied for each SPP par(mfrow = c(1, 2)) funnel(metadata_TNPK$lnrr_laj, metadata_TNPK$v_lnrr_1A, yaxis="seinv", #xlim = c(-3, 3), ylab = "Precision (1/SE)", xlab = "Effect size (logRR)", col =metadata_TNPK$ES_ID) ############### OUTLIER REMOVAL ########################### ################ This Function is used for each SPP # the function to estimate number of outliers outs = function(x, factor=1.5) { # identify outliers if(!is_tibble(x)){ x = x %>% tibble::enframe(name = NULL) } x = x %>% drop_na() #IQR = sumstats(x)[["IQR"]] IQ = quantile(pull(x), c(0.25, 0.75), names = FALSE) IQR = diff(IQ) x %>% mutate( logisch = !dplyr::between(value, IQ[1] - factor*IQR, IQ[2] + factor*IQR )) %>% pull(logisch) } ################## Funnel plot to check the data without outliers ################################## ################# This funnel plot has been applied for each SPP par(mfrow = c(1, 2)) funnel(metadata_TNPK$lnrr_laj, metadata_TNPK$v_lnrr_1A, yaxis="seinv", #xlim = c(-3, 3), ylab = "Precision (1/SE)", xlab = "Effect size (logRR)", col =metadata_TNPK$ES_ID) ############################################# application of outlier removal function ################ metadata_TNPK = metadata_TNPK %>% dplyr::filter(!outs(1/se, factor = 10)) ####################################### ######### Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_TNPK) MLMA_MC_res <- get_est(MLMA_MC) Robustness_MLMA_MC = robust(MLMA_MC, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_robust <- get_est(Robustness_MLMA_MC) ############################################################################# ##################### Soil mineral nitrogen ################################# # Filter abundance data metadata_SMN <- metadata %>% filter(measurement_n == "Soil mineral nitrogen") # Needed for metafor to make model equivalent to MCMCglmm metadata_SMN$ES_ID<-as.factor(seq(1, nrow(metadata_SMN), 1)) metadata_SMN = metadata_SMN %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_SMN = metadata_SMN %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_SMN <- metadata_SMN %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_SMN <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_SMN) metadata_SMN <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_SMN) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_SMN <- metadata_SMN %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_SMN <- metadata_SMN %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_SMN <- metadata_SMN %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_SMN = metadata_SMN %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_SMN = metadata_SMN %>% dplyr::filter(!outs(1/se, factor = 10)) ########################################## ########## Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_2<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_SMN) MLMA_MC_res_2 <- get_est(MLMA_MC_2) Robustness_MLMA_MC_2 = robust(MLMA_MC_2, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_2_robust <- get_est(Robustness_MLMA_MC_2) ############################################################################# ################## plant nutrient level ########################################### # Filter abundance data metadata_PNL <- metadata %>% filter(measurement_n == "Plant nutrient level") # Needed for metafor to make model equivalent to MCMCglmm metadata_PNL$ES_ID<-as.factor(seq(1, nrow(metadata_PNL), 1)) metadata_PNL = metadata_PNL %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_PNL = metadata_PNL %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_PNL <- metadata_PNL %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_PNL <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_PNL) metadata_PNL <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_PNL) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_PNL <- metadata_PNL %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_PNL <- metadata_PNL %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_PNL <- metadata_PNL %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_PNL = metadata_PNL %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_PNL = metadata_PNL %>% dplyr::filter(!outs(1/se, factor = 10)) ################################# ############### Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_3<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_PNL) MLMA_MC_res_3 <- get_est(MLMA_MC_3) Robustness_MLMA_MC_3 = robust(MLMA_MC_3, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_3_robust <- get_est(Robustness_MLMA_MC_3) ################################################################################ ########################## N2O emission ####################################### # Filter abundance data metadata_N2O <- metadata %>% filter(measurement_n == "N2O emission") # Needed for metafor to make model equivalent to MCMCglmm metadata_N2O$ES_ID<-as.factor(seq(1, nrow(metadata_N2O), 1)) metadata_N2O = metadata_N2O %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_N2O = metadata_N2O %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_N2O <- metadata_N2O %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_N2O <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_N2O) metadata_N2O <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_N2O) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_N2O <- metadata_N2O %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_N2O <- metadata_N2O %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_N2O <- metadata_N2O %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_N2O = metadata_N2O %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_N2O = metadata_N2O %>% dplyr::filter(!outs(1/se, factor = 10)) ############################################## ###################### Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_4<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_N2O) MLMA_MC_res_4 <- get_est(MLMA_MC_4) Robustness_MLMA_MC_4 = robust(MLMA_MC_4, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_4_robust <- get_est(Robustness_MLMA_MC_4) ################################################################################ ##################### Soil NPK availability ################################### # Filter abundance data metadata_NPKA <- metadata %>% filter(measurement_n == "Soil NPK availability") # Needed for metafor to make model equivalent to MCMCglmm metadata_NPKA$ES_ID<-as.factor(seq(1, nrow(metadata_NPKA), 1)) metadata_NPKA = metadata_NPKA %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_NPKA = metadata_NPKA %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_NPKA <- metadata_NPKA %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_NPKA <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_NPKA) metadata_NPKA <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_NPKA) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_NPKA <- metadata_NPKA %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_NPKA <- metadata_NPKA %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_NPKA <- metadata_NPKA %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_NPKA = metadata_NPKA %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_NPKA = metadata_NPKA %>% dplyr::filter(!outs(1/se, factor = 10)) ############################################ ################## Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_5<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_NPKA) MLMA_MC_res_5 <- get_est(MLMA_MC_5) Robustness_MLMA_MC_5 = robust(MLMA_MC_5, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_5_robust <- get_est(Robustness_MLMA_MC_5) ################################################################################ ########################## Potential CEC ################################### # Filter abundance data metadata_PCEC <- metadata %>% filter(measurement_n == "Potential CEC") # Needed for metafor to make model equivalent to MCMCglmm metadata_PCEC$ES_ID<-as.factor(seq(1, nrow(metadata_PCEC), 1)) metadata_PCEC = metadata_PCEC %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_PCEC = metadata_PCEC %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_PCEC <- metadata_PCEC %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_PCEC <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_PCEC) metadata_PCEC <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_PCEC) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_PCEC <- metadata_PCEC %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_PCEC <- metadata_PCEC %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_PCEC <- metadata_PCEC %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_PCEC = metadata_PCEC %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_PCEC = metadata_PCEC %>% dplyr::filter(!outs(1/se, factor = 10)) ################################################ ##################### Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_6<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_PCEC) MLMA_MC_res_6 <- get_est(MLMA_MC_6) Robustness_MLMA_MC_6 = robust(MLMA_MC_6, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_6_robust <- get_est(Robustness_MLMA_MC_6) ################################################################################ ########################## Effective CEC ################################### # Filter abundance data metadata_ECEC <- metadata %>% filter(measurement_n == "Effective CEC") # Needed for metafor to make model equivalent to MCMCglmm metadata_ECEC$ES_ID<-as.factor(seq(1, nrow(metadata_ECEC), 1)) metadata_ECEC = metadata_ECEC %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_ECEC = metadata_ECEC %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_ECEC <- metadata_ECEC %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_ECEC <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_ECEC) metadata_ECEC <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_ECEC) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_ECEC <- metadata_ECEC %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_ECEC <- metadata_ECEC %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_ECEC <- metadata_ECEC %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_ECEC = metadata_ECEC %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_ECEC = metadata_ECEC %>% dplyr::filter(!outs(1/se, factor = 10)) ################################################# ################# Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_7<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_ECEC) MLMA_MC_res_7 <- get_est(MLMA_MC_7) Robustness_MLMA_MC_7 = robust(MLMA_MC_7, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_7_robust <- get_est(Robustness_MLMA_MC_7) ################################################################################ ########################## Nutrient use efficiency ################################### # Filter abundance data metadata_NUE <- metadata %>% filter(measurement_n == "Nutrient use efficiency") # Needed for metafor to make model equivalent to MCMCglmm metadata_NUE$ES_ID<-as.factor(seq(1, nrow(metadata_NUE), 1)) metadata_NUE = metadata_NUE %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_NUE = metadata_NUE %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_NUE <- metadata_NUE %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_NUE <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_NUE) metadata_NUE <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_NUE) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_NUE <- metadata_NUE %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_NUE <- metadata_NUE %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_NUE <- metadata_NUE %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_NUE = metadata_NUE %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_NUE = metadata_NUE %>% dplyr::filter(!outs(1/se, factor = 10)) ########################################## ################## Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_8<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_NUE) MLMA_MC_res_8 <- get_est(MLMA_MC_8) Robustness_MLMA_MC_8 = robust(MLMA_MC_8, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_8_robust <- get_est(Robustness_MLMA_MC_8) ################################################################################ ########################## Mineral N leaching ################################### # Filter abundance data metadata_Leach <- metadata %>% filter(measurement_n == "Mineral N leaching") # Needed for metafor to make model equivalent to MCMCglmm metadata_Leach$ES_ID<-as.factor(seq(1, nrow(metadata_Leach), 1)) metadata_Leach = metadata_Leach %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_Leach = metadata_Leach %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_Leach <- metadata_Leach %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_Leach <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_Leach) metadata_Leach <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_Leach) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_Leach <- metadata_Leach %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_Leach <- metadata_Leach %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_Leach <- metadata_Leach %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_Leach = metadata_Leach %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_Leach = metadata_Leach %>% dplyr::filter(!outs(1/se, factor = 10)) ############################################ ################ Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_9<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_Leach) MLMA_MC_res_9 <- get_est(MLMA_MC_9) Robustness_MLMA_MC_9 = robust(MLMA_MC_9, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_9_robust <- get_est(Robustness_MLMA_MC_9) ################################################################################ ########################## crop yield ################################## # Filter abundance data metadata_Crop <- metadata %>% filter(measurement_n == "Food crop yield") # Needed for metafor to make model equivalent to MCMCglmm metadata_Crop$ES_ID<-as.factor(seq(1, nrow(metadata_Crop), 1)) metadata_Crop = metadata_Crop %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_Crop = metadata_Crop %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_Crop <- metadata_Crop %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_Crop <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_Crop) metadata_Crop <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_Crop) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_Crop <- metadata_Crop %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_Crop <- metadata_Crop %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_Crop <- metadata_Crop %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_Crop = metadata_Crop %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_Crop = metadata_Crop %>% dplyr::filter(!outs(1/se, factor = 10)) ############################################ ################# Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_10<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_Crop) MLMA_MC_res_10 <- get_est(MLMA_MC_10) Robustness_MLMA_MC_10 = robust(MLMA_MC_10, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_10_robust <- get_est(Robustness_MLMA_MC_10) ################################################################################ ########################## biomass production ################################### # Filter abundance data metadata_Biomass <- metadata %>% filter(measurement_n == "Biomass production") # Needed for metafor to make model equivalent to MCMCglmm metadata_Biomass$ES_ID<-as.factor(seq(1, nrow(metadata_Biomass), 1)) metadata_Biomass = metadata_Biomass %>% group_by(publication_title) %>% mutate(esid = row_number(), ID = cur_group_id()) %>% ungroup() metadata_Biomass = metadata_Biomass %>% mutate(unique_id = row_number()) # to create a unique ID # Calculate CV metadata_Biomass <- metadata_Biomass %>% mutate( cv_Control = na_if(control_sd / control_mean, Inf), cv_Experimental = na_if(treatment_sd / treatment_mean, Inf)) # Calculate the average between study CV, which will replace missing values. metadata_Biomass <- cv_avg(x = control_mean, sd = control_sd, n = control_n, group = publication_title, label = "1", data = metadata_Biomass) metadata_Biomass <- cv_avg(x = treatment_mean, sd = treatment_sd, n = treatment_n, group = publication_title, label = "2", data = metadata_Biomass) # Use weighted mean CV in replacement for where CV's are missing. Otherwise, # calculate CV^2 of data that is known. metadata_Biomass <- metadata_Biomass %>% mutate(cv2_cont_new = if_else(is.na(cv_Control), b_CV2_1, cv_Control^2), cv2_expt_new = if_else(is.na(cv_Experimental), b_CV2_2, cv_Experimental^2)) # Now calculate new yi and vi, called lnrr_laj & v_lnrr_laj, respectively. # This uses either the between individual CV^2 when missing or normal CV^2 when # not missing. metadata_Biomass <- metadata_Biomass %>% mutate(lnrr_laj = lnrr_laj(m1 = treatment_mean, m2 = control_mean, cv1_2 = cv2_expt_new, cv2_2 = cv2_cont_new, n1= treatment_n, n2 = control_n), v_lnrr_1A = v_lnrr_laj( cv1_2 = cv2_expt_new, n1= treatment_n, cv2_2 = cv2_cont_new, n2 = control_n)) # We need to exclude some missing data in the raw data set and data that is # not defined on the ratio scale. metadata_Biomass <- metadata_Biomass %>% filter(!is.infinite(lnrr_laj) & !is.na(lnrr_laj)) ################## metadata_Biomass = metadata_Biomass %>% mutate(se = sqrt(v_lnrr_1A) ) ############################################# metadata_Biomass = metadata_Biomass %>% dplyr::filter(!outs(1/se, factor = 10)) ###################################################### ############### Missing-cases Method: MLMA of missing SD effect sizes using pooled CV2 MLMA_MC_11<-rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random = ~ 1 | publication_title / ES_ID, method = "REML", data = metadata_Biomass) MLMA_MC_res_11 <- get_est(MLMA_MC_11) Robustness_MLMA_MC_res_11 = robust(MLMA_MC_11, cluster = ID, adjust = TRUE, verbose=TRUE, clubSandwich = TRUE) MLMA_MC_res_11_robust <- get_est(Robustness_MLMA_MC_res_11) ################## Forest plots ########################################### ################### Missing cases methods ################################# ######## Forest plot for pub correction random effects ################## metrics = metadata %>% pull(measurement_n)%>% unique() %>% na.omit() %>% magrittr::extract(!. %in% c("Food crop yield", "Biomass production")) ######## Robust estimation (Missing cases methods) meta_b_robust <- c(Robustness_MLMA_MC$b[1], Robustness_MLMA_MC_2$b[1], Robustness_MLMA_MC_3$b[1], Robustness_MLMA_MC_4$b[1], Robustness_MLMA_MC_5$b[1], Robustness_MLMA_MC_6$b[1], Robustness_MLMA_MC_7$b[1], Robustness_MLMA_MC_8$b[1], Robustness_MLMA_MC_9$b[1]) meta_se_robust <- c(Robustness_MLMA_MC$se[1], Robustness_MLMA_MC_2$se[1], Robustness_MLMA_MC_3$se[1], Robustness_MLMA_MC_4$se[1], Robustness_MLMA_MC_5$se[1], Robustness_MLMA_MC_6$se[1], Robustness_MLMA_MC_7$se[1], Robustness_MLMA_MC_8$se[1], Robustness_MLMA_MC_9$se[1]) obs_labels <- c("n=486", "n=236", "n=100", "n=53", "n=448", "n=37", "n=44", "n=23", "n=40") quartz();forest(x = meta_b_robust, sei = meta_se_robust, slab = paste(metrics, "(", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.4, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1), xlab = "Log Response ratio") ################### Robust crop & biomass production forest plot ############### metrics4_1 = metadata %>% pull(measurement_n)%>% unique() %>% na.omit() %>% magrittr::extract(!. %in% c("Soil total NPK", "Soil mineral nitrogen", "Plant nutrient level", "N2O emission", "Soil NPK availability", "Potential CEC", "Effective CEC", "Nutrient use efficiency", "Mineral N leaching")) Metarobust_b <- c(Robustness_MLMA_MC_res_11$b[1], Robustness_MLMA_MC_10$b[1]) Metarobust_se <- c(Robustness_MLMA_MC_res_11$se[1], Robustness_MLMA_MC_10$se[1]) obs_labels_1 <- c("n=21", "n=55") quartz();forest(x = Metarobust_b, sei = Metarobust_se, slab = paste(metrics4_1, " (", obs_labels_1, ")"), atransf = exp, cex = 0.9, at = log(c(0.5, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ################################################################################################ ############################### PUBLICATION BIAS ANALYSIS #################################### ################################# Soil Total NPK ################################################ ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_TNPK$inv_n_tilda <- with(metadata_TNPK, ((control_mean + treatment_mean)/control_mean*treatment_mean)) metadata_TNPK$sqrt_inv_n_tilda <- with(metadata_TNPK, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript Total_NPK_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_TNPK) Robustness_REML = robust(Total_NPK_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############## PET estimate ######################### Total_NPK_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_TNPK) Robustness_REML_PET = robust(Total_NPK_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ###################### PEESE estimates ################################ Total_NPK_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_TNPK) Robustness_REML_PEESE = robust(Total_NPK_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# Total_NPK_PUB_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_TNPK) Robustness_FE = robust(Total_NPK_PUB_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### Total_NPK_PUB_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1+ sqrt_inv_n_tilda, method = "FE", data=metadata_TNPK) Robustness_FE_PET = robust(Total_NPK_PUB_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### Total_NPK_PUB_PEESE_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1+ inv_n_tilda, method = "FE", data=metadata_TNPK) Robustness_FE_PEESE = robust(Total_NPK_PUB_PEESE_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_TNPK$lnrr_laj, metadata_TNPK$v_lnrr_1A, ni = metadata_TNPK$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_TNPK$unique_id) ######################################################################################################### ############################## Soil mineral nitrogen ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_SMN$inv_n_tilda <- with(metadata_SMN, (control_mean + treatment_mean)/(control_mean*treatment_mean) ) metadata_SMN$sqrt_inv_n_tilda <- with(metadata_SMN, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript Soil_mineral_nitrogen_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_SMN) Robustness_REML_SMN = robust(Soil_mineral_nitrogen_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### Soil_mineral_nitrogen_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_SMN) Robustness_REML_SMN_PET = robust(Soil_mineral_nitrogen_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### Soil_mineral_nitrogen_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_SMN) Robustness_REML_SMN_PEESE = robust(Soil_mineral_nitrogen_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# SMN_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_SMN) SMN_Robustness_FE = robust(SMN_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check PET ########### SMN_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_SMN) SMN_Robustness_FE_PET = robust(SMN_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check PEESE ########### SMN_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_SMN) SMN_Robustness_FE_PEESE = robust(SMN_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_SMN$lnrr_laj, metadata_SMN$v_lnrr_1A, ni = metadata_SMN$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_SMN$unique_id) ######################################################################################################### ############################## Plant nutrient level ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_PNL$inv_n_tilda <- with(metadata_PNL, (control_mean + treatment_mean)/(control_mean*treatment_mean)) metadata_PNL$sqrt_inv_n_tilda <- with(metadata_PNL, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript PNL_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PNL) Robustness_REML_PNL = robust(PNL_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### PNL_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PNL) Robustness_REML_PNL_PET = robust(PNL_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### PNL_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PNL) Robustness_REML_PNL_PEESE = robust(PNL_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# PML_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_PNL) PNL_Robustness_FE = robust(PML_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE And Robustness check for PET ########### PML_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_PNL) PNL_Robustness_FE_PET = robust(PML_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE And Robustness check for PET ########### PML_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_PNL) PNL_Robustness_FE_PEESE = robust(PML_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_PNL$lnrr_laj, metadata_PNL$v_lnrr_1A, ni = metadata_PNL$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_PNL$unique_id) ######################################################################################################### ############################## N2O emission ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_N2O$inv_n_tilda <- with(metadata_N2O, (control_mean + treatment_mean)/ (control_mean*treatment_mean)) metadata_N2O$sqrt_inv_n_tilda <- with(metadata_N2O, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript N2O_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_N2O) Robustness_REML_N2O = robust(N2O_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### N2O_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_N2O) Robustness_REML_N2O_PET = robust(N2O_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### N2O_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_N2O) Robustness_REML_N2O_PEESE = robust(N2O_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) funnel(metadata_N2O$lnrr, metadata_N2O$v, ni = metadata_N2O$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_N2O$unique_id) ####################### Fixed effects model ################# N2O_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_N2O) N2O_Robustness_FE = robust(N2O_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### N2O_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_N2O) N2O_Robustness_FE_PET = robust(N2O_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEESE ########### N2O_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_N2O) N2O_Robustness_FE_PEESE = robust(N2O_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_N2O$lnrr_laj, metadata_N2O$v_lnrr_1A, ni = metadata_N2O$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_N2O$unique_id) ######################################################################################################### ############################## Soil NPK availability ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_NPKA$inv_n_tilda <- with(metadata_NPKA, (control_mean + treatment_mean)/(control_mean*treatment_mean)) metadata_NPKA$sqrt_inv_n_tilda <- with(metadata_NPKA, sqrt(inv_n_tilda)) NPK_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NPKA) Robustness_REML_NPK = robust(NPK_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### NPK_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NPKA) Robustness_REML_NPK_PET = robust(NPK_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### NPK_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NPKA) Robustness_REML_NPK_PEESE = robust(NPK_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# NPK_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_NPKA) NPK_Robustness_FE = robust(NPK_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### NPK_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_NPKA) NPK_Robustness_FE_PET = robust(NPK_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEES ########### NPK_correction_FE_PEES = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_NPKA) NPK_Robustness_FE_PEES = robust(NPK_correction_FE_PEES, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_NPKA$lnrr_laj, metadata_NPKA$v_lnrr_1A, ni = metadata_NPKA$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_NPKA$unique_id) ######################################################################################################### ############################## Potential CEC ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_PCEC$inv_n_tilda <- with(metadata_PCEC, (control_mean + treatment_mean) /(control_mean*treatment_mean) ) metadata_PCEC$sqrt_inv_n_tilda <- with(metadata_PCEC, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript CECP_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PCEC) Robustness_REML_CECP = robust(CECP_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### CECP_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PCEC) Robustness_REML_CECP_PET = robust(CECP_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### CECP_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_PCEC) Robustness_REML_CECP_PEESE = robust(CECP_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# CECP_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_PCEC) CECP_Robustness_FE = robust(CECP_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### CECP_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_PCEC) CECP_Robustness_FE_PET = robust(CECP_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEESE ########### CECP_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_PCEC) CECP_Robustness_FE_PEESE = robust(CECP_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_PCEC$lnrr_laj, metadata_PCEC$v_lnrr_1A, ni = metadata_PCEC$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_PCEC$unique_id) ######################################################################################################### ############################## Effective CEC ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_ECEC$inv_n_tilda <- with(metadata_ECEC, ((control_mean + treatment_mean) /control_mean*treatment_mean)) metadata_ECEC$sqrt_inv_n_tilda <- with(metadata_ECEC, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript ECEC_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_ECEC) Robustness_REML_ECEC = robust(ECEC_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### ECEC_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_ECEC) Robustness_REML_ECEC_PET = robust(ECEC_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### ECEC_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_ECEC) Robustness_REML_ECEC_PEESE = robust(ECEC_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# ECEC_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_ECEC) ECEC_Robustness_FE = robust(ECEC_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### ECEC_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_ECEC) ECEC_Robustness_FE_PET = robust(ECEC_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEESE ########### ECEC_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_ECEC) ECEC_Robustness_FE_PEESE = robust(ECEC_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_ECEC$lnrr_laj, metadata_ECEC$v_lnrr_1A, ni = metadata_ECEC$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_ECEC$unique_id) ######################################################################################################### ############################## Nutrient use efficiency ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_NUE$inv_n_tilda <- with(metadata_NUE, ((control_mean + treatment_mean) / control_mean*treatment_mean)) metadata_NUE$sqrt_inv_n_tilda <- with(metadata_NUE, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript NUE_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NUE) Robustness_REML_NUE = robust(NUE_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### NUE_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NUE) Robustness_REML_NUE_PET = robust(NUE_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### NUE_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_NUE) Robustness_REML_NUE_PEESE = robust(NUE_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# NUE_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_NUE) NUE_Robustness_FE = robust(NUE_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### NUE_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_NUE) NUE_Robustness_FE_PET = robust(NUE_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEESE ########### NUE_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_NUE) NUE_Robustness_FE_PEESE = robust(NUE_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_NUE$lnrr_laj, metadata_NUE$v_lnrr_1A, ni = metadata_NUE$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_NUE$unique_id) ######################################################################################################### ############################## Mineral N leaching ########################################### ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_Leach$inv_n_tilda <- with(metadata_Leach, ((control_mean + treatment_mean) /control_mean*treatment_mean) ) metadata_Leach$sqrt_inv_n_tilda <- with(metadata_Leach, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript MNL_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Leach) Robustness_REML_MNL = robust(MNL_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PET ########### MNL_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Leach) Robustness_REML_MNL_PET = robust(MNL_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## REML and Robustness check for PEESE ########### MNL_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Leach) Robustness_REML_MNL_PEESE = robust(MNL_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ####################### Fixed effects model ################# MNL_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_Leach) MNL_Robustness_FE = robust(MNL_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PET ########### MNL_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, test = "t", method = "FE", data=metadata_Leach) MNL_Robustness_FE_PET = robust(MNL_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ######## FE and Robustness check for PEESE ########### MNL_correction_FE_PEESE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_Leach) MNL_Robustness_FE_PEESE = robust(MNL_correction_FE_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_Leach$lnrr_laj, metadata_Leach$v_lnrr_1A, ni = metadata_Leach$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_Leach$unique_id) ################################# Crop yield ################################################ ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_Crop$inv_n_tilda <- with(metadata_Crop, ((control_mean + treatment_mean)/control_mean*treatment_mean)) metadata_Crop$sqrt_inv_n_tilda <- with(metadata_Crop, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript crop_yield_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Crop) Robustness_crop_yield_REML = robust(crop_yield_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############## PET estimate ######################### crop_yield_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Crop) Robustness_crop_yield_REML_PET = robust(crop_yield_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ###################### PEESE estimates ################################ crop_yield_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Crop) Robustness_REML_crop_yield_PEESE = robust(crop_yield_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############################ FE crop yield ################################# crop_yield_PUB_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_Crop) Robustness_crop_yield_FE = robust(crop_yield_PUB_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############## PET estimate ######################### crop_yield_PUB_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_Crop) Robustness_crop_yield_FE_PET = robust(crop_yield_PUB_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ###################### PEESE estimates ################################ crop_yield_PUB_correction_PEESE_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_Crop) Robustness_FE_crop_yield_PEESE = robust(crop_yield_PUB_correction_PEESE_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) quartz(); funnel(metadata_Crop$lnrr_laj, metadata_Crop$v_lnrr_1A, ni = metadata_Crop$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_Crop$unique_id) ################################# Biomass production ################################################ ############################### Meta-regression with effective sampling size (uni-moderator) ################### # calculating the inverse of the "effective sample size" to account for unbalanced sampling for lnRR metadata_Biomass$inv_n_tilda <- with(metadata_Biomass, ((control_mean + treatment_mean)/control_mean*treatment_mean)) metadata_Biomass$sqrt_inv_n_tilda <- with(metadata_Biomass, sqrt(inv_n_tilda)) # Application of Equation 27 from the main manuscript Biomass_production_PUB = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Biomass) Robustness_Biomass_production_REML = robust(Biomass_production_PUB, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############## PET estimate ######################### Biomass_production_PUB_correction = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Biomass) Robustness_Biomass_production_REML_PET = robust(Biomass_production_PUB_correction, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ###################### PEESE estimates ################################ Biomass_production_PUB_correction_PEESE = metafor::rma.mv(yi = lnrr_laj, V = v_lnrr_1A, mods = ~ 1 + inv_n_tilda, random=list(~1|publication_title, ~1|ES_ID), method = "REML", data=metadata_Biomass) Robustness_REML_Biomass_production_PEESE = robust(Biomass_production_PUB_correction_PEESE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############################### FE biomass ################################# Biomass_production_PUB_FE = metafor::rma(lnrr_laj, v_lnrr_1A, method = "FE", data=metadata_Biomass) Robustness_Biomass_production_FE = robust(Biomass_production_PUB_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ############## PET estimate ######################### Biomass_production_PUB_correction_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + sqrt_inv_n_tilda, method = "FE", data=metadata_Biomass) Robustness_Biomass_production_FE_PET = robust(Biomass_production_PUB_correction_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) ###################### PEESE estimates ################################ Biomass_production_PUB_correction_PEESE_FE = metafor::rma(lnrr_laj, v_lnrr_1A, mods = ~ 1 + inv_n_tilda, method = "FE", data=metadata_Biomass) Robustness_FE_Biomass_production_PEESE = robust(Biomass_production_PUB_correction_PEESE_FE, cluster = ID, adjust = TRUE, clubSandwich = TRUE) funnel(metadata_Biomass$lnrr, metadata_Biomass$v, ni = metadata_Biomass$sqrt_inv_n_tilda, yaxis="ni", #xlim = c(-3, 3), ylab = "Square root of effective sample size", xlab = "Effect size (lnRR)", col = metadata_Biomass$unique_id) ################################################################################### ######## Forest plot for pub correction random effects (PET) ################## meta_pub_correc_b <- c(Total_NPK_PUB_correction$b[1], Soil_mineral_nitrogen_PUB_correction$b[1], PNL_PUB_correction$b[1], N2O_PUB_correction$b[1], NPK_PUB_correction$b[1], CECP_PUB_correction$b[1], ECEC_PUB_correction$b[1], NUE_PUB_correction$b[1], MNL_PUB_correction$b[1]) meta_pub_correc_se <- c(Total_NPK_PUB_correction$se[1], Soil_mineral_nitrogen_PUB_correction$se[1], PNL_PUB_correction$se[1], N2O_PUB_correction$se[1], NPK_PUB_correction$se[1], CECP_PUB_correction$se[1], ECEC_PUB_correction$se[1], NUE_PUB_correction$se[1], MNL_PUB_correction$se[1]) table(metadata$measurement_n) # Add the number of observations to the plot obs_labels <- c("n=486", "n=236", "n=100", "n=53", "n=448", "n=37", "n=44", "n=23", "n=40") quartz();forest(x = meta_pub_correc_b,sei = meta_pub_correc_se, slab = paste(metrics, " (", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.4, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ############################ Robust frop crop and biomass ################################## metrics4_1 = metadata %>% pull(measurement_n)%>% unique() %>% na.omit() %>% magrittr::extract(!. %in% c("Soil total NPK", "Soil mineral nitrogen", "Plant nutrient level", "N2O emission", "Soil NPK availability", "Potential CEC", "Effective CEC", "Nutrient use efficiency", "Mineral N leaching")) pub_robust_b <- c(Robustness_Biomass_production_REML$b[1], Robustness_crop_yield_REML$b[1]) pub_robust_se <- c(Robustness_Biomass_production_REML$se[1], Robustness_crop_yield_REML$se[1]) obs_labels_1 <- c("n=21", "n=55") quartz();forest(x = pub_robust_b, sei = pub_robust_se, slab = paste(metrics4_1, " (", obs_labels_1, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.5, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ########################################################################### ############################ Robust REML (Correted for ECEC and used in the manuscript) ################################## meta_pub_robust_b1 <- c(Robustness_REML$b[1], Robustness_REML_SMN$b[1], Robustness_REML_PNL$b[1], Robustness_REML_N2O$b[1], Robustness_REML_NPK$b[1], Robustness_REML_CECP$b[1], Robustness_REML_ECEC_PET$b[1], Robustness_REML_NUE$b[1], Robustness_REML_MNL$b[1]) meta_pub_robust_se1 <- c(Robustness_REML$se[1], Robustness_REML_SMN$se[1], Robustness_REML_PNL$se[1], Robustness_REML_N2O$se[1], Robustness_REML_NPK$se[1], Robustness_REML_CECP$se[1], Robustness_REML_ECEC_PET$se[1], Robustness_REML_NUE$se[1], Robustness_REML_MNL$se[1]) obs_labels <- c("n=486", "n=236", "n=100", "n=53", "n=448", "n=37", "n=44", "n=23", "n=40") quartz();forest(x = meta_pub_robust_b1, sei = meta_pub_robust_se1, slab = paste(metrics, " (", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.4, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ############################ Robust REML PET ################################## meta_pub_robust_b <- c(Robustness_REML_PET$b[1], Robustness_REML_SMN_PET$b[1], Robustness_REML_PNL_PET$b[1], Robustness_REML_N2O_PET$b[1], Robustness_REML_NPK_PET$b[1], Robustness_REML_CECP_PET$b[1], Robustness_REML_ECEC_PET$b[1], Robustness_REML_NUE_PET$b[1], Robustness_REML_MNL_PET$b[1]) meta_pub_robust_se <- c(Robustness_REML_PET$se[1], Robustness_REML_SMN_PET$se[1], Robustness_REML_PNL_PET$se[1], Robustness_REML_N2O_PET$se[1], Robustness_REML_NPK_PET$se[1], Robustness_REML_CECP_PET$se[1], Robustness_REML_ECEC_PET$se[1], Robustness_REML_NUE_PET$se[1], Robustness_REML_MNL_PET$se[1]) obs_labels <- c("n=486", "n=236", "n=100", "n=53", "n=448", "n=37", "n=44", "n=23", "n=40") quartz();forest(x = meta_pub_robust_b, sei = meta_pub_robust_se, slab = paste(metrics, " (", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.45, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ############################ Robust REML PET frop crop and biomass ################################## metrics4_1 = metadata %>% pull(measurement_n)%>% unique() %>% na.omit() %>% magrittr::extract(!. %in% c("Soil total NPK", "Soil mineral nitrogen", "Plant nutrient level", "N2O emission", "Soil NPK availability", "Potential CEC", "Effective CEC", "Nutrient use efficiency", "Mineral N leaching")) PET_pub_robust_b <- c(Robustness_Biomass_production_REML_PET$b[1], Robustness_crop_yield_REML_PET$b[1]) PET_pub_robust_se <- c(Robustness_Biomass_production_REML_PET$se[1], Robustness_crop_yield_REML_PET$se[1]) table(metadata_1$measurement_n) obs_labels_1 <- c("n=21", "n=55") quartz();forest(x = PET_pub_robust_b, sei = PET_pub_robust_se, slab = paste(metrics4_1, " (", obs_labels_1, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.5, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ############################ Robust REML PEESE ################################## meta_pub_robust_PEESE_b <- c(Robustness_REML_PEESE$b[1], Robustness_REML_SMN_PEESE$b[1], Robustness_REML_PNL_PEESE$b[1], Robustness_REML_N2O_PEESE$b[1], Robustness_REML_NPK_PEESE$b[1], Robustness_REML_CECP_PEESE$b[1], Robustness_REML_ECEC_PEESE$b[1], Robustness_REML_NUE_PEESE$b[1], Robustness_REML_MNL_PEESE$b[1]) meta_pub_robust_PEESE_se <- c(Robustness_REML_PEESE$se[1], Robustness_REML_SMN_PEESE$se[1], Robustness_REML_PNL_PEESE$se[1], Robustness_REML_N2O_PEESE$se[1], Robustness_REML_NPK_PEESE$se[1], Robustness_REML_CECP_PEESE$se[1], Robustness_REML_ECEC_PEESE$se[1], Robustness_REML_NUE_PEESE$se[1], Robustness_REML_MNL_PEESE$se[1]) obs_labels <- c("n=486", "n=236", "n=100", "n=53", "n=448", "n=37", "n=44", "n=23", "n=40") quartz();forest(x = meta_pub_robust_PEESE_b, sei = meta_pub_robust_PEESE_se, slab = paste(metrics, " (", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.45, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ############################ Robust REML PEESE frop crop and biomass ################################## PEESE_pub_robust_b <- c(Robustness_REML_crop_yield_PEESE$b[1], Robustness_REML_Biomass_production_PEESE$b[1]) PEESE_pub_robust_se <- c(Robustness_REML_crop_yield_PEESE$se[1], Robustness_REML_Biomass_production_PEESE$se[1]) obs_labels_1 <- c("n=21", "n=55") quartz();forest(x = PEESE_pub_robust_b, sei = PEESE_pub_robust_se, slab = paste(metrics4_1, " (", obs_labels_1, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.5, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ################## Fixed effects ################################### meta_pub_correc_FE_b <- c(Total_NPK_PUB_correction_FE$b[1], SMN_correction_FE$b[1], PML_correction_FE$b[1], Robustness_REML_N2O$b[1], NPK_correction_FE$b[1], CECP_correction_FE$b[1], ECEC_correction_FE$b[1], NUE_correction_FE$b[1], MNL_correction_FE$b[1]) meta_pub_correc_FE_se <- c(Total_NPK_PUB_correction_FE$se[1], SMN_correction_FE$se[1], PML_correction_FE$se[1], N2O_correction_FE$se[1], NPK_correction_FE$se[1], CECP_correction_FE$se[1], ECEC_correction_FE$se[1], NUE_correction_FE$se[1], MNL_correction_FE$se[1]) obs_labels <- c("486", "236", "100", "53", "448", "37", "44", "23", "40") quartz();forest(x = meta_pub_correc_FE_b, sei = meta_pub_correc_FE_se, slab = paste(metrics, " (", obs_labels, ")"), # Modify the slab argument atransf = exp, cex = 0.9, at = log(c(0.45, 1.0, 1.5, 2.0)), header = "Ecosystem processes", xlim = c(-1.40, 1)) ########################################################################################### ################### META REGRESSION ANALYSIS ############################################# ####################### LASSO ANALYSIS ################################################ Lasso_data = readxl::read_excel("Additional file 9. Data-extraction sheet.xlsx", sheet = "Sheet1", na = "NA") Lasso_data = Lasso_data%>% mutate(Biochar_app_rate = cut(application_rate, breaks = c(0, 10, 30, 50, 250), labels = c("BiocharRate_0_10", "BiocharRate_10_30", "BiocharRate_30_50", "BiocharRate_50_210")), fertilizer_app_rate = as.numeric(fertilizer_app_rate), Fertilizer_app_rate = cut(fertilizer_app_rate, breaks = c(0, 30, 120, 250, 600), labels = c("FertilizerRate_0_30", "FertilizerRate_30_120", "FertilizerRate_120_250", "FertilizerRate_250_600")), duration_exp = as.numeric(duration_exp), Experiment_duration = cut(duration_exp, breaks = c(0, 200, 600, 1000, 1500, 2500), labels = c("Duration_0_200", "Duration_200_600", "Duration_600_1000", "Duration_1000_1500", "Duration_1500_2500")), Soil_pH = as.numeric(Soil_pH), Soil_pH = cut(Soil_pH, breaks = c(0, 5.5, 6.5, 7.5, 8.5, 9.5), labels = c("SoilpH_0_5.6", "SoilpH_5.6_6.5", "SoilpH_6.5_7.5", "SoilpH_7.5_8.5", "SoilpH_8.5_9.5"))) Lasso_data = Lasso_data %>% mutate(greenhouse = ifelse(greenhouse == "No",0,1), lab = ifelse(lab == "No",0,1), field = ifelse(field == "No",0,1), woody_biomass = ifelse(woody_biomass == "No",0,1), manure_digestate = ifelse(manure_digestate == "No",0,1), agricultural_residue = ifelse(agricultural_residue == "No",0,1), fertilizer_app = ifelse(fertilizer_app == "No",0,1), manure_app = ifelse(manure_app == "No",0,1), compost_app = ifelse(compost_app == "No",0,1), NPK_before_biochar_after_all = ifelse(NPK_before_biochar_after_all == "No",0,1), manure_before_biochar_after_all = ifelse(manure_before_biochar_after_all == "No",0,1), irrigated_all = ifelse(irrigated_all == "No",0,1), tillage_all = ifelse(tillage_all == "No",0,1)) Lasso_data$inv_n_tilda <- with(Lasso_data, ((control_mean + treatment_mean)/control_mean*treatment_mean)) Lasso_data$sqrt_inv_n_tilda <- with(Lasso_data, sqrt(inv_n_tilda)) ################################################### ##################### TOTAL NPK ######################### Lasso_data_1 = Lasso_data %>% filter(measurement_n == "Soil total NPK") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_TotalNPK <- Lasso_data_1 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America")%>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Coarse_sand = "Coarse sand", Loamy_sand = "Loamy sand", Loamy_soil = "Loamy soil", Sandy_clay_loam = "Sandy clay loam") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Oceania, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_TotalNPK = function(x) { probabilities = stabs::stabsel(x = Lasso_data_TotalNPK %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_TotalNPK %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_TotalNPK, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_2 = map_dfr(q_range_1,~ tryout1_TotalNPK(.x)) ## no filter sample_2 = sample_2 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_2 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_2$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_2_selected = sample_2 %>% filter(!is.na(check)) ggplot(sample_2_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_2_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ################################################################################## ###################### SOIL MINERAL NITROGEN ################################### Lasso_data_2 = Lasso_data %>% filter(measurement_n == "Soil mineral nitrogen") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_TotalSMN <- Lasso_data_2 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America")%>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Coarse_sand = "Coarse sand", Loamy_sand = "Loamy sand", Loamy_soil = "Loamy soil", Sandy_clay_loam = "Sandy clay loam") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Oceania, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"", -average_precipitation, -annual_temp, -C_content) ################## tryout1_SMN = function(x) { probabilities = stabs::stabsel(x = Lasso_data_TotalSMN %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_TotalSMN %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_TotalSMN, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_3 = map_dfr(q_range_1,~ tryout1_SMN(.x)) ## no filter sample_3 = sample_3 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_3 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_3$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_3_selected = sample_3 %>% filter(!is.na(check)) ggplot(sample_3_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_3_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ######################################################################## ##################### PLANT NUTRIENT LEVEL ####################################### Lasso_data_3 = Lasso_data %>% filter(measurement_n == "Plant nutrient level") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_PNL <- Lasso_data_3 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America")%>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Coarse_sand = "Coarse sand", Loamy_sand = "Loamy sand", Loamy_soil = "Loamy soil", Sandy_clay_loam = "Sandy clay loam") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Oceania, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"", -average_precipitation, -annual_temp, -C_content) ################## tryout1_PNL = function(x) { probabilities = stabs::stabsel(x = Lasso_data_PNL %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_PNL %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_PNL, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_4 = map_dfr(q_range_1,~ tryout1_PNL(.x)) ## no filter sample_4 = sample_4 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_4 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_4$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_4_selected = sample_4 %>% filter(!is.na(check)) ggplot(sample_4_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_4_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() #################################################################################### ################################# N2O EMISSION ##################################### Lasso_data_4 = Lasso_data %>% filter(measurement_n == "N2O emission") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_N2O <- Lasso_data_4 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Oceania, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_N2O = function(x) { probabilities = stabs::stabsel(x = Lasso_data_N2O %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_N2O %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_N2O, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_5 = map_dfr(q_range_1,~ tryout1_N2O(.x)) ## no filter sample_5 = sample_5 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_5 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_5$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_5_selected = sample_5 %>% filter(!is.na(check)) ggplot(sample_5_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_5_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ############################################################################################## ############################### NPK AVAILABILITY ############################################# Lasso_data_5 = Lasso_data %>% filter(measurement_n == "Soil NPK availability") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_NPKAvail <- Lasso_data_5 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America")%>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Coarse_sand = "Coarse sand", Loamy_sand = "Loamy sand", Loamy_soil = "Loamy soil", Sandy_clay_loam = "Sandy clay loam", Coarse_loamy = "Coarse loamy") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Oceania, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_NPKAail = function(x) { probabilities = stabs::stabsel(x = Lasso_data_NPKAvail %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_NPKAvail %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_NPKAvail, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_6 = map_dfr(q_range_1,~ tryout1_NPKAail(.x)) ## no filter sample_6 = sample_6 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_6 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_6$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_6_selected = sample_6 %>% filter(!is.na(check)) ggplot(sample_6_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_6_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ############################################################################################## ################################ POTENTIAL CEC ############################################### Lasso_data_6 = Lasso_data %>% filter(measurement_n == "Potential CEC") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_PCEC <- Lasso_data_6 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America") %>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Loamy_sand = "Loamy sand", Loamy_soil = "Loamy soil") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_PCEC = function(x) { probabilities = stabs::stabsel(x = Lasso_data_PCEC %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_PCEC %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_PCEC, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_7 = map_dfr(q_range_1,~ tryout1_PCEC(.x)) ## no filter sample_7 = sample_7 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_7 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_7$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_7_selected = sample_7 %>% filter(!is.na(check)) ggplot(sample_7_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_7_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ################################################################################################# ######################## EFFECTIVE CEC ###################################################### Lasso_data_7 = Lasso_data %>% filter(measurement_n == "Effective CEC") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_ECEC <- Lasso_data_7 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% rename(North_America = "North America", South_America = "South America") %>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil", Loamy_sand = "Loamy sand") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Asia, -Europe, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_ECEC = function(x) { probabilities = stabs::stabsel(x = Lasso_data_ECEC %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_ECEC %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_ECEC, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_8 = map_dfr(q_range_1,~ tryout1_ECEC(.x)) ## no filter sample_8 = sample_8 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_8 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_8$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_8_selected = sample_8 %>% filter(!is.na(check)) ggplot(sample_8_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_8_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ############################################################################################## ############################ MINERAL N LEACHING ############################################# Lasso_data_8 = Lasso_data %>% filter(measurement_n == "Mineral N leaching") %>% droplevels %>% filter(!is.na(lnrr)) Lasso_data_Nleach <- Lasso_data_8 %>% mutate(dummy = 1) %>% spread(key = continent, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = soil_texture, value = dummy, fill = 0) %>% rename(Sandy_loam = "Sandy loam", Sandy_soil = "Sandy soil") %>% mutate(dummy = 1) %>% spread(key = Pyrolysis_temperature, value = dummy, fill = 0) %>% rename(pyrolysisTemp_High = "High", pyrolysisTemp_Low = "Low", pyrolysisTemp_Medium = "Medium") %>% mutate(dummy = 1) %>% spread(key = Experiment_duration, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Biochar_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Fertilizer_app_rate, value = dummy, fill = 0) %>% mutate(dummy = 1) %>% spread(key = Soil_pH, value = dummy, fill = 0) %>% select(-Biochar_pH, -rr, -treatment_mean, -control_mean, average_precipitation, number_of_replicates, -c("lab", "agricultural_residue", "compost_app"), manure_before_biochar_after_all, -compost_app_rate, -measurement_n, greenhouse, field, -duration_exp, woody_biomass, manure_digestate, -temp, C_content, -application_rate, fertilizer_app, fertilizer_app_rate, manure_app, manure_app_rate, soil_sample_depth_min, soil_sample_depth_max, -NPK_before_biochar_after_all, irrigated_all, tillage_all, Oceania, Europe, Sandy_loam, -Sandy_soil, -fertilizer_app_rate, -inv_n_tilda, -"") %>% select(-average_precipitation, -annual_temp, -C_content) ################## tryout1_Nleach = function(x) { probabilities = stabs::stabsel(x = Lasso_data_Nleach %>% # Randomised Lasso select(-(lnrr)) %>% as.matrix(), y = Lasso_data_Nleach %>% pull(lnrr), fitfun = stabs::glmnet.lasso, q = x, cutoff = 0.9) %>% magrittr::extract2("max") %>% # named vector as_tibble(rownames = "var") %>% rename(prob = "value") selected_variables = probabilities %>% arrange(desc(prob)) %>% slice(1:x) %>% pull(var) coefficients = glm(formula =paste0("lnrr ~ ", paste(selected_variables, collapse = "+")) %>% as.formula(), data = Lasso_data_Nleach, family = "gaussian") %>% coef() %>% magrittr::extract(names(.)!="(Intercept)") %>% as_tibble(rownames = "var") %>% rename(estimate = value) %>% mutate(sign = ifelse(estimate > 0, 1, -1)) full_join(probabilities, # common variables are kept only coefficients) %>% mutate(modelsize = x) } q_range_1 = 1:5 # we have limited observations at the article level thus we look at the smaller model size sample_9 = map_dfr(q_range_1,~ tryout1_Nleach(.x)) ## no filter sample_9 = sample_9 %>% filter(var!="") %>% group_by(var) %>% mutate(check = mean(estimate, na.rm=T), prob_mean = mean(prob, na.rm=T)) %>% ungroup() %>% arrange(desc(prob_mean)) %>% mutate(name = var, name = factor(name, levels = unique(name)), name = factor(name, levels = rev(unique(levels(name)))), symbol = case_when( sign==1 ~ "+", sign== -1 ~ "-", is.na(sign) ~ "" )) ggplot(sample_9 %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_9$prob > 0.35, "black", "white")) + theme_bw() + coord_equal() ### filtering only selected ones sample_9_selected = sample_9 %>% filter(!is.na(check)) ggplot(sample_9_selected %>% arrange(desc(prob)), aes(modelsize, name, fill = prob, label = symbol)) + geom_tile(color = "white") + labs(x = "Model size", y = "") + scale_fill_viridis_c(name = "Probability") + geom_text(color = ifelse(sample_9_selected$prob > 0.35, "black", "white")) + theme_bw() + coord_equal()