## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----echo=FALSE, message=FALSE, warning=FALSE, results='hide'----------------- library(metaConvert) library(metafor) library(DT) ## ----------------------------------------------------------------------------- data(df.psychom) ## ----eval=FALSE--------------------------------------------------------------- # str(df.psychom) ## ----echo=FALSE--------------------------------------------------------------- DT::datatable(df.psychom, options = list( scrollX = TRUE, dom = c('t'), scrollY = "300px", pageLength = 50, ordering = FALSE, rownames = FALSE, columnDefs = list( list(width = '130px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----eval=FALSE--------------------------------------------------------------- # # Extraction sheet for Cronbach's alpha # data_extraction_sheet(measure = "alpha", extension = "data.frame") # # # Extraction sheet for ICC # data_extraction_sheet(measure = "icc", extension = "data.frame") # # # Extraction sheet for correlations (Pearson or Spearman) # data_extraction_sheet(measure = "r", extension = "data.frame") # # # Extraction sheet for proportions # data_extraction_sheet(measure = "prop", extension = "data.frame") ## ----------------------------------------------------------------------------- # Subset internal consistency studies dat_alpha <- df.psychom[df.psychom$outcome == "internal_consistency", ] # Compute effect sizes with Bonett transformation (default) res_alpha <- convert_df(dat_alpha, measure = "alpha", verbose = FALSE, split_adjusted = FALSE) summary_alpha <- summary(res_alpha, flags = TRUE, guidance = TRUE) ## ----eval=FALSE--------------------------------------------------------------- # summary_alpha[, c("author", "es", "se", "es_ci_lo", "es_ci_up", "info_used")] ## ----echo=FALSE--------------------------------------------------------------- DT::datatable(summary_alpha[, c("author", "es", "se", "es_ci_lo", "es_ci_up", "info_used")], options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '130px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=4------------------------------------------------ # Random-effects meta-analysis on Bonett-transformed scale ma_alpha <- metafor::rma(yi = es, sei = se, data = summary_alpha, method = "REML") # Forest plot metafor::forest(ma_alpha, slab = paste0(summary_alpha$author, " (", dat_alpha$year, ")"), xlab = "Bonett-transformed alpha: ln(1 - alpha)", header = TRUE) ## ----------------------------------------------------------------------------- # Back-transform pooled estimate and CI pooled_alpha <- 1 - exp(ma_alpha$beta[1]) pooled_alpha_lo <- 1 - exp(ma_alpha$ci.ub) pooled_alpha_up <- 1 - exp(ma_alpha$ci.lb) cat(sprintf("Pooled alpha = %.3f [%.3f, %.3f]\n", pooled_alpha, pooled_alpha_lo, pooled_alpha_up)) ## ----eval=FALSE--------------------------------------------------------------- # # Raw alpha (not recommended for meta-analysis) # res_alpha_raw <- convert_df(dat_alpha, measure = "alpha", alpha_to_es = "raw", # verbose = FALSE, split_adjusted = FALSE) # summary(res_alpha_raw) ## ----------------------------------------------------------------------------- # Subset test-retest studies dat_icc <- df.psychom[df.psychom$outcome == "test_retest", ] # Compute effect sizes with Bonett transformation (default) res_icc <- convert_df(dat_icc, measure = "icc", verbose = FALSE, split_adjusted = FALSE) summary_icc <- summary(res_icc, flags = TRUE) ## ----eval=FALSE--------------------------------------------------------------- # summary_icc[, c("author", "es", "se", "es_ci_lo", "es_ci_up", # "icc_type", "info_used")] ## ----echo=FALSE--------------------------------------------------------------- DT::datatable(summary_icc[, c("author", "es", "se", "es_ci_lo", "es_ci_up", "icc_type", "info_used")], options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '130px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=4------------------------------------------------ # Random-effects meta-analysis ma_icc <- metafor::rma(yi = es, sei = se, data = summary_icc, method = "REML") # Forest plot metafor::forest(ma_icc, slab = paste0(summary_icc$author, " (", dat_icc$year, ")"), xlab = "Bonett-transformed ICC: ln(1 - ICC)", header = TRUE) ## ----------------------------------------------------------------------------- # Back-transform pooled estimate pooled_icc <- 1 - exp(ma_icc$beta[1]) pooled_icc_lo <- 1 - exp(ma_icc$ci.ub) pooled_icc_up <- 1 - exp(ma_icc$ci.lb) cat(sprintf("Pooled ICC = %.3f [%.3f, %.3f]\n", pooled_icc, pooled_icc_lo, pooled_icc_up)) ## ----------------------------------------------------------------------------- # Use test-retest studies that report both ICC and SD dat_me <- df.psychom[df.psychom$outcome == "test_retest" & !is.na(df.psychom$sd_scores), ] # Compute SEM for each study (delta-method SE included) sem_results <- compute_sem( sd = dat_me$sd_scores, icc = dat_me$icc, n_sample = dat_me$n_sample ) # Chain to SDC sdc_results <- compute_sdc( sem = sem_results$sem, sem_se = sem_results$sem_se ) ## ----eval=FALSE--------------------------------------------------------------- # # Combined measurement error table # measurement_error <- data.frame( # study = dat_me$study_id, # n = dat_me$n_sample, # sd = dat_me$sd_scores, # icc = dat_me$icc, # sem = round(sem_results$sem, 3), # sem_se = round(sem_results$sem_se, 3), # sdc = round(sdc_results$sdc, 3), # sdc_se = round(sdc_results$sdc_se, 3) # ) # measurement_error ## ----echo=FALSE--------------------------------------------------------------- measurement_error <- data.frame( study = dat_me$study_id, n = dat_me$n_sample, sd = dat_me$sd_scores, icc = dat_me$icc, sem = round(sem_results$sem, 3), sem_se = round(sem_results$sem_se, 3), sdc = round(sdc_results$sdc, 3), sdc_se = round(sdc_results$sdc_se, 3) ) DT::datatable(measurement_error, options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '100px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=4------------------------------------------------ ma_sem <- metafor::rma(yi = sem_results$sem, sei = sem_results$sem_se, method = "REML") metafor::forest(ma_sem, slab = paste0(dat_me$author, " (", dat_me$year, ")"), xlab = "Standard Error of Measurement (SEM)", header = TRUE) ## ----------------------------------------------------------------------------- cat(sprintf("Pooled SEM = %.3f [%.3f, %.3f]\n", ma_sem$beta[1], ma_sem$ci.lb, ma_sem$ci.ub)) # Derive pooled SDC from pooled SEM pooled_sdc <- 1.96 * sqrt(2) * ma_sem$beta[1] cat(sprintf("Pooled SDC = %.3f\n", pooled_sdc)) ## ----------------------------------------------------------------------------- # Subset criterion and construct validity studies dat_validity <- df.psychom[df.psychom$outcome %in% c("criterion_validity", "construct_validity"), ] # convert_df automatically handles both Pearson r and Spearman rho res_r <- convert_df(dat_validity, measure = "r", verbose = FALSE, split_adjusted = FALSE) summary_r <- summary(res_r, flags = TRUE) ## ----eval=FALSE--------------------------------------------------------------- # summary_r[, c("author", "es", "se", "info_used")] ## ----echo=FALSE--------------------------------------------------------------- DT::datatable(summary_r[, c("author", "es", "se", "es_ci_lo", "es_ci_up", "info_used")], options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '130px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=5------------------------------------------------ # Pool observed (uncorrected) correlations on Fisher's z scale z_obs <- atanh(summary_r$es) r_bounded <- pmin(pmax(summary_r$es, -0.9999), 0.9999) z_se <- summary_r$se / (1 - r_bounded^2) ma_r_obs <- metafor::rma(yi = z_obs, sei = z_se, method = "REML") # Forest plot on correlation scale metafor::forest(ma_r_obs, slab = paste0(summary_r$author, " (", dat_validity$year, ")"), xlab = "Fisher's z (observed correlation)", header = TRUE) ## ----------------------------------------------------------------------------- # Back-transform to correlation scale pooled_r_obs <- tanh(ma_r_obs$beta[1]) pooled_r_lo <- tanh(ma_r_obs$ci.lb) pooled_r_up <- tanh(ma_r_obs$ci.ub) cat(sprintf("(a) Pooled uncorrected r = %.3f [%.3f, %.3f]\n", pooled_r_obs, pooled_r_lo, pooled_r_up)) ## ----------------------------------------------------------------------------- # Disattenuate using study-specific reliabilities corrected <- es_disattenuate( r = summary_r$es, r_se = summary_r$se, reliability_x = dat_validity$reliability_target, reliability_y = dat_validity$reliability_comparator, n_sample = dat_validity$n_sample ) ## ----eval=FALSE--------------------------------------------------------------- # # Comparison table # data.frame( # study = dat_validity$study_id, # info_used = summary_r$info_used, # r_observed = round(summary_r$es, 3), # r_corrected = round(corrected$r_corrected, 3), # attenuation_factor = round(corrected$attenuation_factor, 3) # ) ## ----echo=FALSE--------------------------------------------------------------- comp <- data.frame( study = dat_validity$study_id, info_used = summary_r$info_used, r_observed = round(summary_r$es, 3), r_corrected = round(corrected$r_corrected, 3), attenuation_factor = round(corrected$attenuation_factor, 3) ) DT::datatable(comp, options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '130px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=5------------------------------------------------ # Pool corrected correlations on Fisher's z scale ma_r_corr <- metafor::rma(yi = corrected$z_corrected, sei = corrected$z_corrected_se, method = "REML") metafor::forest(ma_r_corr, slab = paste0(summary_r$author, " (", dat_validity$year, ")"), xlab = "Fisher's z (disattenuated correlation)", header = TRUE) ## ----------------------------------------------------------------------------- pooled_r_corr <- tanh(ma_r_corr$beta[1]) pooled_r_corr_lo <- tanh(ma_r_corr$ci.lb) pooled_r_corr_up <- tanh(ma_r_corr$ci.ub) cat(sprintf("(b) Pooled disattenuated r = %.3f [%.3f, %.3f]\n", pooled_r_corr, pooled_r_corr_lo, pooled_r_corr_up)) ## ----eval=FALSE--------------------------------------------------------------- # # Use pooled alpha and ICC from earlier sections as proxies # es_disattenuate( # r = 0.65, # r_se = 0.08, # reliability_x = pooled_alpha, # from Section 2 # reliability_y = 0.85, # from external published data # n_sample = 150 # ) ## ----------------------------------------------------------------------------- # Subset responsiveness studies dat_resp <- df.psychom[df.psychom$outcome == "responsiveness", ] # Step 1: Compute change-score reliability change_rel <- reliability_change_score( reliability = dat_resp$single_occasion_reliability, r_pre_post = dat_resp$r_pre_post ) # Step 2: Get responsiveness correlations via convert_df res_resp <- convert_df(dat_resp, measure = "r", verbose = FALSE, split_adjusted = FALSE) summary_resp <- summary(res_resp) # Step 3: Disattenuate using CHANGE-SCORE reliability corrected_resp <- es_disattenuate( r = summary_resp$es, r_se = summary_resp$se, reliability_x = change_rel$rel_change, reliability_y = dat_resp$reliability_comparator, n_sample = dat_resp$n_sample ) ## ----eval=FALSE--------------------------------------------------------------- # data.frame( # study = dat_resp$study_id, # r_observed = round(summary_resp$es, 3), # rel_single = dat_resp$single_occasion_reliability, # r_pre_post = dat_resp$r_pre_post, # rel_change = round(change_rel$rel_change, 3), # r_corrected = round(corrected_resp$r_corrected, 3) # ) ## ----echo=FALSE--------------------------------------------------------------- resp_table <- data.frame( study = dat_resp$study_id, r_observed = round(summary_resp$es, 3), rel_single = dat_resp$single_occasion_reliability, r_pre_post = dat_resp$r_pre_post, rel_change = round(change_rel$rel_change, 3), r_corrected = round(corrected_resp$r_corrected, 3) ) DT::datatable(resp_table, options = list(scrollX = TRUE, dom = 't', ordering = FALSE, rownames = FALSE, pageLength = 50, columnDefs = list( list(width = '110px', targets = "_all"), list(className = 'dt-center', targets = "_all")))) ## ----fig.width=7, fig.height=4------------------------------------------------ # Pool observed change-score correlations z_resp <- atanh(summary_resp$es) r_resp_bounded <- pmin(pmax(summary_resp$es, -0.9999), 0.9999) z_resp_se <- summary_resp$se / (1 - r_resp_bounded^2) ma_resp_obs <- metafor::rma(yi = z_resp, sei = z_resp_se, method = "REML") cat(sprintf("Pooled observed r = %.3f [%.3f, %.3f]\n", tanh(ma_resp_obs$beta[1]), tanh(ma_resp_obs$ci.lb), tanh(ma_resp_obs$ci.ub))) # Pool disattenuated change-score correlations ma_resp_corr <- metafor::rma(yi = corrected_resp$z_corrected, sei = corrected_resp$z_corrected_se, method = "REML") cat(sprintf("Pooled disattenuated r = %.3f [%.3f, %.3f]\n", tanh(ma_resp_corr$beta[1]), tanh(ma_resp_corr$ci.lb), tanh(ma_resp_corr$ci.ub))) ## ----------------------------------------------------------------------------- # Example: one study with r_observed = 0.50, rel_single = 0.85 r_pre_post_grid <- c(0.20, 0.40, 0.60, 0.80) sensitivity <- data.frame( r_pre_post = r_pre_post_grid, rel_change = sapply(r_pre_post_grid, function(rpp) { reliability_change_score(reliability = 0.85, r_pre_post = rpp)$rel_change }), r_corrected = sapply(r_pre_post_grid, function(rpp) { rc <- reliability_change_score(reliability = 0.85, r_pre_post = rpp)$rel_change es_disattenuate(r = 0.50, r_se = 0.08, reliability_x = rc, reliability_y = 0.80, n_sample = 100)$r_corrected }) ) sensitivity ## ----------------------------------------------------------------------------- # Subset floor/ceiling studies dat_prop <- df.psychom[df.psychom$outcome == "floor_ceiling", ] # Freeman-Tukey transformation (recommended) res_prop <- convert_df(dat_prop, measure = "prop", prop_to_es = "freeman_tukey", verbose = FALSE, split_adjusted = FALSE) summary_prop <- summary(res_prop) ## ----fig.width=7, fig.height=3.5---------------------------------------------- ma_prop <- metafor::rma(yi = es, sei = se, data = summary_prop, method = "REML") metafor::forest(ma_prop, slab = paste0(summary_prop$author, " (", dat_prop$year, ")"), xlab = "Freeman-Tukey transformed proportion", header = TRUE) ## ----------------------------------------------------------------------------- # Approximate back-transformation (for the pooled estimate) pooled_prop <- sin(ma_prop$beta[1])^2 cat(sprintf("Pooled proportion (approx.) = %.3f\n", pooled_prop))