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”.

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.

2 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))
## 
##  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

2.1 Dependence among categorical variables for alpha values

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

3 Missing values, publication bias and outliers

3.1 Missing value influence

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)

3.2 Publication Bias

3.2.1 Funnel plot and test of symmetry (Figure 2)

# 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

3.3 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 
## [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")

4 Random effect models

4.1 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)

4.2 Mean weighted alpha - Scale Characteristics (Table 3; for k, mean, and 95%CI)

4.2.1 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)

4.2.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)

4.2.3 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)

4.3 Mean weighted alpha - Sample charcteristic (Table 4; for k, mean, and 95%CI)

4.3.1 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)

4.3.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)

4.4 Figure 3 Plot

# 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")

5 Meta analysis - Single factor models

5.1 Scale characteristics

5.1.1 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)  
## 
## 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

5.1.2 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)             
## 
## 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

5.2 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)

5.2.1 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)

5.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)

5.3.1 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)

5.4 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)

5.5 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)

6 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")