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”.
Paper
, Year: the author and year of the paperSample
: if the same paper report several samplesSamplePopulation
: whether the sample is from student, community, professional populationsSampletype
: reclassify sample types into student vs nonstudent.Language
: language of the sampleFirstLanguage
: reclassify language to English vs non-EnglishSamplesize
: sample size.Samplesize100
: sample size/100MeanAge
: Mean age of the sampleMeasureVersion
: 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 scaleLikert
: likert point used in the scaleLikertPoint
: same as `Likert
but removing points other than 5 and 7.AlphaValue
: Cronbach’s alpha value of the scale.MeanScore
: the scale mean scoresMeanScoreTrans
: to accommodate the different likert point, all mean scores are transformed into 0-1 interval.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))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(xx$MeasureVersion, xx$FirstLanguage)
## X-squared = 2.4206, df = 1, p-value = 0.1198
Measure Version & Sample type
chisq.test(table(xx$MeasureVersion, xx$Sampletype))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(xx$MeasureVersion, xx$Sampletype)
## X-squared = 1.9021, df = 1, p-value = 0.1678
Measure Version & Subscale
chisq.test(table(DOSPERT_RG_Data$MeasureVersion, DOSPERT_RG_Data$Scale))
##
## Pearson's Chi-squared test
##
## data: table(DOSPERT_RG_Data$MeasureVersion, DOSPERT_RG_Data$Scale)
## X-squared = 5.4448, df = 5, p-value = 0.364
Scale aspects & Subscale versions
chisq.test(table(DOSPERT_RG_Data$ScaleAspect, DOSPERT_RG_Data$Scale))
##
## Pearson's Chi-squared test
##
## data: table(DOSPERT_RG_Data$ScaleAspect, DOSPERT_RG_Data$Scale)
## X-squared = 2.5935, df = 10, p-value = 0.9894
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)
# 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)
}
)
## data frame with 0 columns and 0 rows
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
## [1] 266
## 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
## integer(0)
## 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
## [1] 266 267 12
datatable(DOSPERT_RG_testol[c(x$rowid, x2$rowid), ],
caption = "Influencial Cases across scales")
# 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)
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)
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)
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)
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)
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)
# 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")
##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)
##
## Mixed-Effects Model (k = 465; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.149 (SE = 0.011)
## tau (square root of estimated tau^2 value): 0.386
## I^2 (residual heterogeneity / unaccounted variability): 95.35%
## H^2 (unaccounted variability / sampling variability): 21.51
## R^2 (amount of heterogeneity accounted for): 0.46%
##
## Test for Residual Heterogeneity:
## QE(df = 462) = 9742.949, p-val < .001
##
## Test of Moderators (coefficient(s) 2:3):
## F(df1 = 2, df2 = 462) = 2.124, p-val = 0.121
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.481 0.025 59.519 <.001 1.433 1.530
## ScaleAspectBenefitPercet 0.023 0.042 0.553 0.581 -0.059 0.105
## ScaleAspectRiskPercept 0.032 0.035 0.917 0.360 -0.036 0.099
##
## intrcpt ***
## ScaleAspectBenefitPercet
## ScaleAspectRiskPercept
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 464; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.147 (SE = 0.011)
## tau (square root of estimated tau^2 value): 0.383
## I^2 (residual heterogeneity / unaccounted variability): 95.27%
## H^2 (unaccounted variability / sampling variability): 21.13
## R^2 (amount of heterogeneity accounted for): 0.29%
##
## Test for Residual Heterogeneity:
## QE(df = 461) = 9387.876, p-val < .001
##
## Test of Moderators (coefficient(s) 2:3):
## F(df1 = 2, df2 = 461) = 1.759, p-val = 0.173
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.478 0.025 59.651 <.001 1.429 1.526
## ScaleAspectBenefitPercet 0.027 0.041 0.650 0.516 -0.054 0.108
## ScaleAspectRiskPercept 0.024 0.034 0.694 0.488 -0.044 0.092
##
## intrcpt ***
## ScaleAspectBenefitPercet
## ScaleAspectRiskPercept
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 396; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.071 (SE = 0.006)
## tau (square root of estimated tau^2 value): 0.267
## I^2 (residual heterogeneity / unaccounted variability): 90.77%
## H^2 (unaccounted variability / sampling variability): 10.84
## R^2 (amount of heterogeneity accounted for): 30.97%
##
## Test for Residual Heterogeneity:
## QE(df = 391) = 4392.082, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 391) = 38.133, p-val < .001
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.319 0.033 40.375 <.001 1.255 1.383 ***
## ScaleFinancial 0.190 0.049 3.876 <.001 0.094 0.286 ***
## ScaleHealth -0.096 0.045 -2.114 0.035 -0.186 -0.007 *
## ScaleRecreational 0.313 0.046 6.807 <.001 0.222 0.403 ***
## ScaleSocial -0.169 0.045 -3.735 <.001 -0.258 -0.080 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 395; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.067 (SE = 0.006)
## tau (square root of estimated tau^2 value): 0.258
## I^2 (residual heterogeneity / unaccounted variability): 90.16%
## H^2 (unaccounted variability / sampling variability): 10.16
## R^2 (amount of heterogeneity accounted for): 32.94%
##
## Test for Residual Heterogeneity:
## QE(df = 390) = 3915.352, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 390) = 40.513, p-val < .001
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.302 0.032 40.596 <.001 1.239 1.365 ***
## ScaleFinancial 0.208 0.048 4.334 <.001 0.114 0.302 ***
## ScaleHealth -0.079 0.044 -1.768 0.078 -0.166 0.009 .
## ScaleRecreational 0.330 0.045 7.344 <.001 0.242 0.418 ***
## ScaleSocial -0.152 0.044 -3.427 <.001 -0.239 -0.065 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 274; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.064 (SE = 0.007)
## tau (square root of estimated tau^2 value): 0.253
## I^2 (residual heterogeneity / unaccounted variability): 89.56%
## H^2 (unaccounted variability / sampling variability): 9.57
## R^2 (amount of heterogeneity accounted for): 38.39%
##
## Test for Residual Heterogeneity:
## QE(df = 269) = 2471.471, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 269) = 34.859, p-val < .001
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.293 0.038 33.754 <.001 1.218 1.369 ***
## ScaleFinancial 0.180 0.057 3.169 0.002 0.068 0.292 **
## ScaleHealth -0.123 0.052 -2.346 0.020 -0.226 -0.020 *
## ScaleRecreational 0.363 0.054 6.725 <.001 0.257 0.469 ***
## ScaleSocial -0.179 0.054 -3.340 <.001 -0.284 -0.073 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 80; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.069 (SE = 0.013)
## tau (square root of estimated tau^2 value): 0.263
## I^2 (residual heterogeneity / unaccounted variability): 89.82%
## H^2 (unaccounted variability / sampling variability): 9.83
## R^2 (amount of heterogeneity accounted for): 5.92%
##
## Test for Residual Heterogeneity:
## QE(df = 75) = 954.147, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 75) = 2.055, p-val = 0.095
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.387 0.070 19.826 <.001 1.247 1.526 ***
## ScaleFinancial 0.078 0.104 0.753 0.454 -0.129 0.285
## ScaleHealth 0.018 0.101 0.175 0.862 -0.183 0.218
## ScaleRecreational 0.119 0.097 1.219 0.227 -0.075 0.313
## ScaleSocial -0.136 0.096 -1.410 0.163 -0.328 0.056
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 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)
##
## Mixed-Effects Model (k = 76; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.034 (SE = 0.008)
## tau (square root of estimated tau^2 value): 0.185
## I^2 (residual heterogeneity / unaccounted variability): 80.45%
## H^2 (unaccounted variability / sampling variability): 5.12
## R^2 (amount of heterogeneity accounted for): 22.11%
##
## Test for Residual Heterogeneity:
## QE(df = 71) = 309.769, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 71) = 4.257, p-val = 0.004
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.301 0.056 23.098 <.001 1.188 1.413 ***
## ScaleFinancial 0.165 0.082 1.996 0.050 0.000 0.329 *
## ScaleHealth 0.098 0.080 1.226 0.224 -0.061 0.256
## ScaleRecreational 0.158 0.078 2.015 0.048 0.002 0.314 *
## ScaleSocial -0.107 0.079 -1.360 0.178 -0.264 0.050
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# 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)
##
## Mixed-Effects Model (k = 42; tau^2 estimator: REML)
##
## tau^2 (estimated amount of residual heterogeneity): 0.081 (SE = 0.021)
## tau (square root of estimated tau^2 value): 0.284
## I^2 (residual heterogeneity / unaccounted variability): 93.06%
## H^2 (unaccounted variability / sampling variability): 14.42
## R^2 (amount of heterogeneity accounted for): 44.49%
##
## Test for Residual Heterogeneity:
## QE(df = 37) = 599.097, p-val < .001
##
## Test of Moderators (coefficient(s) 2:5):
## F(df1 = 4, df2 = 37) = 8.613, p-val < .001
##
## Model Results:
##
## estimate se tval pval ci.lb ci.ub
## intrcpt 1.350 0.099 13.690 <.001 1.150 1.550 ***
## ScaleFinancial 0.578 0.165 3.494 0.001 0.243 0.913 **
## ScaleHealth -0.073 0.144 -0.507 0.615 -0.365 0.219
## ScaleRecreational 0.375 0.140 2.688 0.011 0.092 0.658 *
## ScaleSocial -0.187 0.134 -1.397 0.171 -0.458 0.084
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
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)
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)
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)
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)
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)
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)
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")