Regulatory Focus for Charitable Giving Motivations – Scale Development Factor Analysis
2023-05-10
Loading Packages
library(psych)
library(corrplot)
library(psych)
library(ggplot2)
library(readr)
library(here)
library(tidyverse)
library(GPArotation)Creating dataframe with regulatory focus items
Creating dataframe with regulatory focus items for exploratory factor analysis
rf <- select(fa, starts_with("regulatory_focus")) Examining Data Fitness for Factor Analysis
Kaiser-Meyer Test – “The test measures sampling adequacy for each variable in the model and the complete model. The statistic is a measure of the proportion of variance among variables that might be common variance. The higher the proportion, the higher the KMO-value, the more suited the data is to factor analysis”
Values above .60 considered adequate, above .9 considered “marvelous” :)
psych::KMO(rf) ## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = rf)
## Overall MSA = 0.93
## MSA for each item =
## regulatory_focus_1 regulatory_focus_2 regulatory_focus_3 regulatory_focus_4
## 0.93 0.94 0.96 0.95
## regulatory_focus_5 regulatory_focus_6 regulatory_focus_7 regulatory_focus_8
## 0.93 0.93 0.94 0.94
## regulatory_focus_9 regulatory_focus_10 regulatory_focus_11 regulatory_focus_12
## 0.94 0.96 0.84 0.84
## regulatory_focus_13 regulatory_focus_14 regulatory_focus_15 regulatory_focus_16
## 0.91 0.91 0.89 0.89
## regulatory_focus_17 regulatory_focus_18 regulatory_focus_19 regulatory_focus_20
## 0.96 0.96 0.96 0.95
## regulatory_focus_21 regulatory_focus_22 regulatory_focus_23
## 0.95 0.96 0.96Scree Plot
A scree plot is a visualization of the analysis performed to evaluate how many factors or dimensions best account for the data – the rule of thumb here is to look for the “elbow” – essentially where you are no longer gaining much in explanatory strength with an additional dimension or where eigenvalues fall below a certain threshold
ncol(rf)## [1] 23library(ggplot2)
fafitfree <- fa(rf,nfactors = ncol(rf), rotate = "none")
n_factors <- length(fafitfree$e.values)
scree <- data.frame(
Factor_n = as.factor(1:n_factors),
Eigenvalue = fafitfree$e.values)
ggplot(scree, aes(x = Factor_n, y = Eigenvalue, group = 1)) +
geom_point() + geom_line() +
xlab("Number of factors") +
ylab("Initial eigenvalue") +
labs( title = "Scree Plot",
subtitle = "(Based on the unreduced correlation matrix)")
Parellel
parallel <- fa.parallel(rf) # Suggests three components and 5 factors
## Parallel analysis suggests that the number of factors = 5 and the number of components = 3Parallel analysis suggests 3 components (largest majority explained by 3 clusters and 5 factors – data suggests five unique dimensions to the data)
Factor Analysis
Now we examine the item loadings – which items (questions being evaluated for the scale) load most heavily on each of these factors – what do these grouped items tell us about latent variables?
Items that do not load strongly onto any factors can be dicarded along with items that cross-load – have roughly equal weighting across multiple factors
rf_clean <- filter(rf, complete.cases(rf))
# Fitting data to 2 factors
factanal.3 <- factanal(rf_clean, factors=3, scores = c("regression"), rotation = "promax")
print(factanal.3, cutoff=0.2)##
## Call:
## factanal(x = rf_clean, factors = 3, scores = c("regression"), rotation = "promax")
##
## Uniquenesses:
## regulatory_focus_1 regulatory_focus_2 regulatory_focus_3 regulatory_focus_4
## 0.481 0.431 0.530 0.320
## regulatory_focus_5 regulatory_focus_6 regulatory_focus_7 regulatory_focus_8
## 0.336 0.372 0.421 0.372
## regulatory_focus_9 regulatory_focus_10 regulatory_focus_11 regulatory_focus_12
## 0.508 0.479 0.130 0.110
## regulatory_focus_13 regulatory_focus_14 regulatory_focus_15 regulatory_focus_16
## 0.372 0.396 0.585 0.577
## regulatory_focus_17 regulatory_focus_18 regulatory_focus_19 regulatory_focus_20
## 0.514 0.548 0.298 0.482
## regulatory_focus_21 regulatory_focus_22 regulatory_focus_23
## 0.355 0.444 0.746
##
## Loadings:
## Factor1 Factor2 Factor3
## regulatory_focus_1 0.652 -0.243
## regulatory_focus_2 0.656 -0.240 0.244
## regulatory_focus_3 0.563
## regulatory_focus_4 0.760
## regulatory_focus_5 0.772
## regulatory_focus_6 0.798
## regulatory_focus_7 0.756
## regulatory_focus_8 0.729
## regulatory_focus_9 0.231 0.574
## regulatory_focus_10 0.231 0.499
## regulatory_focus_11 0.948
## regulatory_focus_12 0.969
## regulatory_focus_13 0.795
## regulatory_focus_14 0.804
## regulatory_focus_15 0.496
## regulatory_focus_16 0.256 0.487
## regulatory_focus_17 0.702 0.213
## regulatory_focus_18 0.646 0.221
## regulatory_focus_19 0.897
## regulatory_focus_20 0.652 0.209
## regulatory_focus_21 0.861
## regulatory_focus_22 0.774
## regulatory_focus_23 0.551
##
## Factor1 Factor2 Factor3
## SS loadings 6.309 4.051 2.600
## Proportion Var 0.274 0.176 0.113
## Cumulative Var 0.274 0.450 0.563
##
## Factor Correlations:
## Factor1 Factor2 Factor3
## Factor1 1.000 -0.357 0.479
## Factor2 -0.357 1.000 -0.596
## Factor3 0.479 -0.596 1.000
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 2858.02 on 187 degrees of freedom.
## The p-value is 0factanal.5 <- factanal(rf_clean, factors=5, scores = c("regression"), rotation = "varimax")
print(factanal.5, cutoff=0.2)##
## Call:
## factanal(x = rf_clean, factors = 5, scores = c("regression"), rotation = "varimax")
##
## Uniquenesses:
## regulatory_focus_1 regulatory_focus_2 regulatory_focus_3 regulatory_focus_4
## 0.386 0.314 0.503 0.249
## regulatory_focus_5 regulatory_focus_6 regulatory_focus_7 regulatory_focus_8
## 0.275 0.337 0.395 0.363
## regulatory_focus_9 regulatory_focus_10 regulatory_focus_11 regulatory_focus_12
## 0.498 0.467 0.113 0.069
## regulatory_focus_13 regulatory_focus_14 regulatory_focus_15 regulatory_focus_16
## 0.375 0.405 0.229 0.228
## regulatory_focus_17 regulatory_focus_18 regulatory_focus_19 regulatory_focus_20
## 0.471 0.499 0.277 0.430
## regulatory_focus_21 regulatory_focus_22 regulatory_focus_23
## 0.333 0.395 0.708
##
## Loadings:
## Factor1 Factor2 Factor3 Factor4 Factor5
## regulatory_focus_1 0.338 0.677
## regulatory_focus_2 0.335 0.720 0.231
## regulatory_focus_3 0.366 0.492 0.253 0.217
## regulatory_focus_4 0.456 0.693 0.226
## regulatory_focus_5 0.469 0.675 0.212
## regulatory_focus_6 0.205 0.220 0.743
## regulatory_focus_7 0.251 0.689
## regulatory_focus_8 0.254 0.314 0.677
## regulatory_focus_9 0.322 0.572
## regulatory_focus_10 0.280 0.330 0.550
## regulatory_focus_11 0.910 0.211
## regulatory_focus_12 0.938
## regulatory_focus_13 0.715 0.251
## regulatory_focus_14 0.712 0.231
## regulatory_focus_15 0.421 0.224 0.707
## regulatory_focus_16 0.245 0.409 0.704
## regulatory_focus_17 0.642 0.204
## regulatory_focus_18 0.579 0.279
## regulatory_focus_19 0.739 0.358
## regulatory_focus_20 0.641 0.216 0.225
## regulatory_focus_21 0.711 0.354
## regulatory_focus_22 0.692 0.283
## regulatory_focus_23 0.467 0.222
##
## Factor1 Factor2 Factor3 Factor4 Factor5
## SS loadings 4.047 3.545 2.877 2.777 1.435
## Proportion Var 0.176 0.154 0.125 0.121 0.062
## Cumulative Var 0.176 0.330 0.455 0.576 0.638
##
## Test of the hypothesis that 5 factors are sufficient.
## The chi square statistic is 1019.35 on 148 degrees of freedom.
## The p-value is 5.01e-130Three Factor Solution does not distinguish between other-focused and self-focused promotion motives, but does distinguish between a general sense of responsibility towards others – more neutral valence about reducing generalized guilt for being priviledged not helping enough vs. an emphasis about feeling terrible
Five Factor solution dimension descriptions:
1 Other-focused promotion – create something good/beautiful 2 Self-focused promotion – feel sense of meaning/warm glow 3 Other-focused prevention – prevent harm to others 4 Self-focused prevention – ego protection 5 Self-focused prevention – responsibility maintenance
#Creating Composite Scores based on Factor Analysis Results
Using the clusters identified in the analyses above (taking highest factor loadings while dropping items with high cross-loadings)
other_focused_positive_df <- select(rf, regulatory_focus_1, regulatory_focus_2, regulatory_focus_4, regulatory_focus_5) # 3 crossloads
psych::alpha(other_focused_positive_df)##
## Reliability analysis
## Call: psych::alpha(x = other_focused_positive_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.9 0.9 0.87 0.68 8.7 0.0045 7.5 1.5 0.68
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.89 0.9 0.90
## Duhachek 0.89 0.9 0.91
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## regulatory_focus_1 0.88 0.88 0.83 0.71 7.3 0.0055 0.00267
## regulatory_focus_2 0.87 0.86 0.82 0.68 6.4 0.0063 0.00654
## regulatory_focus_4 0.86 0.86 0.80 0.67 6.0 0.0067 0.00245
## regulatory_focus_5 0.86 0.86 0.81 0.68 6.4 0.0063 0.00052
## med.r
## regulatory_focus_1 0.69
## regulatory_focus_2 0.66
## regulatory_focus_4 0.69
## regulatory_focus_5 0.67
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## regulatory_focus_1 1399 0.85 0.85 0.78 0.73 7.5 1.6
## regulatory_focus_2 1399 0.87 0.88 0.82 0.77 7.6 1.6
## regulatory_focus_4 1399 0.89 0.89 0.85 0.80 7.2 1.8
## regulatory_focus_5 1399 0.88 0.88 0.83 0.78 7.5 1.7
##
## Non missing response frequency for each item
## 1 3 4 5 6 7 8 9 miss
## regulatory_focus_1 0.01 0.01 0.02 0.06 0.10 0.19 0.23 0.37 0
## regulatory_focus_2 0.01 0.01 0.01 0.07 0.11 0.17 0.23 0.38 0
## regulatory_focus_4 0.02 0.02 0.03 0.08 0.13 0.22 0.20 0.31 0
## regulatory_focus_5 0.02 0.01 0.02 0.08 0.11 0.18 0.22 0.36 0fa$other_focused_pos_mean <- rowMeans(other_focused_positive_df) # e.g. "My major goal for my charitable giving is to bring about something good in the world."
other_focused_negative_df <- select(rf, regulatory_focus_6, regulatory_focus_7, regulatory_focus_9, regulatory_focus_10) # 8 crossloads
psych::alpha(other_focused_negative_df)##
## Reliability analysis
## Call: psych::alpha(x = other_focused_negative_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.83 0.83 0.79 0.55 5 0.0073 5.4 2.1 0.54
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.82 0.83 0.85
## Duhachek 0.82 0.83 0.85
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## regulatory_focus_6 0.79 0.79 0.72 0.56 3.8 0.0097 0.0028
## regulatory_focus_7 0.79 0.79 0.72 0.55 3.7 0.0097 0.0028
## regulatory_focus_9 0.78 0.78 0.71 0.55 3.6 0.0101 0.0022
## regulatory_focus_10 0.79 0.79 0.72 0.56 3.8 0.0097 0.0016
## med.r
## regulatory_focus_6 0.56
## regulatory_focus_7 0.53
## regulatory_focus_9 0.53
## regulatory_focus_10 0.56
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## regulatory_focus_6 1399 0.80 0.81 0.72 0.65 6.0 2.4
## regulatory_focus_7 1399 0.82 0.82 0.73 0.66 5.4 2.6
## regulatory_focus_9 1399 0.83 0.82 0.74 0.68 4.5 2.6
## regulatory_focus_10 1399 0.81 0.81 0.72 0.66 5.6 2.6
##
## Non missing response frequency for each item
## 1 3 4 5 6 7 8 9 miss
## regulatory_focus_6 0.10 0.06 0.07 0.14 0.15 0.18 0.14 0.17 0
## regulatory_focus_7 0.17 0.08 0.08 0.15 0.13 0.13 0.12 0.14 0
## regulatory_focus_9 0.23 0.13 0.11 0.17 0.10 0.10 0.08 0.08 0
## regulatory_focus_10 0.14 0.09 0.08 0.13 0.14 0.14 0.13 0.15 0fa$other_focused_neg_mean <- rowMeans(other_focused_negative_df) # e.g. "When I give to charity, it’s because I am focused on preventing potential harm to others."
self_focused_negative_df <- select(rf, regulatory_focus_11, regulatory_focus_12)
psych::alpha(self_focused_negative_df) ##
## Reliability analysis
## Call: psych::alpha(x = self_focused_negative_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.95 0.95 0.91 0.91 21 0.0025 3.5 2.5 0.91
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.95 0.95 0.96
## Duhachek 0.95 0.95 0.96
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## regulatory_focus_11 0.91 0.91 0.83 0.91 10 NA 0
## regulatory_focus_12 0.91 0.91 0.83 0.91 10 NA 0
## med.r
## regulatory_focus_11 0.91
## regulatory_focus_12 0.91
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## regulatory_focus_11 1399 0.98 0.98 0.93 0.91 3.5 2.6
## regulatory_focus_12 1399 0.98 0.98 0.93 0.91 3.5 2.6
##
## Non missing response frequency for each item
## 1 3 4 5 6 7 8 9 miss
## regulatory_focus_11 0.42 0.12 0.09 0.10 0.10 0.08 0.04 0.05 0
## regulatory_focus_12 0.43 0.13 0.09 0.11 0.09 0.08 0.04 0.05 0fa$self_focused_neg_mean <- rowMeans(self_focused_negative_df) #e.g., "I give to charity because I feel terrible about myself when I don’t give."
# not giving as a signal of one's character -- integrity threat -- ego protection motive; although stronger correlation with other-focused prevention makes me wonder if this is more about feeling morally responsible for others in a way that makes one feel terrible, whereas the other may be more about alleviating guilt about privilege.
self_focused_positive_df <- select(rf, regulatory_focus_17, regulatory_focus_18, regulatory_focus_19) #
psych::alpha(self_focused_positive_df)##
## Reliability analysis
## Call: psych::alpha(x = self_focused_positive_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.79 0.8 0.73 0.57 3.9 0.0097 6.7 1.7 0.6
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.77 0.79 0.81
## Duhachek 0.77 0.79 0.81
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## regulatory_focus_17 0.73 0.75 0.60 0.60 3.0 0.014 NA
## regulatory_focus_18 0.74 0.75 0.60 0.60 3.0 0.014 NA
## regulatory_focus_19 0.67 0.68 0.51 0.51 2.1 0.017 NA
## med.r
## regulatory_focus_17 0.60
## regulatory_focus_18 0.60
## regulatory_focus_19 0.51
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## regulatory_focus_17 1399 0.83 0.83 0.69 0.61 6.7 2.1
## regulatory_focus_18 1399 0.85 0.83 0.69 0.62 6.3 2.3
## regulatory_focus_19 1399 0.85 0.87 0.77 0.69 7.0 1.8
##
## Non missing response frequency for each item
## 1 3 4 5 6 7 8 9 miss
## regulatory_focus_17 0.05 0.03 0.05 0.10 0.17 0.21 0.18 0.22 0
## regulatory_focus_18 0.09 0.04 0.06 0.11 0.17 0.20 0.14 0.20 0
## regulatory_focus_19 0.03 0.02 0.03 0.09 0.17 0.22 0.20 0.25 0fa$self_focused_pos_mean <- rowMeans(self_focused_positive_df) # e.g. "I feel very privileged to be able to give to others."
self_focused_negative_guilt_df <- select(rf, regulatory_focus_13, regulatory_focus_14)
psych::alpha(self_focused_negative_guilt_df) ##
## Reliability analysis
## Call: psych::alpha(x = self_focused_negative_guilt_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.86 0.76 0.76 6.4 0.0073 3.2 2.4 0.76
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.85 0.86 0.88
## Duhachek 0.85 0.86 0.88
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## regulatory_focus_13 0.80 0.76 0.58 0.76 3.2 NA 0
## regulatory_focus_14 0.72 0.76 0.58 0.76 3.2 NA 0
## med.r
## regulatory_focus_13 0.76
## regulatory_focus_14 0.76
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## regulatory_focus_13 1399 0.94 0.94 0.82 0.76 3.5 2.6
## regulatory_focus_14 1399 0.94 0.94 0.82 0.76 3.0 2.5
##
## Non missing response frequency for each item
## 1 3 4 5 6 7 8 9 miss
## regulatory_focus_13 0.44 0.11 0.09 0.11 0.10 0.07 0.05 0.04 0
## regulatory_focus_14 0.52 0.11 0.09 0.08 0.08 0.06 0.04 0.03 0fa$self_focused_negative_guilt_mean <- rowMeans(self_focused_negative_guilt_df) # # Reduce Guilt e.g. "I often give to charity to reduce the guilt I feel about not helping." -- "I give to charity because I feel guilty about my privileges. I owe it to others to give to charity."
# not giving as a signal of unmet goal -- goal/value motive Correlation Table of Subscales
reg_focus_measures_df <- select(fa, contains("focused"))
datamatrix <- cor(reg_focus_measures_df, use = "complete.obs")
corrplot(datamatrix, method="color", width = 1200, height = 800)## Warning in text.default(pos.xlabel[, 1], pos.xlabel[, 2], newcolnames, srt =
## tl.srt, : "width" is not a graphical parameter## Warning in text.default(pos.xlabel[, 1], pos.xlabel[, 2], newcolnames, srt =
## tl.srt, : "height" is not a graphical parameter## Warning in text.default(pos.ylabel[, 1], pos.ylabel[, 2], newrownames, col =
## tl.col, : "width" is not a graphical parameter## Warning in text.default(pos.ylabel[, 1], pos.ylabel[, 2], newrownames, col =
## tl.col, : "height" is not a graphical parameter## Warning in title(title, ...): "width" is not a graphical parameter## Warning in title(title, ...): "height" is not a graphical parameter
Preliminary Test
test <- glm(fa$complete_vol ~ + fa$self_focused_neg_mean + fa$self_focused_negative_guilt_mean + fa$other_focused_neg_mean + fa$other_focused_pos_mean + fa$self_focused_pos_mean, family = binomial())
test <- glm(fa$complete_vol ~ fa$self_focused_neg_mean + fa$self_focused_negative_guilt_mean + fa$other_focused_neg_mean + fa$other_focused_pos_mean + fa$self_focused_pos_mean, family = binomial())
summary(test)##
## Call:
## glm(formula = fa$complete_vol ~ fa$self_focused_neg_mean + fa$self_focused_negative_guilt_mean +
## fa$other_focused_neg_mean + fa$other_focused_pos_mean + fa$self_focused_pos_mean,
## family = binomial())
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3620 -1.0851 -0.8785 1.2236 1.8884
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.77110 0.31089 -5.697 1.22e-08 ***
## fa$self_focused_neg_mean 0.03718 0.03545 1.049 0.294251
## fa$self_focused_negative_guilt_mean -0.07918 0.03685 -2.148 0.031685 *
## fa$other_focused_neg_mean -0.04267 0.03479 -1.226 0.220079
## fa$other_focused_pos_mean 0.18869 0.05352 3.526 0.000422 ***
## fa$self_focused_pos_mean 0.06820 0.04321 1.578 0.114519
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1916.5 on 1398 degrees of freedom
## Residual deviance: 1878.0 on 1393 degrees of freedom
## AIC: 1890
##
## Number of Fisher Scoring iterations: 4Summarizing Emotions by Valence
# Positive Affect
pa_pre_df <- select(fa, contains("pos_"), -contains("post"), -contains("mean"))
pa_pre_df$pre_1_pos_inspired <- as.numeric(pa_pre_df$pre_1_pos_inspired)
pa_pre_df$pre_2_pos_hopeful <- as.numeric(pa_pre_df$pre_2_pos_hopeful)
pa_post_df <- select(fa, contains("pos_") & contains("post"))
psych::alpha(pa_pre_df)##
## Reliability analysis
## Call: psych::alpha(x = pa_pre_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.95 0.95 0.95 0.57 18 0.0021 3 0.95 0.61
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.94 0.95 0.95
## Duhachek 0.94 0.95 0.95
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## pre_1_pos_inspired 0.94 0.94 0.95 0.57 16 0.0023
## pre_2_pos_hopeful 0.94 0.94 0.95 0.57 16 0.0023
## pre_3_pos_purposeful 0.94 0.94 0.95 0.57 16 0.0023
## pre_4_pos_happy 0.94 0.94 0.95 0.57 16 0.0023
## pre_9_pos_interested 0.94 0.94 0.95 0.57 16 0.0023
## pre_10_pos_excited 0.94 0.94 0.95 0.58 16 0.0022
## pre_12_pos_strong 0.94 0.94 0.95 0.57 16 0.0023
## pre_15_pos_enthusiastic 0.94 0.94 0.94 0.56 16 0.0023
## pre_16_pos_proud 0.94 0.94 0.95 0.57 16 0.0023
## pre_18_pos_alert 0.95 0.95 0.95 0.60 18 0.0020
## pre_21_pos_determined 0.94 0.94 0.95 0.57 16 0.0022
## pre_22_pos_attentive 0.95 0.95 0.95 0.60 18 0.0021
## pre_24_pos_active 0.94 0.94 0.95 0.57 16 0.0022
## var.r med.r
## pre_1_pos_inspired 0.0122 0.60
## pre_2_pos_hopeful 0.0126 0.60
## pre_3_pos_purposeful 0.0140 0.60
## pre_4_pos_happy 0.0126 0.60
## pre_9_pos_interested 0.0145 0.61
## pre_10_pos_excited 0.0115 0.60
## pre_12_pos_strong 0.0130 0.60
## pre_15_pos_enthusiastic 0.0122 0.60
## pre_16_pos_proud 0.0121 0.60
## pre_18_pos_alert 0.0083 0.63
## pre_21_pos_determined 0.0143 0.61
## pre_22_pos_attentive 0.0105 0.63
## pre_24_pos_active 0.0143 0.62
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## pre_1_pos_inspired 1399 0.83 0.82 0.81 0.79 2.6 1.3
## pre_2_pos_hopeful 1399 0.83 0.82 0.81 0.79 3.0 1.3
## pre_3_pos_purposeful 1399 0.80 0.81 0.79 0.77 3.1 1.2
## pre_4_pos_happy 1399 0.81 0.81 0.80 0.77 3.1 1.2
## pre_9_pos_interested 1399 0.80 0.81 0.79 0.77 3.4 1.1
## pre_10_pos_excited 1399 0.78 0.77 0.76 0.73 2.3 1.3
## pre_12_pos_strong 1399 0.83 0.83 0.82 0.80 2.8 1.3
## pre_15_pos_enthusiastic 1399 0.85 0.84 0.84 0.82 2.7 1.3
## pre_16_pos_proud 1399 0.82 0.82 0.80 0.78 2.6 1.3
## pre_18_pos_alert 1399 0.58 0.59 0.55 0.52 3.5 1.2
## pre_21_pos_determined 1399 0.79 0.79 0.77 0.75 3.3 1.2
## pre_22_pos_attentive 1399 0.62 0.64 0.60 0.57 3.9 1.0
## pre_24_pos_active 1399 0.78 0.78 0.76 0.74 2.9 1.3
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## pre_1_pos_inspired 0.25 0.23 0.25 0.17 0.10 0
## pre_2_pos_hopeful 0.15 0.20 0.28 0.23 0.14 0
## pre_3_pos_purposeful 0.12 0.18 0.30 0.26 0.14 0
## pre_4_pos_happy 0.12 0.21 0.28 0.26 0.13 0
## pre_9_pos_interested 0.06 0.14 0.31 0.32 0.18 0
## pre_10_pos_excited 0.35 0.27 0.19 0.13 0.07 0
## pre_12_pos_strong 0.18 0.21 0.29 0.20 0.11 0
## pre_15_pos_enthusiastic 0.21 0.25 0.26 0.18 0.10 0
## pre_16_pos_proud 0.30 0.19 0.26 0.16 0.09 0
## pre_18_pos_alert 0.08 0.11 0.26 0.35 0.20 0
## pre_21_pos_determined 0.11 0.17 0.25 0.28 0.18 0
## pre_22_pos_attentive 0.03 0.07 0.21 0.38 0.30 0
## pre_24_pos_active 0.18 0.21 0.29 0.20 0.12 0psych::alpha(pa_post_df)##
## Reliability analysis
## Call: psych::alpha(x = pa_post_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.96 0.96 0.96 0.62 22 0.0017 3.1 1 0.65
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.95 0.96 0.96
## Duhachek 0.95 0.96 0.96
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## post_1_pos_inspired 0.95 0.95 0.96 0.62 19 0.0019
## post_2_pos_hopeful 0.95 0.95 0.96 0.62 19 0.0019
## post_3_pos_purposeful 0.95 0.95 0.96 0.62 19 0.0019
## post_4_pos_happy 0.95 0.95 0.96 0.62 20 0.0019
## post_9_pos_interested 0.95 0.95 0.96 0.62 20 0.0019
## post_10_pos_excited 0.95 0.95 0.96 0.62 20 0.0019
## post_12_pos_strong 0.95 0.95 0.96 0.62 20 0.0019
## post_15_pos_enthusiastic 0.95 0.95 0.96 0.62 19 0.0019
## post_16_pos_proud 0.95 0.95 0.96 0.62 20 0.0019
## post_18_pos_alert 0.96 0.96 0.96 0.65 23 0.0016
## post_21_pos_determined 0.95 0.95 0.96 0.62 20 0.0019
## post_22_pos_attentive 0.96 0.96 0.96 0.64 22 0.0017
## post_24_pos_active 0.95 0.95 0.96 0.63 20 0.0018
## var.r med.r
## post_1_pos_inspired 0.012 0.64
## post_2_pos_hopeful 0.012 0.64
## post_3_pos_purposeful 0.013 0.65
## post_4_pos_happy 0.012 0.65
## post_9_pos_interested 0.014 0.66
## post_10_pos_excited 0.011 0.65
## post_12_pos_strong 0.013 0.64
## post_15_pos_enthusiastic 0.012 0.64
## post_16_pos_proud 0.011 0.65
## post_18_pos_alert 0.007 0.68
## post_21_pos_determined 0.014 0.66
## post_22_pos_attentive 0.011 0.68
## post_24_pos_active 0.014 0.68
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## post_1_pos_inspired 1399 0.86 0.86 0.85 0.84 2.9 1.3
## post_2_pos_hopeful 1399 0.86 0.86 0.85 0.83 3.1 1.3
## post_3_pos_purposeful 1399 0.85 0.85 0.84 0.82 3.2 1.2
## post_4_pos_happy 1399 0.84 0.83 0.82 0.81 3.1 1.3
## post_9_pos_interested 1399 0.83 0.83 0.82 0.80 3.4 1.1
## post_10_pos_excited 1399 0.82 0.82 0.81 0.79 2.5 1.3
## post_12_pos_strong 1399 0.84 0.84 0.82 0.81 2.8 1.3
## post_15_pos_enthusiastic 1399 0.86 0.85 0.85 0.83 2.8 1.3
## post_16_pos_proud 1399 0.83 0.83 0.81 0.80 2.7 1.3
## post_18_pos_alert 1399 0.61 0.62 0.58 0.55 3.5 1.2
## post_21_pos_determined 1399 0.82 0.82 0.80 0.79 3.3 1.2
## post_22_pos_attentive 1399 0.68 0.69 0.66 0.63 3.8 1.1
## post_24_pos_active 1399 0.80 0.80 0.77 0.76 2.9 1.3
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## post_1_pos_inspired 0.19 0.22 0.26 0.22 0.12 0
## post_2_pos_hopeful 0.14 0.20 0.25 0.25 0.16 0
## post_3_pos_purposeful 0.12 0.17 0.29 0.26 0.17 0
## post_4_pos_happy 0.14 0.20 0.27 0.24 0.15 0
## post_9_pos_interested 0.07 0.13 0.31 0.31 0.18 0
## post_10_pos_excited 0.30 0.24 0.22 0.16 0.08 0
## post_12_pos_strong 0.20 0.21 0.28 0.20 0.12 0
## post_15_pos_enthusiastic 0.22 0.21 0.25 0.19 0.11 0
## post_16_pos_proud 0.27 0.21 0.24 0.17 0.11 0
## post_18_pos_alert 0.08 0.11 0.27 0.33 0.21 0
## post_21_pos_determined 0.10 0.16 0.27 0.28 0.19 0
## post_22_pos_attentive 0.04 0.08 0.25 0.36 0.27 0
## post_24_pos_active 0.17 0.19 0.30 0.22 0.12 0fa$pos_affect_pre_mean <- rowMeans(pa_pre_df)
fa$pos_affect_post_mean <- rowMeans(pa_post_df)
#Negative Affect
na_pre_df <- select(fa, contains("neg_"), -contains("post"), -contains("mean"))
na_post_df <- select(fa, contains("neg_") & contains("post"), -contains("mean"))
psych::alpha(na_pre_df)##
## Reliability analysis
## Call: psych::alpha(x = na_pre_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.93 0.93 0.94 0.54 14 0.0026 1.3 0.58 0.54
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.93 0.93 0.94
## Duhachek 0.93 0.93 0.94
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## pre_5_neg_distressed 0.92 0.93 0.93 0.53 13 0.0029 0.0080
## pre_6_neg_sad 0.93 0.93 0.94 0.54 13 0.0028 0.0083
## pre_7_neg_angry 0.93 0.93 0.93 0.54 13 0.0028 0.0087
## pre_8_neg_guilty 0.93 0.93 0.94 0.55 14 0.0027 0.0082
## pre_11_neg_upset 0.92 0.93 0.93 0.53 12 0.0030 0.0079
## pre_13_neg_scared 0.92 0.93 0.93 0.53 13 0.0029 0.0073
## pre_14_neg_hostile 0.93 0.93 0.94 0.55 14 0.0027 0.0083
## pre_17_neg_irritable 0.93 0.93 0.94 0.55 13 0.0027 0.0093
## pre_19_neg_ashamed 0.93 0.93 0.93 0.55 13 0.0028 0.0090
## pre_20_neg_nervous 0.93 0.93 0.94 0.54 13 0.0028 0.0087
## pre_23_neg_jittery 0.93 0.93 0.94 0.56 14 0.0026 0.0073
## pre_25_neg_afraid 0.92 0.93 0.93 0.53 13 0.0029 0.0074
## med.r
## pre_5_neg_distressed 0.53
## pre_6_neg_sad 0.54
## pre_7_neg_angry 0.54
## pre_8_neg_guilty 0.56
## pre_11_neg_upset 0.51
## pre_13_neg_scared 0.54
## pre_14_neg_hostile 0.55
## pre_17_neg_irritable 0.55
## pre_19_neg_ashamed 0.54
## pre_20_neg_nervous 0.54
## pre_23_neg_jittery 0.56
## pre_25_neg_afraid 0.54
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## pre_5_neg_distressed 1399 0.83 0.82 0.81 0.79 1.4 0.86
## pre_6_neg_sad 1399 0.79 0.78 0.75 0.73 1.5 0.91
## pre_7_neg_angry 1399 0.75 0.76 0.74 0.71 1.2 0.64
## pre_8_neg_guilty 1399 0.69 0.70 0.67 0.63 1.2 0.66
## pre_11_neg_upset 1399 0.84 0.84 0.84 0.81 1.3 0.79
## pre_13_neg_scared 1399 0.82 0.82 0.82 0.78 1.3 0.73
## pre_14_neg_hostile 1399 0.68 0.70 0.66 0.63 1.2 0.61
## pre_17_neg_irritable 1399 0.75 0.74 0.71 0.68 1.5 0.83
## pre_19_neg_ashamed 1399 0.74 0.74 0.72 0.69 1.2 0.69
## pre_20_neg_nervous 1399 0.78 0.76 0.74 0.72 1.5 0.90
## pre_23_neg_jittery 1399 0.66 0.65 0.60 0.58 1.4 0.79
## pre_25_neg_afraid 1399 0.82 0.82 0.81 0.78 1.3 0.73
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## pre_5_neg_distressed 0.74 0.14 0.08 0.03 0.01 0
## pre_6_neg_sad 0.72 0.16 0.07 0.04 0.02 0
## pre_7_neg_angry 0.86 0.09 0.03 0.01 0.01 0
## pre_8_neg_guilty 0.84 0.11 0.03 0.02 0.01 0
## pre_11_neg_upset 0.80 0.12 0.05 0.03 0.01 0
## pre_13_neg_scared 0.85 0.09 0.04 0.02 0.01 0
## pre_14_neg_hostile 0.87 0.08 0.04 0.01 0.01 0
## pre_17_neg_irritable 0.69 0.20 0.08 0.03 0.01 0
## pre_19_neg_ashamed 0.85 0.09 0.04 0.01 0.01 0
## pre_20_neg_nervous 0.70 0.18 0.07 0.03 0.02 0
## pre_23_neg_jittery 0.74 0.17 0.06 0.03 0.01 0
## pre_25_neg_afraid 0.83 0.10 0.04 0.02 0.01 0psych::alpha(na_post_df)##
## Reliability analysis
## Call: psych::alpha(x = na_post_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.94 0.94 0.95 0.56 15 0.0024 1.3 0.58 0.55
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.93 0.94 0.94
## Duhachek 0.93 0.94 0.94
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## post_5_neg_distressed 0.93 0.93 0.94 0.55 14 0.0028 0.0082
## post_6_neg_sad 0.93 0.93 0.94 0.56 14 0.0026 0.0083
## post_7_neg_angry 0.93 0.93 0.94 0.56 14 0.0026 0.0078
## post_8_neg_guilty 0.93 0.94 0.94 0.57 15 0.0025 0.0080
## post_11_neg_upset 0.93 0.93 0.94 0.55 14 0.0027 0.0082
## post_13_neg_scared 0.93 0.93 0.94 0.55 14 0.0027 0.0070
## post_14_neg_hostile 0.93 0.93 0.94 0.56 14 0.0026 0.0085
## post_17_neg_irritable 0.93 0.93 0.94 0.56 14 0.0026 0.0087
## post_19_neg_ashamed 0.93 0.94 0.94 0.57 15 0.0026 0.0085
## post_20_neg_nervous 0.93 0.93 0.94 0.56 14 0.0026 0.0086
## post_23_neg_jittery 0.94 0.94 0.95 0.58 15 0.0025 0.0077
## post_25_neg_afraid 0.93 0.93 0.94 0.55 13 0.0027 0.0072
## med.r
## post_5_neg_distressed 0.53
## post_6_neg_sad 0.55
## post_7_neg_angry 0.55
## post_8_neg_guilty 0.56
## post_11_neg_upset 0.53
## post_13_neg_scared 0.54
## post_14_neg_hostile 0.56
## post_17_neg_irritable 0.55
## post_19_neg_ashamed 0.55
## post_20_neg_nervous 0.55
## post_23_neg_jittery 0.56
## post_25_neg_afraid 0.54
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## post_5_neg_distressed 1399 0.84 0.83 0.82 0.80 1.4 0.83
## post_6_neg_sad 1399 0.78 0.77 0.74 0.72 1.4 0.89
## post_7_neg_angry 1399 0.75 0.76 0.73 0.70 1.2 0.64
## post_8_neg_guilty 1399 0.70 0.71 0.67 0.64 1.3 0.68
## post_11_neg_upset 1399 0.84 0.83 0.82 0.80 1.3 0.80
## post_13_neg_scared 1399 0.83 0.83 0.83 0.80 1.2 0.71
## post_14_neg_hostile 1399 0.75 0.76 0.74 0.70 1.2 0.60
## post_17_neg_irritable 1399 0.77 0.76 0.74 0.71 1.4 0.84
## post_19_neg_ashamed 1399 0.72 0.73 0.70 0.67 1.2 0.64
## post_20_neg_nervous 1399 0.79 0.78 0.76 0.73 1.4 0.87
## post_23_neg_jittery 1399 0.68 0.68 0.64 0.62 1.3 0.75
## post_25_neg_afraid 1399 0.84 0.84 0.84 0.80 1.2 0.71
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## post_5_neg_distressed 0.78 0.12 0.06 0.03 0.02 0
## post_6_neg_sad 0.75 0.14 0.06 0.03 0.02 0
## post_7_neg_angry 0.86 0.08 0.03 0.02 0.01 0
## post_8_neg_guilty 0.83 0.11 0.04 0.02 0.01 0
## post_11_neg_upset 0.81 0.11 0.04 0.02 0.02 0
## post_13_neg_scared 0.86 0.07 0.04 0.01 0.01 0
## post_14_neg_hostile 0.88 0.07 0.04 0.01 0.01 0
## post_17_neg_irritable 0.74 0.16 0.06 0.03 0.01 0
## post_19_neg_ashamed 0.85 0.09 0.03 0.01 0.01 0
## post_20_neg_nervous 0.74 0.16 0.06 0.03 0.02 0
## post_23_neg_jittery 0.78 0.14 0.04 0.03 0.01 0
## post_25_neg_afraid 0.86 0.08 0.03 0.02 0.01 0fa$neg_affect_pre_mean <- rowMeans(na_pre_df)
fa$neg_affect_post_mean <- rowMeans(na_post_df)General Affect Change
fa$neg_emotion_change <- fa$neg_affect_post_mean - fa$neg_affect_pre_mean
fa$pos_emotion_change <- fa$pos_affect_post_mean - fa$pos_affect_pre_mean
hist(fa$neg_emotion_change)
hist(fa$pos_emotion_change)
test <- lm(fa$neg_emotion_change ~ fa$treat)
summary(test)##
## Call:
## lm(formula = fa$neg_emotion_change ~ fa$treat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.46785 -0.05257 0.02938 0.03215 1.69743
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.032154 0.011591 -2.774 0.00561 **
## fa$treat 0.001386 0.008700 0.159 0.87346
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2601 on 1397 degrees of freedom
## Multiple R-squared: 1.816e-05, Adjusted R-squared: -0.0006976
## F-statistic: 0.02537 on 1 and 1397 DF, p-value: 0.8735test <- lm(fa$pos_emotion_change ~ fa$treat)
summary(test)##
## Call:
## lm(formula = fa$pos_emotion_change ~ fa$treat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.22600 -0.20109 -0.02233 0.18353 2.31246
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.02233 0.01737 1.285 0.1989
## fa$treat 0.02491 0.01304 1.911 0.0563 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3899 on 1397 degrees of freedom
## Multiple R-squared: 0.002606, Adjusted R-squared: 0.001892
## F-statistic: 3.65 on 1 and 1397 DF, p-value: 0.05627Response Bias Index
Here we are creating an index of Response Bias (a measure of people’s general tendency to agree or disagree with survey items) by using a previously validated approach in which we compute a mean score using a selection of items with matched pairs of statements with conceptually opposite meanings such that on a 1-5 scale, a perfectly consistent responding would have a mean of 3 – the midpoint on the scale, a tendency to disagree > 3 and a tendency to disagree will be representend by a mean < 3 – or when standardized – mean of 0 etc.
Since this scale uses validated personality measure scales we also get Big Five personality trait measures so we’ll start with creating these variables.
extraversion_df <- select(fa, contains("bfi_e"))
psych::alpha(extraversion_df)##
## Reliability analysis
## Call: psych::alpha(x = extraversion_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.78 0.78 0.75 0.46 3.5 0.0097 2.9 1 0.43
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.76 0.78 0.8
## Duhachek 0.76 0.78 0.8
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## bfi_e_social_Recoded 0.68 0.68 0.59 0.41 2.1 0.015 0.00047
## bfi_e_assertive 0.76 0.76 0.72 0.51 3.1 0.011 0.03898
## bfi_e_energy 0.78 0.77 0.73 0.53 3.4 0.011 0.03037
## bfi_e_social_acq 0.67 0.67 0.57 0.40 2.0 0.015 0.00119
## med.r
## bfi_e_social_Recoded 0.42
## bfi_e_assertive 0.42
## bfi_e_energy 0.44
## bfi_e_social_acq 0.39
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_e_social_Recoded 1399 0.83 0.82 0.78 0.66 2.5 1.3
## bfi_e_assertive 1399 0.73 0.73 0.57 0.51 2.9 1.3
## bfi_e_energy 1399 0.69 0.71 0.53 0.47 3.2 1.2
## bfi_e_social_acq 1399 0.84 0.84 0.81 0.69 2.9 1.3
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_e_social_Recoded 0.29 0.32 0.13 0.15 0.11 0
## bfi_e_assertive 0.18 0.23 0.20 0.27 0.12 0
## bfi_e_energy 0.11 0.23 0.21 0.31 0.15 0
## bfi_e_social_acq 0.18 0.26 0.17 0.25 0.13 0fa$bfi_extraversion <- rowMeans(extraversion_df)
openness_df <- select(fa, contains("bfi_o"))
psych::alpha(openness_df)##
## Reliability analysis
## Call: psych::alpha(x = openness_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.6 0.61 0.51 0.34 1.5 0.018 3.9 0.82 0.34
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.57 0.6 0.64
## Duhachek 0.57 0.6 0.64
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## bfi_o_aesthetic 0.45 0.46 0.30 0.30 0.84 0.029 NA 0.30
## bfi_o_curious 0.50 0.50 0.34 0.34 1.02 0.026 NA 0.34
## bfi_o_creative 0.55 0.56 0.39 0.39 1.25 0.024 NA 0.39
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_o_aesthetic 1399 0.76 0.77 0.58 0.45 4.1 1.1
## bfi_o_curious 1399 0.78 0.75 0.54 0.42 3.8 1.2
## bfi_o_creative 1399 0.70 0.73 0.49 0.38 3.9 1.0
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_o_aesthetic 0.03 0.09 0.12 0.32 0.45 0
## bfi_o_curious 0.05 0.12 0.14 0.32 0.37 0
## bfi_o_creative 0.03 0.09 0.15 0.45 0.28 0fa$bfi_openness <- rowMeans(openness_df)
agreeableness_df <- select(fa, contains("bfi_a"))
psych::alpha(agreeableness_df)## Warning in psych::alpha(agreeableness_df): Some items were negatively correlated with the total scale and probably
## should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' option## Some items ( bfi_a_trust_R_acq ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' option##
## Reliability analysis
## Call: psych::alpha(x = agreeableness_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## -0.52 -0.27 0.14 -0.057 -0.21 0.064 3.5 0.48 -0.017
##
## 95% confidence boundaries
## lower alpha upper
## Feldt -0.65 -0.52 -0.39
## Duhachek -0.65 -0.52 -0.40
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## bfi_a_compassion -1.42 -1.32 -0.337 -0.23 -0.57 0.110
## bfi_a_respect_Recode -0.87 -0.60 -0.069 -0.14 -0.38 0.091
## bfi_a_trust -1.06 -0.77 -0.171 -0.17 -0.44 0.100
## bfi_a_trust_R_acq 0.57 0.59 0.487 0.32 1.41 0.020
## var.r med.r
## bfi_a_compassion 0.1997 -0.49
## bfi_a_respect_Recode 0.2068 -0.32
## bfi_a_trust 0.1773 -0.32
## bfi_a_trust_R_acq 0.0022 0.30
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_a_compassion 1399 0.659 0.75 0.82 0.271 4.3 0.86
## bfi_a_respect_Recode 1399 0.602 0.60 0.54 -0.019 3.9 1.19
## bfi_a_trust 1399 0.641 0.64 0.68 0.030 3.5 1.19
## bfi_a_trust_R_acq 1399 -0.095 -0.16 -1.37 -0.601 2.5 1.26
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_a_compassion 0.01 0.04 0.10 0.38 0.47 0
## bfi_a_respect_Recode 0.02 0.18 0.11 0.28 0.41 0
## bfi_a_trust 0.08 0.15 0.19 0.38 0.20 0
## bfi_a_trust_R_acq 0.26 0.31 0.15 0.22 0.06 0fa$bfi_agreeableness <- rowMeans(agreeableness_df)
neuroticism_df <- select(fa, contains("bfi_n"))
psych::alpha(neuroticism_df)##
## Reliability analysis
## Call: psych::alpha(x = neuroticism_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.81 0.81 0.74 0.59 4.3 0.0086 2.7 1.2 0.58
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.79 0.81 0.83
## Duhachek 0.79 0.81 0.83
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## bfi_n_vol_Recoded 0.76 0.76 0.62 0.62 3.2 0.013 NA
## bfi_n_anxiety 0.73 0.74 0.58 0.58 2.8 0.014 NA
## bfi_n_depression 0.72 0.73 0.57 0.57 2.7 0.015 NA
## med.r
## bfi_n_vol_Recoded 0.62
## bfi_n_anxiety 0.58
## bfi_n_depression 0.57
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_n_vol_Recoded 1399 0.82 0.84 0.71 0.64 2.3 1.2
## bfi_n_anxiety 1399 0.87 0.86 0.74 0.67 3.2 1.5
## bfi_n_depression 1399 0.87 0.86 0.75 0.68 2.6 1.4
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_n_vol_Recoded 0.31 0.33 0.16 0.14 0.06 0
## bfi_n_anxiety 0.18 0.19 0.10 0.29 0.23 0
## bfi_n_depression 0.32 0.22 0.11 0.24 0.12 0fa$bfi_neuroticism <- rowMeans(neuroticism_df)
conscientiousness_df <- select(fa, contains("bfi_c"))
psych::alpha(conscientiousness_df)##
## Reliability analysis
## Call: psych::alpha(x = conscientiousness_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.8 0.8 0.79 0.5 4 0.0079 3.7 0.95 0.46
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.79 0.8 0.82
## Duhachek 0.79 0.8 0.82
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## bfi_c_org_Recoded 0.68 0.69 0.60 0.42 2.2 0.0138 0.0066
## bfi_c_productive_Rec 0.75 0.74 0.71 0.49 2.9 0.0103 0.0540
## bfi_c_responsibility 0.83 0.83 0.79 0.62 4.9 0.0081 0.0170
## bfi_c_org_acq 0.72 0.73 0.66 0.47 2.7 0.0114 0.0151
## med.r
## bfi_c_org_Recoded 0.43
## bfi_c_productive_Rec 0.37
## bfi_c_responsibility 0.61
## bfi_c_org_acq 0.43
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_c_org_Recoded 1399 0.89 0.87 0.85 0.76 3.7 1.32
## bfi_c_productive_Rec 1399 0.82 0.80 0.70 0.63 3.3 1.36
## bfi_c_responsibility 1399 0.61 0.68 0.48 0.44 4.3 0.85
## bfi_c_org_acq 1399 0.83 0.82 0.77 0.68 3.6 1.21
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_c_org_Recoded 0.07 0.18 0.10 0.27 0.38 0
## bfi_c_productive_Rec 0.10 0.27 0.11 0.28 0.24 0
## bfi_c_responsibility 0.01 0.04 0.07 0.36 0.52 0
## bfi_c_org_acq 0.06 0.16 0.15 0.35 0.28 0fa$bfi_conscientiousness <- rowMeans(conscientiousness_df)
acquiescence_items_df <- select(fa, contains("acq"))
acquiescence_items_df <- 6 -acquiescence_items_df # Reverse-coding conceptual opposites
#Response Bias Dataframe -- both acquiescence items reversecoded and their positive key opposites
rb_df <- select(fa, bfi_c_org_Recoded, bfi_a_trust, bfi_e_social_Recoded)
rb_df <- bind_cols(rb_df, acquiescence_items_df)
psych::alpha(rb_df) # A negative alpha here is exactly what we would want to see## Warning in psych::alpha(rb_df): Some items were negatively correlated with the total scale and probably
## should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' option## Some items ( bfi_c_org_acq bfi_e_social_acq ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' option##
## Reliability analysis
## Call: psych::alpha(x = rb_df)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## -0.58 -0.53 0.24 -0.061 -0.35 0.062 3.1 0.43 -0.044
##
## 95% confidence boundaries
## lower alpha upper
## Feldt -0.71 -0.58 -0.45
## Duhachek -0.70 -0.58 -0.46
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## bfi_c_org_Recoded -0.452 -0.375 0.14 -0.0577 -0.273 0.060
## bfi_a_trust -1.440 -1.451 -0.16 -0.1343 -0.592 0.102
## bfi_e_social_Recoded -0.304 -0.294 0.20 -0.0476 -0.227 0.054
## bfi_c_org_acq 0.042 0.085 0.39 0.0183 0.093 0.039
## bfi_e_social_acq 0.027 0.020 0.36 0.0042 0.021 0.038
## bfi_a_trust_R_acq -1.974 -1.888 -0.35 -0.1504 -0.654 0.126
## var.r med.r
## bfi_c_org_Recoded 0.10 -0.090
## bfi_a_trust 0.12 -0.065
## bfi_e_social_Recoded 0.11 -0.065
## bfi_c_org_acq 0.11 0.102
## bfi_e_social_acq 0.11 0.102
## bfi_a_trust_R_acq 0.12 -0.110
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## bfi_c_org_Recoded 1399 0.361 0.322 0.25 -0.16 3.7 1.3
## bfi_a_trust 1399 0.675 0.698 0.70 0.28 3.5 1.2
## bfi_e_social_Recoded 1399 0.287 0.273 0.11 -0.24 2.5 1.3
## bfi_c_org_acq 1399 -0.085 -0.050 -0.53 -0.49 2.4 1.2
## bfi_e_social_acq 1399 0.024 0.019 -0.41 -0.44 3.1 1.3
## bfi_a_trust_R_acq 1399 0.774 0.777 0.87 0.41 3.5 1.3
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## bfi_c_org_Recoded 0.07 0.18 0.10 0.27 0.38 0
## bfi_a_trust 0.08 0.15 0.19 0.38 0.20 0
## bfi_e_social_Recoded 0.29 0.32 0.13 0.15 0.11 0
## bfi_c_org_acq 0.28 0.35 0.15 0.16 0.06 0
## bfi_e_social_acq 0.13 0.25 0.17 0.26 0.18 0
## bfi_a_trust_R_acq 0.06 0.22 0.15 0.31 0.26 0fa$response_bias_index <- rowMeans(rb_df)
hist(fa$response_bias_index) # I would almost describe this distribution as bimodal -- that there is a spike -- large group of people who respond in logically consistent ways using the the range of response options-- and also a slight skew -- another cluster with a slight acquiescence bias -- tendency to slightly agree
#write_csv(fa, here("Desktop","pilot_data_with_reg_focus_subscales.csv"))