# WP5 Simulation # Version 14 # Sensitivity Simulation with Human Data # Note: the following changes have been made to the pre-registered code. # (1) Line 112: in one of the new data sets there was a missing value # for the sd of the control group in one study. This was dealt with the # same way as zero sd values were treated. # (2) Line 139-140: The human data contained cases where the group size of # the control group was 1. This has not happened with the pilot data set. # We generally said, that for the simulation the minimal sample size is 2. # Therefore, now any n=1 in the data is replaced by the minimal allowed # sample size of n=2. # (3) Line 224: Precaution was taken that the estimate from the meta analysis is # always positive. library(here) library(lme4) library(readxl) library(metafor) here::i_am("Sensitivity_Sim_14_humans.R") set.seed(1066) # to be used for the final simulation # Preamble ------------------------------------------------------------------------------- # # This script is written to run a simulation study to probe whether statistical and # design interventions improve the reproducibility of intervention studies in biomedical # research. # # Study: a study is described by a vector of length 6 giving sample size, mean, and # standard deviation and of each of two groups. The group with the larger mean value is # by definition called the "treatment" group and the group with the smaller mean value # is called by definition the "control" group. Variable names are n_treatment, # mean_treatment, sd_treatment, n_control, mean_control, and sd_control. # # Set of studies: Studies combined in data frame with column names n_treatment, # mean_treatment, sd_treatment, n_control, mean_control, and sd_control. Each row # represents one study. # # n: number of subjects in a treatment arm # sd: standard deviation # # Constants ----------------------------------------------------------------------------- # # The standard rejection threshold is 0.025 for one sided tests alpha <- 0.025 # For the minimally important difference we seek the sample size required to achieve a power # of 0.8 (mid_n_08) or of 0.9 (min_n_09) given a standardized effect sizes of d=0.2, 0.5 and # 1.0 and a one sided alpha threshold of 0.025: mid_s_n_08 <- ceiling(power.t.test(d = 0.2, sig.level = alpha, power = 0.8 , type = "two.sample", alternative = "one.sided")$n) mid_s_n_09 <- ceiling(power.t.test(d = 0.2, sig.level = alpha, power = 0.9 , type = "two.sample", alternative = "one.sided")$n) mid_m_n_08 <- ceiling(power.t.test(d = 0.5, sig.level = alpha, power = 0.8 , type = "two.sample", alternative = "one.sided")$n) mid_m_n_09 <- ceiling(power.t.test(d = 0.5, sig.level = alpha, power = 0.9 , type = "two.sample", alternative = "one.sided")$n) mid_l_n_08 <- ceiling(power.t.test(d = 1, sig.level = alpha, power = 0.8 , type = "two.sample", alternative = "one.sided")$n) mid_l_n_09 <- ceiling(power.t.test(d = 1, sig.level = alpha, power = 0.9 , type = "two.sample", alternative = "one.sided")$n) # # For small values of d, the function power.t.test gives prohibitively large sample # sizes (n > 1000). This is unfeasible for human studies. We, therefore want to # set limits for the sample size. A lower limit was set to 2 subjects per group. max_size <- 315 # The sample size # is be based on 5*the max sample # size in all data sets, where separate values are calculated for pre-clinical # and clinical studies. min_size <- 2 # If calculated sample size is below the threshold, the sample # size is set to 2 per group # Reducing the alpha threshold to 0.0025 (one-sided) requires adjustment of the sample # size by a factor of (approximately) 1.7, if the power is to be kept unchanged. sig_adj_005 <- 1.7 # Threshold value for Edgington's p-value edgington_threshold <- alpha * sqrt(2) # number of runs for the simulation #runs <- 1000000 # Loading functions -------------------------------------------------------------------- # all required functions are in the file "Sim_functions.R" source("Sim_functions_14.R") # Data import and curation ------------------------------------------------------------- df <- read.csv("Human_Data.csv",sep=";",dec=".",fill=TRUE,na.strings="NA",row.names = NULL,as.is=TRUE) attach(df) df$n_treatment<-as.numeric(df$n_treatment) df$mean_treatment<-as.numeric(df$mean_treatment) df$sd_treatment<-as.numeric(df$sd_treatment) df$n_control<-as.numeric(df$n_control) df$mean_control<-as.numeric(df$mean_control) df$sd_control<-as.numeric(df$sd_control) df$data_set<-as.numeric(df$data_set) df[is.na(df)]<-0 # data set 8 contained one NA value in the column # sd_control. This is replaced by zero. See below # regarding further treatment of zero sds. # In a few cases reported SD was zero. This is unlikely to be the true # SD for the population, and furthermore it makes problems for the simulation for # null differences. In those cases, assuming equal variances, a zero value # for the control group is replaced by the reported SD value for the treatment # group and a zero value of the treatment group is replaced by the reported # SD value from the control group. Data sets where the SD for both groups is # reported to be zero will be excluded from the analysis. # This replaces zero SDs: zero_sd <- 0 for(i in 1:dim(df)[1]){ if(df[i,]$sd_control<=0){ df[i,]$sd_control<-df[i,]$sd_treatment zero_sd <- zero_sd+1 } if(df[i,]$sd_treatment<=0){ df[i,]$sd_treatment<-df[i,]$sd_control zero_sd <- zero_sd+1 } } print(paste0("Number of cases of SD=0: ",zero_sd)) # This removes studies that still contain zero SDs: stud_num <- dim(df)[1] df <- subset(df, sd_control != 0) remov <- stud_num - dim(df)[1] print(paste0("Number of cases removed because both sd were zero: ",remov)) # In Sanchez et al 2014, the same control group was used for 4 treatments. # The authors seemingly provide a 'corrected' sample size for the control # group of 4.5. We don't do this, but take the actual sizer of the control # group. df[81,6] <-9 df[82,6] <-9 df[83,6] <-9 df[84,6] <-9 # In this case we cannot reconstruct where the 8.5 for n is coming from. Entry # 675 might be a typo (8.5 instead of 5), but as we don't know the safer option # is to stick with the reported number and just ignore the 0.5. df[674,6] <-floor(df[674,6]) df[676,6] <-floor(df[676,6]) df[677,6] <-floor(df[677,6]) df[674,3] <-floor(df[674,3]) df[676,3] <-floor(df[676,3]) df[677,3] <-floor(df[677,3]) # Replacing sample size of 1 by the min sample size of 2 df$n_control[df$n_control<2]<-min_size df$n_treatment[df$n_treatment<2]<-min_size # For each dataset we are running a random effect meta-analysis using the # function rma from the metafor package. metaeffects<-c() for(q in unique(df$data_set)){ # Get rows belonging to study q ds<-df[df$data_set==q,] # Transform to SMD scale esc<-escalc(measure="SMD", m2i=mean_control, sd2i=sd_control, n2i=n_control, m1i=mean_treatment, sd1i=sd_treatment, n1i=n_treatment, data=ds,vtype="LS") # Perform random effect MA metamodel<-rma(esc$yi, esc$vi) # Extract relevant parameters metaeffects <- rbind(metaeffects, c("study_id" = q, "estimate" = metamodel$b, "lb_ci" = metamodel$ci.lb, "ub_ci" = metamodel$ci.ub, "significant" = metamodel$pval < 0.05, "se_estimate" = metamodel$se, "i_squared" = metamodel$I2, "q_test" = metamodel$QE, "q_test_pval" = metamodel$QEp, "tau_squared" = metamodel$tau2)) } # The matrix "metaeffects" gives in each row the data set number effect size estimate, # lower CI, upper CI, p-value, standard error, I-squared, Q, p-vaue for Q, and tau-squared # in this order. # Only those datasets are kept, where the meta-analysis found a significant effect # in either direction (p<0.05, two-sided): metaeffects <- metaeffects[metaeffects[,"significant"]==1,] df<-df[!is.na(match(df$data_set,unique(metaeffects[,"study_id"]))),] # The vector data_set_numbers gives the ID numbers of the data sets to be included in # the simulation study. data_set_numbers <- unique(metaeffects[,"study_id"]) # A logical vector "metaeffects_direction" is created with TRUE indicating a positive # effect, i.e. mean treatment > mean control, and FALSE otherwise for each data set. metaeffect_direction <- metaeffects[,"estimate"] > 0 # Simulation ----------------------------------------------------------------------- # The data frame for the simulation outcome is created: humans_out <- data.frame(matrix(ncol = 269, nrow = 0)) sample_sizes_out <- data.frame(matrix(ncol = 21, nrow = 0)) # For Sensitivity: those dataets had more than 10% warning messages # only for those do we run the sensitivity analysis high_warnings <-c(2,3,9,12,26) requ_runs <- c(118000,196000,115000,124000,122000,112000, 108000,122000,105000,105000,107000,131000,109000,105000, 106000,124000,450000,500000,132000,105000,110000,105000, 131000,105000,161000,113000,125000,105000,105000,105000, 161000,127000,149000,105000) for(q in 1:length(data_set_numbers)){ runs <- requ_runs[q] print(q) print(data_set_numbers[q]) # The data set is selected ds <- df[df$data_set==data_set_numbers[q],] # Extract the important information all_studies <-data.frame(ds$n_treatment,ds$mean_treatment,ds$sd_treatment, ds$n_control,ds$mean_control,ds$sd_control) # Naming variables # if-else takes care that the group with the larger mean is referred to # as the treatment group. I.e. the effect is always positive if(metaeffect_direction[q] == TRUE){ names(all_studies)<-c("n_treatment","mean_treatment","sd_treatment","n_control", "mean_control","sd_control") } else { names(all_studies)<-c("n_control","mean_control","sd_control","n_treatment", "mean_treatment","sd_treatment") } # 95% CI from the overall meta analysis # As the effect is by definition always positive, the CI is # also mirrored in case of a negative meta effect if(metaeffects[q,2]>0){ meta_ci_lb <- metaeffects[q,3] meta_ci_ub <- metaeffects[q,4] } else { meta_ci_lb <-metaeffects[q,4]*(-1) meta_ci_ub <- metaeffects[q,3]*(-1) } meta_mean <- abs(metaeffects[q,2]) # adding data frame for recording sample sizes: all_recorded_sample_sizes <<- data.frame(matrix(ncol = 21, nrow = 0)) # The simulation is run sim_out <- replicate(n = runs, simulate_function(all_studies), simplify = TRUE) sim_out <- apply(sim_out,2, as.numeric) # Variables of sim_out are named df_sim_out <- as.data.frame(t(sim_out)) names(df_sim_out) <- c( "t_test_effect_p", "t_test_effect_means_diff", "t_test_effect_ci_lower", "t_test_effect_ci_upper", "t_test_effect_df", "t_test_effect_coverage", "rule_ten_effect_p", "rule_ten_effect_means_diff", "rule_ten_effect_ci_lower", "rule_ten_effect_ci_upper", "rule_ten_effect_df", "rule_ten_effect_coverage", "large_sample_effect_p", "large_sample_effect_means_diff", "large_sample_effect_ci_lower","large_sample_effect_ci_upper", "large_sample_effect_df", "large_sample_effect_coverage", "005_effect_p", "005_effect_means_diff", "005_effect_ci_lower", "005_effect_ci_upper", "005_effect_df", "005_effect_coverage", "005_adj_effect_p", "005_adj_effect_means_diff", "005_adj_effect_ci_lower", "005_adj_effect_ci_upper", "005_adj_effect_df", "005_adj_effect_coverage", "power_one_08_effect_p", "power_one_08_effect_means_diff", "power_one_08_effect_ci_lower", "power_one_08_effect_ci_upper", "power_one_08_effect_df", "power_one_08_effect_coverage", "power_one_09_effect_p", "power_one_09_effect_means_diff", "power_one_09_effect_ci_lower", "power_one_09_effect_ci_upper", "power_one_09_effect_df", "power_one_09_effect_coverage", "power_meta_08_effect_p", "power_meta_08_effect_means_diff", "power_meta_08_effect_ci_lower", "power_meta_08_effect_ci_upper", "power_meta_08_effect_df", "power_meta_08_effect_coverage", "power_meta_09_effect_p", "power_meta_09_effect_means_diff", "power_meta_09_effect_ci_lower", "power_meta_09_effect_ci_upper", "power_meta_09_effect_df", "power_meta_09_effect_coverage", "mid_s_08_effect_p", "mid_s_08_effect_means_diff", "mid_s_08_effect_ci_lower", "mid_s_08_effect_ci_upper", "mid_s_08_effect_df", "mid_s_08_effect_coverage", "mid_s_09_effect_p", "mid_s_09_effect_means_diff", "mid_s_09_effect_ci_lower", "mid_s_09_effect_ci_upper", "mid_s_09_effect_df","mid_s_09_effect_coverage", "mid_m_08_effect_p", "mid_m_08_effect_means_diff", "mid_m_08_effect_ci_lower", "mid_m_08_effect_ci_upper", "mid_m_08_effect_df", "mid_m_08_effect_coverage", "mid_m_09_effect_p", "mid_m_09_effect_means_diff", "mid_m_09_effect_ci_lower", "mid_m_09_effect_ci_upper", "mid_m_09_effect_df","mid_m_09_effect_coverage", "mid_l_08_effect_p", "mid_l_08_effect_means_diff", "mid_l_08_effect_ci_lower", "mid_l_08_effect_ci_upper", "mid_l_08_effect_df", "mid_l_08_effect_coverage", "mid_l_09_effect_p", "mid_l_09_effect_means_diff", "mid_l_09_effect_ci_lower", "mid_l_09_effect_ci_upper", "mid_l_09_effect_df","mid_l_09_effect_coverage", "rlm_effect_p", "rlm_effect_means_diff", "rlm_effect_ci_lower", "rlm_effect_ci_upper", "rlm_effect_df", "rlm_effect_coverage", "rlm_power_08_effect_p", "rlm_power_08_effect_means_diff", "rlm_power_08_effect_ci_lower", "rlm_power_08_effect_ci_upper", "rlm_power_08_effect_df", "rlm_power_08_effect_coverage", "rlm_power_09_effect_p", "rlm_power_09_effect_means_diff", "rlm_power_09_effect_ci_lower", "rlm_power_09_effect_ci_upper", "rlm_power_09_effect_df", "rlm_power_09_effect_coverage", "multi_lab_effect_p", "multi_lab_effect_means_diff", "multi_lab_effect_ci_lower", "multi_lab_effect_ci_upper", "multi_lab_effect_df", "multi_lab_effect_coverage", "multi_lab_08_effect_p", "multi_lab_08_effect_means_diff", "multi_lab_08_effect_ci_lower", "multi_lab_08_effect_ci_upper", "multi_lab_08_effect_df", "multi_lab_08_effect_coverage", "multi_lab_09_effect_p", "multi_lab_09_effect_means_diff", "multi_lab_09_effect_ci_lower", "multi_lab_09_effect_ci_upper", "multi_lab_09_effect_df", "multi_lab_09_effect_coverage", "t_test_null_p", "t_test_null_means_diff", "t_test_null_ci_lower", "t_test_null_ci_upper", "t_test_null_df", "t_test_null_coverage", "rule_ten_null_p", "rule_ten_null_means_diff", "rule_ten_null_ci_lower", "rule_ten_null_ci_upper", "rule_ten_null_df", "rule_ten_null_coverage", "large_sample_null_p", "large_sample_null_means_diff", "large_sample_null_ci_lower", "large_sample_null_ci_upper", "large_sample_null_df", "large_sample_null_coverage", "005_null_p", "005_null_means_diff", "005_null_ci_lower", "005_null_ci_upper", "005_null_df", "005_null_coverage", "005_adj_null_p", "005_adj_null_means_diff", "005_adj_null_ci_lower", "005_adj_null_ci_upper", "005_adj_null_df", "005_adj_null_coverage", "power_one_08_null_p", "power_one_08_null_means_diff", "power_one_08_null_ci_lower", "power_one_08_null_ci_upper", "power_one_08_null_df", "power_one_08_null_coverage", "power_one_09_null_p", "power_one_09_null_means_diff", "power_one_09_null_ci_lower", "power_one_09_null_ci_upper", "power_one_09_null_df", "power_one_09_null_coverage", "power_meta_08_null_p", "power_meta_08_null_means_diff", "power_meta_08_null_ci_lower", "power_meta_08_null_ci_upper", "power_meta_08_null_df", "power_meta_08_null_coverage", "power_meta_09_null_p", "power_meta_09_null_means_diff", "power_meta_09_null_ci_lower", "power_meta_09_null_ci_upper", "power_meta_09_null_df", "power_meta_09_null_coverage", "mid_s_08_null_p", "mid_s_08_null_means_diff", "mid_s_08_null_ci_lower", "mid_s_08_null_ci_upper", "mid_s_08_null_df", "mid_s_08_null_coverage", "mid_s_09_null_p", "mid_s_09_null_means_diff", "mid_s_09_null_ci_lower", "mid_s_09_null_ci_upper", "mid_s_09_null_df", "mid_s_09_null_coverage", "mid_m_08_null_p", "mid_m_08_null_means_diff", "mid_m_08_null_ci_lower", "mid_m_08_null_ci_upper", "mid_m_08_null_df", "mid_m_08_null_coverage", "mid_m_09_null_p", "mid_m_09_null_means_diff", "mid_m_09_null_ci_lower", "mid_m_09_null_ci_upper", "mid_m_09_null_df", "mid_m_09_null_coverage", "mid_l_08_null_p", "mid_l_08_null_means_diff", "mid_l_08_null_ci_lower", "mid_l_08_null_ci_upper", "mid_l_08_null_df", "mid_l_08_null_coverage", "mid_l_09_null_p", "mid_l_09_null_means_diff", "mid_l_09_null_ci_lower", "mid_l_09_null_ci_upper", "mid_l_09_null_df", "mid_l_09_null_coverage", "rlm_null_p", "rlm_null_means_diff", "rlm_null_ci_lower", "rlm_null_ci_upper", "rlm_null_df", "rlm_null_coverage", "rlm_power_08_null_p", "rlm_power_08_null_means_diff", "rlm_power_08_null_ci_lower", "rlm_power_08_null_ci_upper", "rlm_power_08_null_df", "rlm_power_08_null_coverage", "rlm_power_09_null_p", "rlm_power_09_null_means_diff", "rlm_power_09_null_ci_lower", "rlm_power_09_null_ci_upper", "rlm_power_09_null_df", "rlm_power_09_null_coverage", "multi_lab_null_p", "multi_lab_null_means_diff", "multi_lab_null_ci_lower", "multi_lab_null_ci_upper", "multi_lab_null_df", "multi_lab_null_coverage", "multi_lab_08_null_p", "multi_lab_08_null_means_diff", "multi_lab_08_null_ci_lower", "multi_lab_08_null_ci_upper", "multi_lab_08_null_df", "multi_lab_08_null_coverage", "multi_lab_09_null_p", "multi_lab_09_null_means_diff", "multi_lab_09_null_ci_lower", "multi_lab_09_null_ci_upper", "multi_lab_09_null_df", "multi_lab_09_null_coverage", "gamma_square", "set_1_k", "sample_size_meta_08", "sample_size_one_08", "sample_size_meta_09", "sample_size_one_09", "ma_cohens_d", "ma_means_diff", "has_message_warning" ) # One sided alpha threshold is 0.025, except for interventions "p=0.005" and # "p=0.005 adjusted" (at postions 4 and 5 in the list of interventions) and the # respective sims for the null effects (positions 25 and 26) thresholds <- replace(rep(alpha,42),c(4,5,25,26),alpha*0.1) # For the p<0.005 intervention, Edgington's p-value has to be adjusted accordingly # as alpha' is given as sqrt(2)*alpha, the threshold for the intervention p<0.005 # (corresponding to a one-sided threshold of 0.0025) is 0.1*edginton_threshold. edgington_thresholds <-replace(rep(edgington_threshold,42),c(4,5,25,26), edgington_threshold*0.1) # Here comes the new part for the sensitivity analysis: df_sim_out <- df_sim_out[df_sim_out$has_message_warning==0,] df_sim_out <- df_sim_out[1:100000,] # calculates proportion of significant p-values summary_set <- c() sim_out_p <- df_sim_out[, grepl("*p$", names(df_sim_out))] for(k in 1:42){ summary_set <- c(summary_set, sum(sim_out_p[,k] < thresholds[k]) / runs ) } # calculates proportion of significant edgington's p-values for(k in 1:42){ summary_set <- c(summary_set, edgington(sim_out_p[,k],edgington_thresholds[k]) ) } # calculates proportion of consistent consecutive results for(k in 1:42){ summary_set <- c(summary_set, consistency(sim_out_p[,k],thresholds[k]) ) } # calculates proportion of replication successes based on the two-trial rule. for(k in 1:42){ summary_set <- c(summary_set, two_trial(sim_out_p[,k],thresholds[k]) ) } # calculates the proportion of simulations, where the study CI captures the # meta-analytic estimate (i.e. covering) # Note: position 178+24=202 of sim_out is the effect estimate of the meta-analysis sim_out_lower <- df_sim_out[, grepl("*lower$", names(df_sim_out))] sim_out_upper <- df_sim_out[, grepl("*upper$", names(df_sim_out))] for(k in 1:42){ summary_set <- c(summary_set, sum((df_sim_out$"ma_cohens_d" > sim_out_lower[k]) & (df_sim_out$"ma_cohens_d" < sim_out_upper[k]) )/runs ) } # Calculating the proportion of simulations where the mean estimate # falls into the CI of the meta analysis sim_out_cover <- df_sim_out[, grepl("*coverage$", names(df_sim_out))] for(k in 1:42){ summary_set <- c(summary_set, sum(sim_out_cover[,k]) / runs ) } # gives means for gamma_square, set_1_k, sample_size_meta_08, # sample_size_one_08, sample_size_meta_09,sample_size_one_09, # meta-analytic_cohens_d, meta-analytic_means_diff summary_set <- c(summary_set, mean(df_sim_out$"gamma_square"), mean(df_sim_out$"set_1_k"), mean(df_sim_out$"sample_size_meta_08"), mean(df_sim_out$"sample_size_one_08"), mean(df_sim_out$"sample_size_meta_09"), mean(df_sim_out$"sample_size_one_09"), mean(df_sim_out$"ma_cohens_d"), mean(df_sim_out$"ma_means_diff") ) # gives medians for gamma_square, set_1_k, sample_size_meta_08, # sample_size_one_08, sample_size_meta_09,sample_size_one_09, # meta-analytic_cohens_d, meta-analytic_means_diff summary_set <- c(summary_set, median(df_sim_out$"gamma_square"), median(df_sim_out$"set_1_k"), median(df_sim_out$"sample_size_meta_08"), median(df_sim_out$"sample_size_one_08"), median(df_sim_out$"sample_size_meta_09"), median(df_sim_out$"sample_size_one_09"), median(df_sim_out$"ma_cohens_d"), median(df_sim_out$"ma_means_diff") ) # adds the sum of convergence warnings summary_set <- c(summary_set, sum(df_sim_out$"has_message_warning") ) humans_out[nrow(humans_out) + 1,] <- summary_set sample_sizes_out[nrow(sample_sizes_out) + 1,] <-lapply(all_recorded_sample_sizes,mean) } # Save outputs as CSV file write.table(humans_out, file = "sensitivity_humans_out_14.csv", append = FALSE, quote = TRUE, sep = ",", eol = "\n", na = "NA", dec = ".", row.names = FALSE, col.names = FALSE, qmethod = c("escape", "double"), fileEncoding = "") # Save intermediate metaeffects as CSV file write.table(metaeffects, file = "sensitivity_humans_meta_14.csv", append = FALSE, quote = TRUE, sep = ",", eol = "\n", na = "NA", dec = ".", row.names = FALSE, col.names = FALSE, qmethod = c("escape", "double"), fileEncoding = "") # Save recorded sample sizes as CSV file write.table(sample_sizes_out, file = "sensitivity_humans_sample_sizes_14.csv", append = FALSE, quote = TRUE, sep = ",", eol = "\n", na = "NA", dec = ".", row.names = FALSE, col.names = FALSE, qmethod = c("escape", "double"), fileEncoding = "") dim(humans_out)