#' --- #' title: "Meta-analysis of reliability of the DOSPERT scale Replication Code and Output" #' author: "Yiyun Shou" #' output: #' html_document: #' highlight: textmate #' keep_md: yes #' number_sections: yes #' theme: yeti #' toc: yes #' toc_float: #' collapsed: no #' editor_options: #' chunk_output_type: console #' --- #' #' #' #' The document includes the detailed analysis codes for all results in the paper entitled as "Assessing a domain-specific risk-taking construct: a meta-analysis of reliability of the DOSPERT scale" for coming issue in "Judgement and Decision Making". #' ## ----setup, include=FALSE------------------------------------------------ knitr::opts_chunk$set(echo = TRUE, warning=FALSE, message=FALSE) #*********** Load packages******* # Rmarkdown knitr library(knitr) #Version 1.26 # Data processing and display packages library(reshape2) #version 1.4.3 library(plyr) #version 1.8.5 library(DT) #version 0.11 # Plot library(ggplot2) #Version 3.2.1 # Correlation analysis library(psych) #Version 1.9.12 # Meta analysis library(metafor) #Version 2.1-0 #*********** Read data file******* DOSPERT_RG_Data <- read.csv("DOSPERT_RG_JDM_Data.csv", na.strings = "", stringsAsFactors = FALSE) ## Process factor variables and set up contrast DOSPERT_RG_Data$Sampletype <- factor(DOSPERT_RG_Data$Sampletype) DOSPERT_RG_Data$FirstLanguage <- factor(DOSPERT_RG_Data$FirstLanguage) DOSPERT_RG_Data$LikertPoint <- factor(DOSPERT_RG_Data$LikertPoint, exclude = NA) contrasts(DOSPERT_RG_Data$LikertPoint)[1] <- -1 DOSPERT_RG_Data$MeasureVersion <- factor(DOSPERT_RG_Data$MeasureVersion) contrasts(DOSPERT_RG_Data$MeasureVersion)[1] <- -1 DOSPERT_RG_Data$ScaleAspect <- factor(DOSPERT_RG_Data$ScaleAspect, levels = c("RiskTaking" , "BenefitPercet","RiskPercept"), ordered = FALSE) DOSPERT_RG_Data$ScaleAspect <- factor(DOSPERT_RG_Data$ScaleAspect) contrasts(DOSPERT_RG_Data$ScaleAspect)[1,] <- c(-1, -1) #' #' # Data Descriptions: #' #' * `Paper`, Year: the author and year of the paper #' * `Sample`: if the same paper report several samples #' * `SamplePopulation`: whether the sample is from student, community, professional populations #' * `Sampletype`: reclassify sample types into student vs nonstudent. #' * `Language`: language of the sample #' * `FirstLanguage`: reclassify language to English vs non-English #' * `Samplesize`: sample size. #' * `Samplesize100`: sample size/100 #' * `MeanAge`: Mean age of the sample #' * `MeasureVersion`: Dospert Original (Weber_2002) or Revised (Weber_2006) #' * `ScaleAspect`: Scale rating aspect: risk taking, risk perception, benefit perception ; #' * `Scale`: subscale domain Total, and ethical, financial, health, social and recreational ; #' * `ScaleLength`: the number of items in the scale #' * `Likert`: likert point used in the scale #' * `LikertPoint`: same as ``Likert` but removing points other than 5 and 7. #' * `AlphaValue`: Cronbach's alpha value of the scale. #' * `MeanScore`: the scale mean scores #' * `MeanScoreTrans`: to accommodate the different likert point, all mean scores are transformed into 0-1 interval. #' #' # Dependencies among variables of samples (Table 1) #' ## ------------------------------------------------------------------------ indsamples <- paste(DOSPERT_RG_Data$Paper, DOSPERT_RG_Data$Year, DOSPERT_RG_Data$Sample, sep="") DOSPERT_RG_list <- DOSPERT_RG_Data[!duplicated(indsamples), ] modvariable1 <- data.frame( var = c("MeasureVersion", "LikertPoint", "Sampletype", "FirstLanguage", "MeanAge", "Samplesize100", "Pmale"), type = c("B","B", "B","B", "C", "C","C"), #B is binary; C is countinous stringsAsFactors = FALSE) modvariablecmb <- t(combn(modvariable1$var, 2)) modvariablecmb <- data.frame(modvariablecmb,stringsAsFactors = FALSE) modvariablecmb$test <- "CC" for (i in 1:nrow(modvariablecmb)){ modvariablecmb$test[i] = paste( modvariable1$type[which(modvariable1$var== modvariablecmb[i, 1])], modvariable1$type[which(modvariable1$var== modvariablecmb[i, 2])], sep="" ) } xx = DOSPERT_RG_list[, modvariable1$var] xx$MeasureVersion = as.numeric(xx$MeasureVersion) xx$LikertPoint = as.numeric(xx$LikertPoint) xx$Sampletype = as.numeric(factor(xx$Sampletype, levels =c("Student", "Nonstudent"), ordered =TRUE)) xx$FirstLanguage = as.numeric(factor(xx$FirstLanguage)) modvariable1$n = apply(xx, 2, function(x) { nrow(DOSPERT_RG_list) - length(na.omit(x))} ) modvariablecmb$r <- 0 modvariablecmb$p <- 0 modvariablecmb$n <- 0 modvariablecmb$rstar ="" for (i in 1:nrow(modvariablecmb)){ var1 <- xx[, modvariablecmb[i, 1]] var2 <- xx[, modvariablecmb[i, 2]] xxvar <- na.omit(data.frame(var1, var2)) names(xxvar) = c("var1", "var2") if(modvariablecmb$test[i] == "BB"){ # For binary variables pair rtest <-polychoric(xxvar) modvariablecmb$r[i] = rtest$rho[1, 2] modvariablecmb$n[i] = nrow(xxvar) chtest <- chisq.test(table(xxvar$var1, xxvar$var2)) modvariablecmb$p[i] = chtest$p.value } if(modvariablecmb$test[i] == "BC"){# For binary-countinous variables pair rtest <- biserial(x = xxvar$var2, y = xxvar$var1) modvariablecmb$r[i] = rtest modvariablecmb$n[i] = nrow(xxvar) chtest <- corr.test(xxvar$var1, xxvar$var2) modvariablecmb$p[i] = chtest$p } if(modvariablecmb$test[i] == "CC"){# For countinous-countinous variables pair rtest <- corr.test(xxvar$var1, xxvar$var2) modvariablecmb$r[i] = rtest$r modvariablecmb$n[i] = nrow(xxvar) modvariablecmb$p[i] = rtest$p } if(modvariablecmb$p[i] < 0.05){ modvariablecmb$rstar[i] = "*" } if(modvariablecmb$p[i] < 0.01){ modvariablecmb$rstar[i] = "**" } if(modvariablecmb$p[i] < 0.001){ modvariablecmb$rstar[i] = "***" } } modvariablecmb$output = paste(round(modvariablecmb$r,2), modvariablecmb$rstar, sep="") cormat <- matrix("", ncol = 7, nrow = 7) rownames(cormat)=colnames(cormat)=modvariable1$var cormat[lower.tri(cormat, diag = FALSE)] = modvariablecmb$output cormat[lower.tri(cormat, diag = FALSE)] = t(cormat[lower.tri(cormat, diag = FALSE)]) cormat[upper.tri(cormat, diag = FALSE)] = modvariablecmb$n cormat[upper.tri(cormat, diag = FALSE)] = t(cormat[upper.tri(cormat, diag = FALSE)]) datatable(cormat, caption = "Table 1: Correlations among varaibles", filter = "top") #' #' Measure Version & Sample language ## ------------------------------------------------------------------------ chisq.test(table(xx$MeasureVersion, xx$FirstLanguage)) #' #' Measure Version & Sample type ## ------------------------------------------------------------------------ chisq.test(table(xx$MeasureVersion, xx$Sampletype)) #' #' ## Dependence among categorical variables for alpha values #' #' Measure Version & Subscale #' ## ------------------------------------------------------------------------ chisq.test(table(DOSPERT_RG_Data$MeasureVersion, DOSPERT_RG_Data$Scale)) #' #' Scale aspects & Subscale versions ## ------------------------------------------------------------------------ chisq.test(table(DOSPERT_RG_Data$ScaleAspect, DOSPERT_RG_Data$Scale)) #' #' #' # Missing values, publication bias and outliers #' #' ## Missing value influence #' ## ---- warning=FALSE, message=FALSE--------------------------------------- DOSPERT_RG_Data$misslikert <- ifelse(is.na(DOSPERT_RG_Data$Likert), 1, 0) DOSPERT_RG_Data$missage <- ifelse(is.na(DOSPERT_RG_Data$MeanAge), 1, 0) DOSPERT_RG_Data$missmale <- ifelse(is.na(DOSPERT_RG_Data$Pmale), 1, 0) DOSPERT_RG_Data$missmean <- ifelse(is.na(DOSPERT_RG_Data$MeanScoreTrans), 1, 0) missvar <- c("misslikert", "missage","missmale", "missmean") output = NULL for (i in 1:length(missvar)){ dataset = DOSPERT_RG_Data[, c("AlphaValue", "SampleSize", "ScaleLength","Scale", missvar[i])] names(dataset)[5]="variable" rma_ms <- ddply(dataset, .(Scale), function(x) { out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = x) x1 = c(out$k, out$b[2], out$QM, out$QMp,out$R2) names(x1) = c("k","b","Q","Q.p","R2") x1 } ) rma_ms[, 2:5] =round(rma_ms[, 2:5],3) output = rbind(output, rma_ms ) } output = data.frame(Variable = rep(missvar, each = 6), output) output[, 3:6] = round(output[, 3:6],3) alloutput = output[order(output$Scale), -8] formatRound(datatable(alloutput, caption = "Impact of missing values on alpha estimates", filter = "top"), c(4:7),3) #' #' ## Publication Bias #' #' ### Funnel plot and test of symmetry (Figure 2) #' ## ---- fig.width=10, fig.height=12---------------------------------------- # Calculate the transformed alpha values and se dat1 <- escalc(measure="ABT", ai=AlphaValue, ni=SampleSize, mi= ScaleLength, data=DOSPERT_RG_Data) ranktests <- ddply(dat1, .(Scale), function(x) { out = ranktest(x$yi,x$vi) x1 = c(out$tau, out$pval) names(x1) = c("tau","p.val") x1 } ) #Plot par(mfrow=c(3,2), mar = c(3, 4, 2, 1)) ddply(dat1, .(Scale), function(x) { tauval = round(ranktests$tau[which(ranktests$Scale==x$Scale[1])], 2) p = round(ranktests$p.val[which(ranktests$Scale==x$Scale[1])], 3) tautext = bquote(atop(tau~plain("=")~.(tauval), plain("p = ")~.(p))) funnel(x$yi, x$vi, main=x$Scale[1], refline = mean(na.omit(x$yi)), xlim = c(0.5, 3)) text(2.2, 0.2, tautext, pos=4,cex = 1.5) } ) #' #' #' ## Outlier Test #' ## ------------------------------------------------------------------------ DOSPERT_RG_testol = DOSPERT_RG_Data DOSPERT_RG_testol$rowid = 1:nrow(DOSPERT_RG_Data) ## For all scales together x = ddply(DOSPERT_RG_testol, .(Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) cd <- influence(out) entryinfl = cbind(x$rowid[cd$is.infl], x[cd$is.infl, ]) entryinfl } ) x$rowid ## For Risk Taking scale x1 = ddply(subset(DOSPERT_RG_testol, ScaleAspect =="RiskTaking"), .(Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) cd <- influence(out) entryinfl = cbind(x$rowid[cd$is.infl], x[cd$is.infl, ]) # plot(cd) #mtext(x$Scale[1], outer = TRUE, cex = 1.5) entryinfl } ) x1$rowid ## For Risk Perception scale x2 = ddply(subset(DOSPERT_RG_testol, ScaleAspect =="RiskPercept"), .(Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) cd <- influence(out) entryinfl = cbind(x$rowid[cd$is.infl], x[cd$is.infl, ]) #plot(cd) #mtext(x$Scale[1], outer = TRUE, cex = 1.5) entryinfl } ) x2$rowid datatable(DOSPERT_RG_testol[c(x$rowid, x2$rowid), ], caption = "Influencial Cases across scales") #' #' #' # Random effect models #' #' ## Mean weighted alpha for different subscales (Table 2) #' ## ------------------------------------------------------------------------ # For total rma_overall <- ddply(DOSPERT_RG_Data, .(Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$se.tau2, out$QE, out$QEp,out$I2, out$H2) out2 <- c(out$k,x1a, x2) names(out2) = c("k","Mean","CIlow","CIup","tau2","se.tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_overall, caption = "Overall Alpha Values Across Scales", filter = "top", options = list(pageLength = 10)), c(2:12),2) #' #' #' ## Mean weighted alpha - Scale Characteristics (Table 3; for k, mean, and 95%CI) #' #' ### Scale Aspect ## ------------------------------------------------------------------------ rma_scale <- ddply(DOSPERT_RG_Data, .(ScaleAspect, Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$QE, round(out$QEp, 3), out$I2, out$H2) out2 <- c(out$k, x1a, x2) names(out2) = c("k","alpha","CIlow","CIup","tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_scale[, 1:6], caption = "Alpha Values Across Scale Apects", filter = "top", options = list(pageLength = 20)), c(4:6),2) #' #' ### Measure versions ## ------------------------------------------------------------------------ rma_mv <- ddply(DOSPERT_RG_Data, .(MeasureVersion, Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$QE, round(out$QEp, 3), out$I2, out$H2) out2 <- c(out$k, x1a, x2) names(out2) = c("k","alpha","CIlow","CIup","tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_mv[, 1:6], caption = "Alpha Values Across Measure Versions", filter = "top", options = list(pageLength = 12)), c(4:6),2) #' #' ### Likert Points ## ------------------------------------------------------------------------ DOSPERT_RG_Data1 <- DOSPERT_RG_Data[!is.na(DOSPERT_RG_Data$LikertPoint), ] rma_lk <- ddply(DOSPERT_RG_Data1, .(LikertPoint, Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$QE, round(out$QEp, 3), out$I2, out$H2) out2 <- c(out$k, x1a, x2) names(out2) = c("k","alpha","CIlow","CIup","tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_lk[, 1:6],caption = "Alpha Values Across Likert Scales", filter = "top", options = list(pageLength = 12)), c(4:6),2) #' #' ## Mean weighted alpha - Sample charcteristic (Table 4; for k, mean, and 95%CI) #' #' ### Student vs Non student ## ------------------------------------------------------------------------ rma_sample <- ddply(DOSPERT_RG_Data, .(Sampletype, Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$QE, round(out$QEp, 3), out$I2, out$H2) out2 <- c(out$k, x1a, x2) names(out2) = c("k","alpha","CIlow","CIup","tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_sample[, 1:6], caption = "Based on Sample Type", filter = "top", options = list(pageLength = 12)), c(4:6),2) #' #' ### English vs Non English ## ------------------------------------------------------------------------ rma_esl <- ddply(DOSPERT_RG_Data, .(FirstLanguage, Scale), function(x) { out <- rma.uni(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, dat=x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$QE, round(out$QEp, 3), out$I2, out$H2) out2 <- c(out$k, x1a, x2) names(out2) = c("k","alpha","CIlow","CIup","tau2","Q","Q.p","I2","H2") out2 } ) formatRound(datatable(rma_esl[, 1:6], caption = "Based on Languages", filter = "top", options = list(pageLength = 12)), c(4:6),2) #' #' ## Figure 3 Plot ## ---- fig.width=10, fig.height=15---------------------------------------- # Merge all above results rma_scale$variable = "Aspect" rma_mv$variable = "Version" rma_lk$variable = "Likert" rma_sample$variable = "Sample" rma_esl$variable = "Language" names(rma_scale)[1] = names(rma_mv)[1] = names(rma_lk)[1] = names(rma_sample)[1] = names(rma_esl)[1] = "Levels" rma_scale$Levels = rep(c("Risk Taking","Expected Benefit","Perceived Risk"), each = 6) rma_mv$Levels = rep(c("Original","Revised"), each = 6) rma_all <- rbind(rma_scale, rma_mv, rma_lk, rma_sample[1:12, ], rma_esl[1:12, ]) rma_all$Xlab <- paste(rma_all$variable, ": ",rma_all$Levels, sep = "") # Plot sp1 <- ggplot(rma_all, aes(x = Xlab, y = alpha, shape = variable)) # add lines and error bars sp1 <- sp1 + geom_errorbar(aes(ymin=CIlow, ymax=CIup), width=0,color="black") + geom_point(aes(size=1)) + guides(shape = FALSE,size = FALSE) # configure plot sp1 <- sp1 + theme_bw() + xlab("Factors") + ylab("") + ylim(c(0.5,1))+ theme(axis.text.x=element_text(size=rel(1.2)), axis.title.x=element_text(size=rel(1.3)), axis.text.y=element_text(size=rel(1.2)), panel.grid.minor=element_blank(), panel.grid.major.x=element_blank()) # To put levels on y axis sp1 <- sp1+ coord_flip() # Spread out based on subscales sp1 + facet_grid(Scale~.) # ggsave("Figure3_MeanAlphas.png", width = 7.5, height = 10, units = "in") # ggsave("Figure3_MeanAlphas.eps", width = 7.5, height = 10, units = "in") #' #' # Meta analysis - Single factor models #' #' ## Scale characteristics #' #' ### Overall Rating Aspects and Subscales ## ------------------------------------------------------------------------ ##Differences across rating aspects---------- out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ ScaleAspect,method="REML", test="knha", dat = DOSPERT_RG_Data) print(out, digits =3) ## Differences across rating aspects No outliers"---- out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ ScaleAspect,method="REML", test="knha", dat = subset(DOSPERT_RG_Data[-266, ])) print(out, digits =3) #' #' #' ### Overall Across Subscales ## ------------------------------------------------------------------------ ## Differences across subscales---- out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data, Scale !="Total")) print(out, digits =3) ## Differences across subscales - No outliers---- out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data[-266, ], Scale !="Total")) print(out, digits =3) #' ## ------------------------------------------------------------------------ ## Differences across subscales - Risk Taking only out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data, Scale !="Total" & ScaleAspect == "RiskTaking")) print(out, digits =3) ## Differences across subscales - Risk Perception only out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data, Scale !="Total" & ScaleAspect == "RiskPercept")) print(out, digits =3) ## Differences across subscales - Risk Perception only No outliers out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data[-c(266,267,268,12), ], Scale !="Total" & ScaleAspect == "RiskPercept")) print(out, digits =3) # Differences across subscales - Benefit Perception only out<- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ Scale,method="REML", test="knha", dat = subset(DOSPERT_RG_Data, Scale !="Total" & ScaleAspect == "BenefitPercet")) print(out, digits =3) #' #' #' ## Categorical Moderation Across Subscales (Table 3 & 4; for F value, p and R2) #' ## ------------------------------------------------------------------------ modvariable <- c("ScaleAspect","MeasureVersion", "LikertPoint","Sampletype", "FirstLanguage") output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Data[, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" rmm_temp <- ddply(dataset, .(Scale), function(x) { out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = x) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") x1 } ) rmm_temp[, 6:8] =round(rmm_temp[, 6:8],3) output = rbind(output, rmm_temp ) } output = data.frame(Variable = rep(modvariable, each = 6), output) output[, c(3, 6:8)] =round(output[, c(3, 6:8)],3) alloutput = output[order(output$Scale),] formatRound(datatable(alloutput, caption = "Single factor meta analysis - DOSPERT Total - All scale aspects", filter = "top", options = list(pageLength = 30)), c(4:9),3) #' #' ### Exclude outliers (in Ethical scale -- retest ethical scale) #' ## ------------------------------------------------------------------------ output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Data[-266, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = subset(dataset, Scale == "Ethical")) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") output = rbind(output,x1) } output = data.frame(Variable = modvariable, output) output[, c(3, 6:8)] =round(output[, c(3, 6:8)],3) formatRound(datatable(output, caption = "Single factor meta analysis - DOSPERT (ethical scale) - No outlier", filter = "top", options = list(pageLength = 20)), c(4:9),3) #' #' ## Other continuous characteristics Moderation Across Subscales (Table 5; k, b, F, R2) #' ## ------------------------------------------------------------------------ modvariable <- c("MeanAge","Samplesize100","Pmale","MeanScoreTrans") output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Data[, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" rmm_temp <- ddply(dataset, .(Scale), function(x) { out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = x) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") x1 } ) rmm_temp[, 2:5] =round(rmm_temp[, 2:5],3) output = rbind(output,rmm_temp ) } output = data.frame(Variable = rep(modvariable, each = 6), output) output[, 3:6] =round(output[, 3:6],3) alloutput = output[order(output$Scale),] formatRound(datatable(alloutput, caption = "Single factor meta analysis - DOSPERT Total - All scale aspects", filter = "top", options = list(pageLength = 25)), c(4:9),3) #' #' ### Exclude outliers in Ethical scale -- retest ethical scale) #' ## ------------------------------------------------------------------------ output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Data[-266, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = subset(dataset, Scale == "Ethical")) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") output = rbind(output,x1) } output = data.frame(Variable = modvariable, output) output[, 3:6] =round(output[, 3:6],3) formatRound(datatable(output, caption = "Single factor meta analysis - DOSPERT No outlier", filter = "top", options = list(pageLength = 16)), c(4:9),3) #' #' ## Risk taking only (Table 6;k, b, R2, F, p) #' ## ------------------------------------------------------------------------ modvariable <- c("Sampletype", "FirstLanguage","MeanAge","Samplesize100","Pmale", "MeasureVersion", "LikertPoint","MeanScoreTrans") DOSPERT_RG_Datab = subset(DOSPERT_RG_Data, ScaleAspect=="RiskTaking") output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Datab[, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" rmm_temp <- ddply(dataset, .(Scale), function(x) { out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = x) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") x1 } ) rmm_temp[, 2:5] =round(rmm_temp[, 2:5],3) output = rbind(output,rmm_temp ) } output = data.frame(Variable = rep(modvariable, each = 6), output) output[, 3:6] =round(output[, 3:6],3) modorder = paste(1:length(modvariable), modvariable, sep="") output$modorder = rep(modorder, 6) alloutput = output[order(output$Scale), -10] formatRound(datatable(alloutput, caption = "Single factor meta analysis - DOSPERT Total - Risk Taking only", filter = "top"), c(4:9),3) #' #' #' ## Risk Perception only (Table 6; k, b, R2, F, P) #' ## ------------------------------------------------------------------------ modvariable <- c("Sampletype", "FirstLanguage","MeanAge","Samplesize100","Pmale", "MeasureVersion", "LikertPoint","MeanScoreTrans") DOSPERT_RG_Datab = subset(DOSPERT_RG_Data, ScaleAspect=="RiskPercept") output = NULL for (i in 1:length(modvariable)){ dataset = DOSPERT_RG_Datab[, c("AlphaValue", "SampleSize", "ScaleLength","Scale", modvariable[i])] names(dataset)[5]="variable" rmm_temp <- ddply(dataset, .(Scale), function(x) { out <- rma(measure="ABT", ai= AlphaValue, ni= SampleSize, mi= ScaleLength, mod=~ variable,method="REML", test="knha", dat = x) x1 = c(out$k, out$b[2], out$m, out$dfs, out$QM, out$QMp,out$R2) names(x1) = c("k","b","F_df1","F_df2","F","F.p","R2") x1 } ) rmm_temp[, 2:5] =round(rmm_temp[, 2:5],3) output = rbind(output,rmm_temp) } output = data.frame(Variable = rep(modvariable, each = 6), output) output[, 3:6] =round(output[, 3:6],3) modorder = paste(1:length(modvariable), modvariable, sep="") output$modorder = rep(modorder, 6) alloutput = output[order(output$Scale), -10] formatRound(datatable(alloutput, caption = "Single factor meta analysis - DOSPERT Total - Risk Taking only", filter = "top"), c(4:9),3) #' #' #' # Interscale Correlation (Table 7) #' #' The data file "DOSPERT_RG_JDM_InterScaleCor.csv" contain the studies that reported inter-scale correlations. #' Variables are mostly same as the alpha value data. #' The file has additional columns that indicate the correlation between `E` (ethical), `F` (financial), `H` (health), `S` (social), and `R`(recreational) domains. #' ## ------------------------------------------------------------------------ DOSPERT_RG_cor <- read.csv("DOSPERT_RG_JDM_InterScaleCor.csv", na.strings = "", stringsAsFactors = FALSE) DOSPERT_RG_cor_long <- melt(DOSPERT_RG_cor, measure.vars = names(DOSPERT_RG_cor)[9:18]) cor_rm <- ddply(DOSPERT_RG_cor_long, .(variable), function(x) { out <- rma.uni(measure="ZCOR", ri = value, ni= SampleSize, dat= x) x1 = c(out$b, out$ci.lb, out$ci.ub) x1a<- 1-exp(-x1) x2 = c(out$tau2, out$se.tau2, out$QE, out$QEp,out$I2, out$H2) out2 <- c(out$k,x1a, x2) names(out2) = c("k","Mean","CIlow","CIup","tau2","se.tau2","Q","Q.p","I2","H2") out2 } ) cormat <- matrix("", ncol = 5, nrow = 5) rownames(cormat)=colnames(cormat)=c("E", "F", "H", "R", "S") cormat[lower.tri(cormat, diag = FALSE)] = paste(round(cor_rm$Mean, 2), "\n[", round(cor_rm$CIlow, 2), ", ", round(cor_rm$CIup, 2), "]") cormat[lower.tri(cormat, diag = FALSE)] = t(cormat[lower.tri(cormat, diag = FALSE)]) cormat[upper.tri(cormat, diag = FALSE)] = as.character(cor_rm$k) cormat[upper.tri(cormat, diag = FALSE)] = t(cormat[upper.tri(cormat, diag = FALSE)]) datatable(cormat, caption = "Table 2: Meta Analysis Correlations among varaibles", filter = "top") #'