Cognitive ability and political preferences in Denmark
Emil O. W. Kirkegaard, Julius D. Bjerrekær and Noah Carl
September 15, 2016
Introduction
Many studies have examined the relationship between cognitive ability and political preferences. We formed a three man team – Noah Carl, Julius Bjerrekær and myself – to study this in the Danish population using a custom questionnaire and data collected using a pollster. This document gives a data-near look at the results, but the findings will be published in a paper not yet written.
As an add-on, we decided to examine whether asking people questions using a 7-point scale or 101-point scale format made a difference. This means that about half the participants were asked about their agree to political questions in the form of familiar “Strongly disagree” to “Don’t know/no opinion” to “Strongly agree”. The other half had to rate their agreement with the statements using a 0-100 scale with the same meaning at the ends and the middle. This split nature of the dataset comes up many times in the analysis of the data. The participants who had to select numbers between 0 and 100 used a slider to do this.
Exclusions
The first question one has to deal with is the exclusion of participants who provided random or incorrect data. We added 3 control questions to the questionnaire consisting of simple tasks to perform that should not be difficult enough to exclude anyone who could also read the other questions in the survey.
#data.frame for storing data
d_exclude = as.data.frame(matrix(nrow=nrow(d), ncol=0))
# for 101 scale -----------------------------------------------------------
d_exclude$control_1_A = is_between(d$control_1_A, 20, 30)
d_exclude$control_2_A = (d$control_2_A >= 90)
d_exclude$control_3_A = is_between(d$control_3_A, 10, 20)
# 7 scale -----------------------------------------------------------------
d_exclude$control_1_B = d$control_1_B == 6
d_exclude$control_2_B = d$control_2_B == 2
d_exclude$control_3_B = d$control_3_B == 5The A variables concern the 101-point group and the B concern the 7-point group. For the 101-point group, the control questions required participants to select a number in a given region, e.g. between 20 and 30. For the 7-point group, the questions required them to select a given value such as 6.
Due to a slight mistake in the initial setup of the questionnaire, it was initially possible to skip some questions, which two people did. We crate a variable to find these as well.
d_exclude$missing = miss_by_case(select(d, A.B.Test:cognitive_4)) > 23Before excluding people, we examine the latent correlations between the control variables. The idea here is that if people who fail them mainly fail them due to answering at random, then most people who fail one control, should fail all or most of them, thus giving rise to very high latent intercorrelations.
hetcor(d_exclude[str_detect(names(d_exclude), "_A")])$correlations %>% round(2)## control_1_A control_2_A control_3_A
## control_1_A 1.00 0.88 0.80
## control_2_A 0.88 1.00 0.92
## control_3_A 0.80 0.92 1.00hetcor(d_exclude[str_detect(names(d_exclude), "_B")])$correlations %>% round(2)## control_1_B control_2_B control_3_B
## control_1_B 1 1 1
## control_2_B 1 1 1
## control_3_B 1 1 1We see that the latent correlations are in fact very strong between the items. They are somewhat stronger for the 7-point group. Perhaps users who took the 101-point version had a somewhat higher chance of getting the control questions right by chance.
Finally, we look at the summary statistics for the exclusions:
v_keep = (rowSums(d_exclude, na.rm=T)) == 3
table(v_keep)## v_keep
## FALSE TRUE
## 68 265table(v_keep) %>% prop.table()## v_keep
## FALSE TRUE
## 0.2 0.8So, about 20% of participants failed one of more of the control questions. This is quite a few considering that this questionnaire was only sent out to users who had previously not failed control questions on a previous survey.
Comparing results between 7-point and 101-point groups
After dealing with exclusions, we come to the question of how to combine the data from the two subgroups. This is not as straightforward as it may seem. A simple idea is to conduct every analysis in parallel and then combine the results in meta-analytic fashion. This is possible, but fairly wasteful. It substantially decreases power to detect relationshipos when using multivariate methods like OLS and LASSO regression, which will be using later. So, we’d like to combine the datasets into one, sometimes called integrative data analysis.
First, however, let’s calcualte the correlations between all the political items by subgroup and see if they are similar. For the 7-point subgroup we also do this using latent correlations which get around the violation of continuity inherent to any non-continuous scale. AFter calcualting the correlations, we compare them in two ways: by looking at absolute differences and at correlation matrix correlations:
# calculate correlation matrices ------------------------------------------
m_7_latent = silence(hetcor(d_7_ordered))
m_7_pearson = wtd.cors(d_7_ordered)
m_101_pearson = d[v_101_cases, v_101_vars] %>% wtd.cors
# compare -----------------------------------------------------------------
m_delta_lps = abs(m_7_latent$correlations - m_7_pearson)
m_delta_lp = abs(m_7_latent$correlations - m_101_pearson)
m_delta_pp = abs(m_7_pearson - m_101_pearson)
#describe
psych::describe(MAT_half(m_delta_lps))## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 190 0.03 0.02 0.02 0.02 0.02 0 0.18 0.18 2.4 9.3 0psych::describe(MAT_half(m_delta_lp))## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 190 0.12 0.09 0.1 0.11 0.1 0 0.35 0.35 0.67 -0.48 0.01psych::describe(MAT_half(m_delta_pp))## vars n mean sd median trimmed mad min max range skew kurtosis
## X1 1 190 0.11 0.09 0.09 0.1 0.09 0 0.33 0.33 0.74 -0.27
## se
## X1 0.01#plot
GG_denhist(MAT_half(m_delta_lps))
GG_denhist(MAT_half(m_delta_lp))
GG_denhist(MAT_half(m_delta_pp))
#correlation
cor(MAT_half(m_7_latent), MAT_half(m_7_pearson))## [1] 0.99cor(MAT_half(m_7_latent), MAT_half(m_101_pearson))## [1] 0.68cor(MAT_half(m_7_pearson), MAT_half(m_101_pearson))## [1] 0.67Thus we see that using latent or Pearson correlations made little difference. The within subsample correlations were very strong and the mean absolute differences very small. It also made little difference to the between subsample analysis, which found pretty a strong correlation between the correlation matrices. It’s unknown exactly how large we expected this correlation to be. With infinite sample size and no method variance, it is expected to be 1.00 for the latent correlations and slightly less using the Pearson correlations. However, since sample size is not infinite, it’s not clear how much, if any, of the reduction from 1.00 is due to method variance, but it seems unlikely to be subtantial.
Combining the data at the case-level
Next we return to the question of how to combine the subsamples. While one could convert the 101-point data to a 7-point scale, this would be lose information. It’s better to convert the 7-point scale. I can think of three ways to do this:
- Using endpoints. 1 -> 0, 7 -> 100. This way the ceiling/floor of the small scale is the same as that of the large scale.
- Using mdipoints. 1 -> 7, 2 -> 21.5, … 7 -> 93. The idea here is that participants who answered 7 may not have answered 100, but anywhere in the last bin of values. This bin corresponds to the values from approximately 86 to 100 the mean of which is about 93.
- Using standardized values. We standardize (convert to Z scores) the values in each subsample independently and then combine them. This results in some compromise between (1) and (2) depending on how participants distributed their scores, but has the cost of losing the original scale.
Let’s try all of them:
#calcualte conversion vectors
v_endpoints = seq(0, 100, length.out = 7); v_endpoints## [1] 0 17 33 50 67 83 100v_midpoints = daply(data.frame(value = 0:100, group = (0:100) %>% cut(7, labels=F)), .variables = "group" , .fun = function(block) {
mean(block$value)
}); v_midpoints## 1 2 3 4 5 6 7
## 7 22 36 50 64 78 93#convert
d_7_endpoints = lapply(d[v_7_cases, v_7_vars], FUN = function(col) {
mapvalues(col, from = 1:7, to = v_endpoints, warn_missing = F)
}) %>% as.data.frame()
d_7_midpoints = lapply(d[v_7_cases, v_7_vars], FUN = function(col) {
mapvalues(col, from = 1:7, to = v_midpoints, warn_missing = F)
}) %>% as.data.frame()
d_7_std = lapply(d[v_7_cases, v_7_vars], FUN = function(col) {
standardize(col)
}) %>% as.data.frame()
d_101_std = lapply(d[v_101_cases, v_101_vars], FUN = function(col) {
standardize(col)
}) %>% as.data.frame()
#rename so datasets can be merged
names(d_7_endpoints) = str_replace(names(d_7_endpoints), pattern = "_B", replacement = "")
names(d_7_midpoints) = str_replace(names(d_7_midpoints), pattern = "_B", replacement = "")
names(d_7_std) = str_replace(names(d_7_std), pattern = "_B", replacement = "")
names(d_101) = str_replace(names(d_101), pattern = "_A", replacement = "")
names(d_101_std) = str_replace(names(d_101_std), pattern = "_A", replacement = "")
#add rownames
rownames(d_7_endpoints) = rownames(d_7_ordered)
rownames(d_7_midpoints) = rownames(d_7_ordered)
rownames(d_7_std) = rownames(d_7_ordered)
rownames(d_101_std) = rownames(d_101)
#combine, and skip the redundant vars
#i.e. skip half-version and controls
d_both_endpoints = merge_datasets_multi(d[!(v_101_vars | v_7_vars | str_detect(names(d), "control"))], d_7_endpoints, d_101)
d_both_midpoints = merge_datasets_multi(d[!(v_101_vars | v_7_vars | str_detect(names(d), "control"))], d_7_midpoints, d_101)
d_both_std = merge_datasets_multi(d[!(v_101_vars | v_7_vars | str_detect(names(d), "control"))], d_7_std, d_101_std)
d_one_7 = merge_datasets_multi(d[!(v_101_vars | v_7_vars | str_detect(names(d), "control"))], d_7_midpoints)
d_one_101 = merge_datasets_multi(d[!(v_101_vars | v_7_vars | str_detect(names(d), "control"))], d_101)After having merged the data using the three methods, let’s pick a single question and see how the data looks by subsample:
gg_layout = list(
xlab("Economic freedom score"),
scale_fill_discrete("Subgroup")
)
GG_denhist(d_both_endpoints, var = "economic_freedom_1", group = "A.B.Test") +
gg_layout
ggsave("figures/endpoints_method.png")
GG_denhist(d_both_midpoints, var = "economic_freedom_1", group = "A.B.Test") +
gg_layout
ggsave("figures/midpoints_method.png")
GG_denhist(d_both_std, var = "economic_freedom_1", group = "A.B.Test") +
gg_layout
ggsave("figures/z_method.png")The spikes are due to the lumping of values that necessary happens when there are fewer options to choose from, but the latent distributions estimated by the density curves are very similar. It does not seem to matter much which exact method is used for the conversion. We have to make a choice and went with the endpoints methods to preserve the range.
## [1] TRUE## [1] TRUE## [1] TRUE## [1] TRUE## [1] TRUECognitive ability
Next up we analyze the cognitive ability data. In this case, we both score the data data collected as part of this project and use the data collected earlier on the same sample. From the previous study we have the 5 ICAR5 items and from this study we have 4 verbal reasoning items. These consist of the 3 Cognitive Reflection Test items and one further item found in Steven Pinker’s The better Angels of our Nature book. We combine extract the new items, score them, combine them with the other scored items and finally examine some some descriptive statistics:
#subset
d_cog_new = d_combined[str_c("cognitive_", 1:4)]
#score
d_cog_new_scored = score_items(d_cog_new, key = c("5", "47", "5", "Tirsdag, dagen efter."))
#combine
d_cog_scored = cbind(d_combined[c("VR.4", "VR.19", "LN.58", "MR.46", "R3D.4")], d_cog_new_scored)
# descriptive -------------------------------------------------------------
psych::describe(d_cog_scored) %>%
write_clipboard()## vars n mean sd median trimmed mad min max range
## VR 4 1.00 259.00 0.77 0.42 1.00 0.84 0.00 0.00 1.00 1.00
## VR 19 2.00 259.00 0.54 0.50 1.00 0.55 0.00 0.00 1.00 1.00
## LN 58 3.00 259.00 0.28 0.45 0.00 0.23 0.00 0.00 1.00 1.00
## MR 46 4.00 259.00 0.57 0.50 1.00 0.58 0.00 0.00 1.00 1.00
## R3D 4 5.00 259.00 0.14 0.35 0.00 0.06 0.00 0.00 1.00 1.00
## cognitive 1 6.00 259.00 0.27 0.44 0.00 0.21 0.00 0.00 1.00 1.00
## cognitive 2 7.00 259.00 0.37 0.48 0.00 0.34 0.00 0.00 1.00 1.00
## cognitive 3 8.00 259.00 0.36 0.48 0.00 0.33 0.00 0.00 1.00 1.00
## cognitive 4 9.00 259.00 0.02 0.14 0.00 0.00 0.00 0.00 1.00 1.00
## skew kurtosis se
## VR 4 -1.29 -0.34 0.03
## VR 19 -0.16 -1.98 0.03
## LN 58 0.96 -1.07 0.03
## MR 46 -0.27 -1.93 0.03
## R3D 4 2.03 2.13 0.02
## cognitive 1 1.05 -0.90 0.03
## cognitive 2 0.53 -1.72 0.03
## cognitive 3 0.58 -1.67 0.03
## cognitive 4 6.95 46.44 0.01#mean pass rate
map_dbl(d_cog_scored, ~mean(.)) %>% mean## [1] 0.37It can be seen that the items vary widely in their difficulty. The last reasoning item was very difficult. Only 2% got it right, which is substantially below the percent expected by pure chance (1/7). There were not very easy items (pass rate >90%) which is usually included to give participants a good start and feel that they can perform the task at hand.
We analyze the data using Item Response Theory factor analysis based on latent correlations and inspect the correlations:
#correlate and factor analyze
cog_irt = irt.fa(d_cog_scored, plot = F)## For i = 9 j = 5 A cell entry of 0 was replaced with correct = TRUE. Check your data!#look correlations
cog_irt$rho %>% round(2)## VR.4 VR.19 LN.58 MR.46 R3D.4 cognitive_1 cognitive_2
## VR.4 1.00 0.34 0.55 0.24 0.21 0.37 0.50
## VR.19 0.34 1.00 0.16 0.21 0.40 0.35 0.38
## LN.58 0.55 0.16 1.00 0.40 0.26 0.31 0.42
## MR.46 0.24 0.21 0.40 1.00 0.13 0.15 0.12
## R3D.4 0.21 0.40 0.26 0.13 1.00 0.25 0.39
## cognitive_1 0.37 0.35 0.31 0.15 0.25 1.00 0.69
## cognitive_2 0.50 0.38 0.42 0.12 0.39 0.69 1.00
## cognitive_3 0.52 0.35 0.20 0.08 0.33 0.55 0.57
## cognitive_4 -0.20 -0.37 -0.11 0.03 0.04 0.15 -0.20
## cognitive_3 cognitive_4
## VR.4 0.52 -0.20
## VR.19 0.35 -0.37
## LN.58 0.20 -0.11
## MR.46 0.08 0.03
## R3D.4 0.33 0.04
## cognitive_1 0.55 0.15
## cognitive_2 0.57 -0.20
## cognitive_3 1.00 -0.19
## cognitive_4 -0.19 1.00#stats
psych::describe(cog_irt$rho %>% MAT_half())## vars n mean sd median trimmed mad min max range skew kurtosis
## X1 1 36 0.24 0.24 0.25 0.25 0.2 -0.37 0.69 1.1 -0.56 -0.21
## se
## X1 0.04#delete last cognitive item
d_cog_scored$cognitive_4 = NULL
#rerun
cog_irt = irt.fa(d_cog_scored)
#mean pass rate
map_dbl(d_cog_scored, ~mean(.)) %>% mean## [1] 0.41Almost all the intercorrelations were positive as expected. The only exceptions occur with the last item. This is because the extreme split of this item (2%/98%) which results in very large standard errors on the intercorrelations. This item was excluded. The descriptive analysis confirms this overall picture with a mean correlation of .24.
After this we dive deeper into the IRT results:
#IRT results
png("figures/IRT_ICC.png")
plot(cog_irt, type = "ICC")
dev.off()## png
## 2png("figures/IRT_IIC.png")
plot(cog_irt, type = "IIC")
dev.off()## png
## 2png("figures/IRT_test.png")
plot(cog_irt, type = "test")
dev.off()## png
## 2#ctt
(ctt_iq_alpha = psych::alpha(d_cog_scored))##
## Reliability analysis
## Call: psych::alpha(x = d_cog_scored)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.66 0.66 0.65 0.19 1.9 0.032 0.41 0.25
##
## lower alpha upper 95% confidence boundaries
## 0.6 0.66 0.72
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## VR.4 0.62 0.62 0.61 0.19 1.7 0.036
## VR.19 0.63 0.63 0.62 0.20 1.7 0.034
## LN.58 0.63 0.63 0.62 0.20 1.7 0.035
## MR.46 0.67 0.67 0.65 0.22 2.0 0.031
## R3D.4 0.65 0.65 0.64 0.21 1.9 0.033
## cognitive_1 0.61 0.61 0.59 0.18 1.6 0.037
## cognitive_2 0.58 0.59 0.57 0.17 1.4 0.039
## cognitive_3 0.61 0.61 0.60 0.18 1.6 0.037
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## VR.4 259 0.54 0.55 0.45 0.37 0.77 0.42
## VR.19 259 0.55 0.53 0.41 0.33 0.54 0.50
## LN.58 259 0.53 0.53 0.41 0.33 0.28 0.45
## MR.46 259 0.43 0.41 0.25 0.19 0.57 0.50
## R3D.4 259 0.42 0.46 0.31 0.26 0.14 0.35
## cognitive_1 259 0.60 0.60 0.53 0.42 0.27 0.44
## cognitive_2 259 0.67 0.67 0.63 0.50 0.37 0.48
## cognitive_3 259 0.60 0.59 0.51 0.41 0.36 0.48
##
## Non missing response frequency for each item
## 0 1 miss
## VR.4 0.23 0.77 0
## VR.19 0.46 0.54 0
## LN.58 0.72 0.28 0
## MR.46 0.43 0.57 0
## R3D.4 0.86 0.14 0
## cognitive_1 0.73 0.27 0
## cognitive_2 0.63 0.37 0
## cognitive_3 0.64 0.36 0The first plot shows the modelled probability of getting the items right based on the latent ability of the person. The second shows how good the items are at discriminating between individuals and how easy they are. The three CRT items appear to do well in comparison with the ICAR5 items, but no item was useless. It can be seen that there is a general lack of items on the left side, meaning that the test was somewhat too difficult. Only VR4 provides a reasonable amount of information about participants with cognitive ability at z = -1 and below. The third plot is just the summed version of the second, making it more clear that we lack items on the left side of the distribution. The last output shows reliability results using classical test theory. This test comes out at an alpha (internal) reliability of about .60, which is acceptable for a 9 item test, but not too good.
Lastly, we score the test using both IRT and the simple sum. IRT-based scoring weighs the items based on their discriminative ability akin to ordinary factor analytic scoring, while simple scoring is just the sum of correct items no matter which. We correlate the two sets of scores:
#score
cog_irt_scores = scoreIrt(stats = cog_irt, items = d_cog_scored)
#save scores
d_combined$CA_irt = cog_irt_scores$theta1 %>% standardize()
d_combined$CA_simple = d_cog_scored %>% rowSums()
#compare
wtd.cors(df_subset_by_pattern(d_combined, pattern = "CA_"))## CA_simple CA_irt
## CA_simple 1.00 0.94
## CA_irt 0.94 1.00The correlation was very strong as expected. In general, the IRT results are to be preferred, so we use them for the remaining analyses.
##
## Changing in d_combined
## From: Pers_lib Econ_lib
## To: self_rated_pers_freedom self_rated_econ_freedomPolitical axes
Before collecting data, we wrote down our predictions about the results. With regards to the political items, we predicted that:
- There will be a common factor for each of the two scales with none or few (<3) items not loading on the common factor in the correct direction.
I have skipped the code for reshaping and labeling the variables, so we can jump straight to the factor analysis of each scale:
#factor analyze
fa_econ = fa(d_econ)
fa_pers = fa(d_pers)
#reverse vectors
reverse_econ = -1 #used because the factor is reversed
reverse_pers = -1
#loading plots
fa_plot_loadings(fa_econ, reverse_vector = reverse_econ)
ggsave("figures/fa_econ.png")## Saving 7 x 5 in imagefa_plot_loadings(fa_pers, reverse_vector = reverse_pers)
ggsave("figures/fa_pers.png")## Saving 7 x 5 in image#save scores
d_combined$econ_freedom_fa_score = fa_econ$scores %>% as.vector %>% multiply_by(reverse_econ)
d_combined$pers_freedom_fa_score = fa_pers$scores %>% as.vector %>% multiply_by(reverse_pers)Inspecting the plots we see that all items loaded in the expected directions: items that measured tendency to prefer more freedom for one aspect of life correlated positive with other items that measured a different aspect of life, and similarly for economic freedom. After this, we save the scores for further analysis.
Still, perhaps the data should be scored another way. To investigate this, we must score the data in other ways and compare them. I can think of two ways to score items more manually:
- Keep scaling. Here we reverse the items based on our theortical understanding and then calculate the mean score across items.
- Standardize scalring. Same as above, but we standardize each item before calculating the mean. This means that general levels of agreement between items have no effect.
As usual, we use both methods to look for method variance that may impact our conclusions:
#which scales to reverse?
fa_econ_directions = c(1, -1, 1, -1, 1, -1, 1, -1, -1, 1)
fa_pers_directions = c(1, -1, 1, 1, -1, -1, -1, 1, 1, -1)
#reverse
d_simple_econ = df_colFunc(d_econ, func = reverse_scale, indices = fa_econ_directions == -1, .min = 0, .max = 100)
d_simple_pers = df_colFunc(d_pers, func = reverse_scale, indices = fa_pers_directions == -1, .min = 0, .max = 100)
#score as the average
d_combined$econ_freedom_simple_score = rowMeans(d_simple_econ)
d_combined$pers_freedom_simple_score = rowMeans(d_simple_pers)
#ctt reliabilities
(ctt_econ_alpha = psych::alpha(d_simple_econ))##
## Reliability analysis
## Call: psych::alpha(x = d_simple_econ)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.71 0.71 0.71 0.19 2.4 0.027 53 15
##
## lower alpha upper 95% confidence boundaries
## 0.66 0.71 0.76
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## Not_ensure_jobs 0.69 0.68 0.69 0.19 2.2
## Higher_min_wage 0.67 0.67 0.67 0.19 2.1
## Not_protectionism 0.71 0.71 0.71 0.21 2.4
## Max_salary 0.68 0.68 0.69 0.19 2.1
## Decrease_income_tax 0.69 0.69 0.69 0.20 2.2
## Increase_property_tax 0.71 0.71 0.71 0.21 2.4
## Keep_regulations_to_min 0.67 0.66 0.67 0.18 2.0
## Reduce_income_diffs 0.65 0.65 0.65 0.17 1.9
## Large_companies_staterun 0.67 0.67 0.67 0.18 2.0
## Liberalize_taxi_law 0.71 0.70 0.71 0.21 2.4
## alpha se
## Not_ensure_jobs 0.029
## Higher_min_wage 0.030
## Not_protectionism 0.027
## Max_salary 0.029
## Decrease_income_tax 0.028
## Increase_property_tax 0.027
## Keep_regulations_to_min 0.031
## Reduce_income_diffs 0.032
## Large_companies_staterun 0.030
## Liberalize_taxi_law 0.027
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Not_ensure_jobs 259 0.52 0.52 0.43 0.36 44 28
## Higher_min_wage 259 0.59 0.58 0.53 0.44 43 28
## Not_protectionism 259 0.38 0.39 0.26 0.21 45 27
## Max_salary 259 0.54 0.53 0.45 0.38 76 28
## Decrease_income_tax 259 0.49 0.50 0.41 0.34 58 26
## Increase_property_tax 259 0.39 0.41 0.29 0.23 71 25
## Keep_regulations_to_min 259 0.61 0.62 0.57 0.48 51 25
## Reduce_income_diffs 259 0.67 0.66 0.65 0.53 42 31
## Large_companies_staterun 259 0.61 0.60 0.54 0.45 53 32
## Liberalize_taxi_law 259 0.43 0.42 0.30 0.24 48 31(ctt_pers_alpha = psych::alpha(d_simple_pers))##
## Reliability analysis
## Call: psych::alpha(x = d_simple_pers)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.6 0.6 0.64 0.13 1.5 0.037 43 15
##
## lower alpha upper 95% confidence boundaries
## 0.53 0.6 0.67
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## Abortion_right 0.60 0.60 0.64 0.14 1.5
## Punish_racist_speech 0.60 0.60 0.63 0.14 1.5
## Blasphemy_legal 0.54 0.54 0.58 0.11 1.2
## Legal_cannabis 0.57 0.57 0.61 0.13 1.3
## Prohibit_LSD 0.60 0.60 0.64 0.14 1.5
## Illegal_sex_work 0.55 0.55 0.58 0.12 1.2
## Punish_flag_burning 0.60 0.60 0.63 0.14 1.5
## Legal_motercycle_no_helmet 0.58 0.57 0.59 0.13 1.3
## Legal_car_no_seatbelt 0.59 0.59 0.60 0.14 1.4
## Restrict_access_porn 0.56 0.56 0.59 0.12 1.3
## alpha se
## Abortion_right 0.037
## Punish_racist_speech 0.037
## Blasphemy_legal 0.043
## Legal_cannabis 0.040
## Prohibit_LSD 0.037
## Illegal_sex_work 0.042
## Punish_flag_burning 0.037
## Legal_motercycle_no_helmet 0.039
## Legal_car_no_seatbelt 0.038
## Restrict_access_porn 0.041
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Abortion_right 259 0.40 0.37 0.23 0.19 73 32
## Punish_racist_speech 259 0.37 0.39 0.26 0.18 46 29
## Blasphemy_legal 259 0.61 0.60 0.56 0.44 50 31
## Legal_cannabis 259 0.53 0.50 0.39 0.31 44 36
## Prohibit_LSD 259 0.38 0.38 0.23 0.18 20 30
## Illegal_sex_work 259 0.57 0.57 0.52 0.40 57 32
## Punish_flag_burning 259 0.43 0.39 0.26 0.20 34 35
## Legal_motercycle_no_helmet 259 0.45 0.50 0.45 0.29 14 26
## Legal_car_no_seatbelt 259 0.39 0.44 0.38 0.23 15 26
## Restrict_access_porn 259 0.54 0.53 0.48 0.36 72 31# simple z scoring --------------------------------------------------------
#standardize + reverse
d_simple_econ_z = d_combined[v_econ_freedom] %>%
df_standardize() %>%
df_colFunc(func = multiply_by, indices = fa_econ_directions == -1, e2 = -1)
d_simple_pers_z = d_combined[v_personal_freedom] %>%
df_standardize() %>%
df_colFunc(func = multiply_by, indices = fa_pers_directions == -1, e2 = -1)
#score
d_combined$econ_freedom_simple_z_score = rowMeans(d_simple_econ_z)
d_combined$pers_freedom_simple_z_score = rowMeans(d_simple_pers_z)In the previous study based on this sample, we asked participants to estimate their own standing on these two political axes, so we can use that to compare with. Our preregistered predictions were:
- Self-rated and measured personal liberalism will correlate poorly. Effect size will be r = .20 ± .30.
- Self-rated and measured economic liberalism will correlate moderately. Effect size will be r = .40 ± .30.
The actual correlations between self-rated and measured scores were:
wtd.cors(df_subset_by_pattern(d_combined, pattern = "pers_")) %>% round(2)## self_rated_pers_freedom pers_freedom_fa_score
## self_rated_pers_freedom 1.00 0.13
## pers_freedom_fa_score 0.13 1.00
## pers_freedom_simple_score 0.15 0.95
## pers_freedom_simple_z_score 0.14 0.95
## pers_freedom_simple_score
## self_rated_pers_freedom 0.15
## pers_freedom_fa_score 0.95
## pers_freedom_simple_score 1.00
## pers_freedom_simple_z_score 1.00
## pers_freedom_simple_z_score
## self_rated_pers_freedom 0.14
## pers_freedom_fa_score 0.95
## pers_freedom_simple_score 1.00
## pers_freedom_simple_z_score 1.00wtd.cors(df_subset_by_pattern(d_combined, pattern = "econ_")) %>% round(2)## self_rated_econ_freedom econ_freedom_fa_score
## self_rated_econ_freedom 1.00 0.49
## econ_freedom_fa_score 0.49 1.00
## econ_freedom_simple_score 0.49 0.98
## econ_freedom_simple_z_score 0.50 0.97
## econ_freedom_simple_score
## self_rated_econ_freedom 0.49
## econ_freedom_fa_score 0.98
## econ_freedom_simple_score 1.00
## econ_freedom_simple_z_score 1.00
## econ_freedom_simple_z_score
## self_rated_econ_freedom 0.50
## econ_freedom_fa_score 0.97
## econ_freedom_simple_score 1.00
## econ_freedom_simple_z_score 1.00We see that which scoring method was used made little difference with intercorreations in the high .90s and will use the factor analytic scores due to their theoretical superiority in the following analyses. We also see that self-rated and measured political scores correlated at sizes close to the predicted values: .12 vs. .20 and .47 vs. 40.
What about the relationships between the political axes? We had predicted a negatiev correlation of -.35 ± .15 based on previous research. What did we find?
GG_scatter(d_combined, "econ_freedom_fa_score", "pers_freedom_fa_score", case_names = F) +
geom_smooth() +
xlab("Economic freedom") +
ylab("Personal freedom")
ggsave("figures/axes.png")So, not at all what was predicted. Not only was the correlation positive, it was also somewhat non-linear.
As a robustness check, we check whether the distribution of scores by whether the data came from the 7-point or 101-point groups:
print(NA)## [1] NAGG_denhist(d_combined, var = "econ_freedom_fa_score", group = "A.B.Test") +
scale_fill_discrete(name = "Subgroup")
GG_denhist(d_combined, var = "pers_freedom_fa_score", group = "A.B.Test") +
scale_fill_discrete(name = "Subgroup")
Again, the difference between the groups is fairly negligible, indicating no substantial bias in our method of converting the data between one scale and little difference in whether participants answered in 7 or 101-point formats.
Predictive analyses
We made two predictions with regard to the relationship between cognitive ability and political scores:
- Cognitive ability will be positively related to the freedom end of both axes. The effect sizes will be r = .25 ± .15.
- There will be a non-linear relationship between cognitive ability and the economic liberalism scale such that the positive slope will decline in strength or perhaps reverse near the end of the ability axis.
To examine the first, we simply plot the two pairs of variables:
GG_scatter(d_combined, x_var = "CA_irt", y_var = "econ_freedom_fa_score", case_names = F) +
geom_smooth() +
xlab("Cognitive ability") + ylab("Economic freedom")## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
ggsave("figures/CA_econ.png")## Saving 7 x 5 in image
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'GG_scatter(d_combined, x_var = "CA_irt", y_var = "pers_freedom_fa_score", case_names = F) +
geom_smooth() +
xlab("Cognitive ability") + ylab("Personal freedom")## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
ggsave("figures/CA_pers.png")## Saving 7 x 5 in image
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'#correct for measurement error
psych::correct.cor(d_combined[c("CA_irt", "econ_freedom_fa_score", "pers_freedom_fa_score")] %>% cor,
y = c(ctt_iq_alpha$total$raw_alpha, ctt_econ_alpha$total$raw_alpha, ctt_pers_alpha$total$raw_alpha)) %>%
write_clipboard()## CA irt econ freedom fa score pers freedom fa score
## CA irt 0.66 0.10 0.23
## econ freedom fa score 0.07 0.71 0.10
## pers freedom fa score 0.14 0.07 0.60We see just about no relationship in either case, including non-linear ones. Perhaps some confounding variables are throwing the relationships off, let’s try OLS regression:
fit_econ = lm("econ_freedom_fa_score ~ CA_irt + Age + Gender + Edu_num + A.B.Test", data = d_combined) %>%
MOD_summary(progress = F)## The model data contains characters. These were automatically converteed but you should probably do this before calling this function.
## The model data contains characters. These were automatically converteed but you should probably do this before calling this function.fit_econ$meta## N R2 R2 adj. R2 10-fold cv
## 259.00 0.04 0.02 0.00fit_econ$coefs %>% write_clipboard()## Beta SE CI lower CI upper
## CA irt 0.03 0.06 -0.09 0.16
## Age -0.08 0.06 -0.20 0.05
## Gender: Female 0.00 <NA> <NA> <NA>
## Gender: Male 0.29 0.13 0.04 0.54
## Edu num 0.08 0.06 -0.04 0.21
## A B Test: Branch 0-100 0.00 <NA> <NA> <NA>
## A B Test: Branch 1-7 0.16 0.12 -0.09 0.40fit_pers = lm("pers_freedom_fa_score ~ CA_irt + Age + Gender + Edu_num + A.B.Test", data = d_combined) %>%
MOD_summary(progress = F)## The model data contains characters. These were automatically converteed but you should probably do this before calling this function.
## The model data contains characters. These were automatically converteed but you should probably do this before calling this function.fit_pers$meta## N R2 R2 adj. R2 10-fold cv
## 259.00 0.10 0.08 0.05fit_pers$coefs %>% write_clipboard()## Beta SE CI lower CI upper
## CA irt 0.10 0.06 -0.03 0.22
## Age -0.21 0.06 -0.33 -0.09
## Gender: Female 0.00 <NA> <NA> <NA>
## Gender: Male 0.43 0.12 0.19 0.67
## Edu num 0.10 0.06 -0.03 0.22
## A B Test: Branch 0-100 0.00 <NA> <NA> <NA>
## A B Test: Branch 1-7 0.01 0.12 -0.22 0.25Again, we don’t find much at all. The only possible exception is that of male gender on both freedom axes, in particlar on personal freedom. OLS regression tends to overfit models resulting false positives. A more conservative approach is LASSO regression, and so we try that as well:
#run LASSO
LASSO_pers = MOD_LASSO(d_combined, dependent = "econ_freedom_fa_score", predictors = c("CA_irt", "Age", "Gender_num", "Edu_num"), runs = 500, progress = F)
LASSO_econ = MOD_LASSO(d_combined, dependent = "pers_freedom_fa_score", predictors = c("CA_irt", "Age", "Gender_num", "Edu_num"), runs = 500, progress = F)
#summarize
MOD_summarize_models(LASSO_econ)## CA_irt Age Gender_num Edu_num
## mean 0.001 -0.004 0.021 0
## median 0.000 0.000 0.000 0
## sd 0.003 0.013 0.033 0
## mad 0.000 0.000 0.000 0
## fraction_zeroNA 0.942 0.848 0.640 1MOD_summarize_models(LASSO_pers)## CA_irt Age Gender_num Edu_num
## mean 0 0 0 0
## median 0 0 0 0
## sd 0 0 0 0
## mad 0 0 0 0
## fraction_zeroNA 1 1 1 1The results are even more negative. LASSO could not find any evidence of predictive validity, not even for gender. This may be due to limitations of this implementation of the LASSO, where one cannot use categorical variables. Instead, gender was coded as a numerical 0/1 variable. This results in a moderate downwards bias, perhaps enough for LASSO to not be able to find the gender effect.
Finally, we may wonder whether this is due to some kind of aggregation problem, so we examine the relationship between cognitive ability and political opinions at the item level:
#get item names
v_polit_items = c(labels_econ, labels_pers)
m_item_cors = d_combined[c("CA_irt", v_polit_items)] %>%
cor_matrix(reliabilities = c(ctt_iq_alpha$total$raw_alpha, rep(.70, 20))) %>%
round(2)
m_item_cors[1, -1] %>% v_to_df() %>%
split_into_n_columns(2) %>%
write_clipboard()##
## 1 name value
## Not ensure jobs Not_ensure_jobs -0.21
## Higher min wage Higher_min_wage -0.27
## Not protectionism Not_protectionism 0.05
## Max salary Max_salary -0.09
## Decrease income tax Decrease_income_tax -0.07
## Increase property tax Increase_property_tax 0.05
## Keep regulations to min Keep_regulations_to_min 0.02
## Reduce income diffs Reduce_income_diffs -0.12
## Large companies staterun Large_companies_staterun -0.11
## Liberalize taxi law Liberalize_taxi_law 0
##
## 1 name value
## Not ensure jobs Abortion_right 0.11
## Higher min wage Punish_racist_speech 0.13
## Not protectionism Blasphemy_legal 0.27
## Max salary Legal_cannabis 0.07
## Decrease income tax Prohibit_LSD -0.01
## Increase property tax Illegal_sex_work -0.16
## Keep regulations to min Punish_flag_burning -0.1
## Reduce income diffs Legal_motercycle_no_helmet 0.08
## Large companies staterun Legal_car_no_seatbelt 0.06
## Liberalize taxi law Restrict_access_porn -0.08#approximate CI
span = function(x) max(x)-min(x)
psychometric::CIr(.0, 259) %>% span## [1] 0.24psychometric::CIr(.10, 259) %>% span## [1] 0.24psychometric::CIr(.20, 259) %>% span## [1] 0.23In general, the correlations are near zero as expected, but there are a few exceptions. Smarter people seem to be somewhat against the government unsuring jobs, higher minimum wages, and somewhat for blasphemy and flag burning being legal.
Parties
Lastly, we may wonder how the political parties are placed on the 2 dimensional spectrum given the responses in our dataset. This immediately brings up the question of how to estimate the parties. I can think of two methods:
- For each party, find the participants who agreed 80% or more with the party and calculate the mean scores for this group.
- For each party, build a predictive model and use it to predict what a hypothetical person who agreed 100% with that party would score.
The second approach comes in as many variants as one can build predictive models, but for simplicity we will stick with a linear model.
To make things interesting, we also calculate the political scores for the parties according to people’s self-ratings and plot the distances between the measured and self-rating based party scores. All this gives us the following two plots:
### ESTIMATE THE POSITIONS OF THE POLITICAL PARTIES USING SELF ESTIMATES AND MEASUREMENTS
v_parties = c("DF", "K", "S", "RV", "SF", "V", "LA", "Ø", "Å")
# using cutoff method ---------------------------------------
d_party_supporters = d_combined[v_parties] >= 80
#supporters by party in percent
adply(d_party_supporters, .margins = 2, mean)## X1 V1
## 1 DF 0.197
## 2 K 0.042
## 3 S 0.120
## 4 RV 0.039
## 5 SF 0.054
## 6 V 0.116
## 7 LA 0.081
## 8 Ø 0.116
## 9 Å 0.081#for each party, find supporters' views
d_self_rated_supporters = mdply(.data = expand.grid(party = v_parties, scale = c("self_rated_econ_freedom", "self_rated_pers_freedom"), stringsAsFactors = F), .fun = function(party, scale) {
v_values = d_combined[[scale]] %>% standardize()
mean(v_values[d_party_supporters[, party]], na.rm=T)
})
d_scores_supporters = mdply(.data = expand.grid(party = v_parties, scale = c("econ_freedom_fa_score", "pers_freedom_fa_score"), stringsAsFactors = F), .fun = function(party, scale) {
d_combined[d_party_supporters[, party], scale] %>% mean(na.rm=T)
})
#reshape data for plot
d_supporters = ldf_to_df(list(spread(d_self_rated_supporters, scale, V1) %>% set_colnames(c("party", "econ", "pers")),
spread(d_scores_supporters, scale, V1) %>% set_colnames(c("party", "econ", "pers"))))
#moves
d_supporters_moves = ddply(d_supporters, .variables = c("party"), .fun = function(block) {
c(x = block[1, 2], x2 = block[2, 2], y = block[1, 3], y2 = block[2, 3])
})
# using models -----------------------------------------------------
d_party_data_z = df_standardize(d_combined[c(v_parties, "econ_freedom_fa_score", "pers_freedom_fa_score", "self_rated_econ_freedom", "self_rated_pers_freedom")])
d_models_scored = mdply(expand.grid(party = v_parties, scale = c("econ_freedom_fa_score", "pers_freedom_fa_score"), stringsAsFactors = F), .fun = function(party, scale) {
model_str = scale + " ~ " + party
fit = lm(model_str, data = d_combined)
# fit = loess(model_str, data = d_combined, control=loess.control(surface="direct"))
newdata = data.frame(100) %>% set_colnames(party)
predict(fit, newdata = newdata) %>% set_names("value")
})
d_models_self = mdply(expand.grid(party = v_parties, scale = c("self_rated_econ_freedom", "self_rated_pers_freedom"), stringsAsFactors = F), .fun = function(party, scale) {
model_str = scale + " ~ " + party
# fit = loess(model_str, data = d_party_data_z, control=loess.control(surface="direct"))
fit = lm(model_str, data = d_party_data_z)
v_max_z = max(d_party_data_z[[scale]])
newdata = data.frame(v_max_z) %>% set_colnames(party)
predict(fit, newdata = newdata) %>% set_names("value")
})
#reshape data for plot
d_models = ldf_to_df(list(spread(d_models_self, scale, value) %>% set_colnames(c("party", "econ", "pers")),
spread(d_models_scored, scale, value) %>% set_colnames(c("party", "econ", "pers"))))
#moves
d_models_moves = ddply(d_models, .variables = c("party"), .fun = function(block) {
c(x = block[1, 2], x2 = block[2, 2], y = block[1, 3], y2 = block[2, 3])
})#plot
ggplot(d_supporters, aes(econ, pers)) +
geom_point(size = 4, aes(color = group)) +
geom_text(aes(label = party), color = "black", size = 7) +
scale_color_discrete(name = "Method", labels = c("Self-rated", "Scored")) +
xlab("Economic freedom") + ylab("Personal freedom") +
geom_segment(data = d_supporters_moves, aes(x = x, xend = x2, y = y, yend = y2), linetype = "dashed") +
theme_bw()
ggsave("figures/parties_supporters.png")## Saving 7 x 5 in imageggplot(d_models, aes(econ, pers)) +
geom_point(size = 4, aes(color = group)) +
geom_text(aes(label = party), color = "black", size = 7) +
scale_color_discrete(name = "Method", labels = c("Self-rated", "Scored")) +
xlab("Economic freedom") + ylab("Personal freedom") +
geom_segment(data = d_models_moves, aes(x = x, xend = x2, y = y, yend = y2), linetype = "dashed") +
theme_bw()
ggsave("figures/parties_model.png")## Saving 7 x 5 in image#similarity of results
d_supporters %>% subset(group == 2) %>% wtd.cors() %>% round(2)## Warning in wtd.cors(.): NAs introduced by coercion
## Warning in wtd.cors(.): NAs introduced by coercion## party econ pers group
## party NaN NaN NaN NaN
## econ NaN 1.00 0.56 Inf
## pers NaN 0.56 1.00 NaN
## group NaN Inf NaN NaNd_models %>% subset(group == 2) %>% wtd.cors() %>% round(2)## Warning in wtd.cors(.): NAs introduced by coercion
## Warning in wtd.cors(.): NAs introduced by coercion## party econ pers group
## party NaN NaN NaN NaN
## econ NaN 1.00 0.27 -Inf
## pers NaN 0.27 1.00 NaN
## group NaN -Inf NaN NaNThe two approaches gave similar, but not identical results. Some general patterns of note:
- As expected, the most libertarian-like party, LA, sits up the top right for measured political freedom, meaning that it is the most pro-freedom in both dimensions.
- The parties are aligned more or less as one would expect on the economic axis, no matter whether one uses self-ratings or measured scores or which method was used. Of special note is that the party, DF, which is sometimes called “far right”, but sits at the center of the economic axes across method and data variations.
- There are small differences between the parties in personal freedom when one looks at self-ratings.
- According to the model-based approach, all 5 of the “red block” parties (Ø, SF, Å, S, RV) grossly had supporters who severely overestimated how much in facor of personal freedom they really are.
- When looking at the measured scores estimated for the parties, there are strong to very strong correlations between the political axes. This means that one can meaningfully talk about a 1-dimensional political axis for parties, but not for the general public.
Representativity
Because the current sample relies on a subset of a previous sample asked for a second questionnaire, there may be selective retention which can bias results. To examine this, we calculate the mean values of relevant variables for the responders vs. the non-responders:
d_stereotype_study$responder = !(d_stereotype_study$Col2 %in% d_combined$URL.Variable..id)
d_responder_stats = ddply(d_stereotype_study, .variables = "responder", .fun = function(x) {
c(n = nrow(x),
age_mean = mean(x$Age, na.rm=T), age_sd = sd(x$Age, na.rm=T),
CA_mean = mean(x$CA, na.rm=T), CA_sd = sd(x$CA, na.rm=T),
edu_mean = mean(x$Edu_num, na.rm=T), edu_sd = sd(x$Edu_num, na.rm=T),
men_pct = proportion_true(x$Gender == "Male"), female_pct = proportion_true(x$Gender == "Female"))
}) %>% df_round(2)
d_responder_stats %>%
write_clipboard()## responder n age mean age sd CA mean CA sd edu mean edu sd men pct
## 1 FALSE 259.00 40.83 14.59 0.21 1.02 3.52 1.93 0.49
## 2 TRUE 293.00 37.42 14.59 -0.02 0.97 3.18 1.80 0.44
## female pct
## 1 0.51
## 2 0.56d_combined$Edu_n %>% table %>% prop.table() %>% magrittr::extract(6:8) %>% sum## [1] 0.16Thus, we see that the responders were somewhat different. However, these differences are unlikely to have affected the results because the variables with differences had no reliable predictive validity.
Supplementary materials
#Correlation matrix
d_combined$Gender_fct = d_combined$Gender %>% ordered()
hetcor(d_combined[c("CA_irt", "Edu_num", "Gender_fct", "Age", v_polit_items, "econ_freedom_fa_score", "pers_freedom_fa_score")]) %>%
magrittr::extract2("correlations") %>%
write_clipboard()## Warning in hetcor.data.frame(d_combined[c("CA_irt", "Edu_num",
## "Gender_fct", : the correlation matrix has been adjusted to make it
## positive-definite## CA irt Edu num Gender fct Age Not ensure jobs
## CA irt 1.00 0.21 0.27 0.09 -0.14
## Edu num 0.21 1.00 0.08 0.23 0.02
## Gender fct 0.27 0.08 1.00 0.15 0.04
## Age 0.09 0.23 0.15 1.00 0.10
## Not ensure jobs -0.14 0.02 0.04 0.10 1.00
## Higher min wage -0.19 -0.19 -0.15 0.04 -0.26
## Not protectionism 0.03 0.12 0.00 0.08 0.11
## Max salary -0.06 -0.04 -0.26 -0.01 -0.17
## Decrease income tax -0.05 0.08 0.18 0.14 0.19
## Increase property tax 0.03 -0.05 0.00 -0.01 -0.09
## Keep regulations to min 0.01 -0.05 0.04 0.06 0.31
## Reduce income diffs -0.08 -0.05 -0.15 0.15 -0.29
## Large companies staterun -0.07 0.01 -0.07 0.06 -0.15
## Liberalize taxi law 0.00 -0.04 0.04 -0.11 0.16
## Abortion right 0.08 0.02 0.03 0.03 0.10
## Punish racist speech 0.09 -0.04 0.05 0.04 -0.03
## Blasphemy legal 0.19 0.13 0.11 -0.09 -0.03
## Legal cannabis 0.05 -0.13 -0.04 -0.06 -0.09
## Prohibit LSD 0.00 0.16 -0.09 0.10 0.09
## Illegal sex work -0.11 -0.05 -0.34 0.03 -0.09
## Punish flag burning -0.07 -0.04 0.07 0.23 0.15
## Legal motercycle no helmet 0.05 0.02 0.13 -0.01 0.08
## Legal car no seatbelt 0.04 -0.08 0.06 -0.03 0.02
## Restrict access porn -0.05 -0.15 -0.32 0.20 0.03
## econ freedom fa score 0.07 0.08 0.19 -0.03 0.50
## pers freedom fa score 0.14 0.08 0.27 -0.15 0.00
## Higher min wage Not protectionism Max salary
## CA irt -0.19 0.03 -0.06
## Edu num -0.19 0.12 -0.04
## Gender fct -0.15 0.00 -0.26
## Age 0.04 0.08 -0.01
## Not ensure jobs -0.26 0.11 -0.17
## Higher min wage 1.00 -0.27 0.17
## Not protectionism -0.27 1.00 -0.14
## Max salary 0.17 -0.14 1.00
## Decrease income tax -0.10 -0.02 -0.19
## Increase property tax 0.10 0.00 0.12
## Keep regulations to min -0.21 0.19 -0.25
## Reduce income diffs 0.50 -0.10 0.31
## Large companies staterun 0.23 -0.11 0.39
## Liberalize taxi law -0.20 0.14 -0.08
## Abortion right -0.02 0.09 -0.10
## Punish racist speech 0.10 -0.12 -0.09
## Blasphemy legal -0.10 0.15 -0.02
## Legal cannabis 0.08 0.02 0.05
## Prohibit LSD -0.01 -0.11 -0.08
## Illegal sex work 0.04 -0.02 0.14
## Punish flag burning 0.05 -0.11 0.03
## Legal motercycle no helmet -0.01 -0.02 0.13
## Legal car no seatbelt 0.04 0.04 0.11
## Restrict access porn 0.19 -0.09 0.24
## econ freedom fa score -0.63 0.29 -0.54
## pers freedom fa score -0.11 0.14 -0.08
## Decrease income tax Increase property tax
## CA irt -0.05 0.03
## Edu num 0.08 -0.05
## Gender fct 0.18 0.00
## Age 0.14 -0.01
## Not ensure jobs 0.19 -0.09
## Higher min wage -0.10 0.10
## Not protectionism -0.02 0.00
## Max salary -0.19 0.12
## Decrease income tax 1.00 -0.23
## Increase property tax -0.23 1.00
## Keep regulations to min 0.28 -0.13
## Reduce income diffs -0.23 0.27
## Large companies staterun -0.23 0.23
## Liberalize taxi law 0.19 0.02
## Abortion right -0.08 0.08
## Punish racist speech -0.01 0.03
## Blasphemy legal -0.14 0.08
## Legal cannabis -0.06 0.08
## Prohibit LSD 0.02 -0.05
## Illegal sex work -0.07 0.00
## Punish flag burning 0.19 -0.21
## Legal motercycle no helmet 0.09 0.03
## Legal car no seatbelt -0.03 0.05
## Restrict access porn -0.08 0.00
## econ freedom fa score 0.44 -0.36
## pers freedom fa score -0.03 0.08
## Keep regulations to min Reduce income diffs
## CA irt 0.01 -0.08
## Edu num -0.05 -0.05
## Gender fct 0.04 -0.15
## Age 0.06 0.15
## Not ensure jobs 0.31 -0.29
## Higher min wage -0.21 0.50
## Not protectionism 0.19 -0.10
## Max salary -0.25 0.31
## Decrease income tax 0.28 -0.23
## Increase property tax -0.13 0.27
## Keep regulations to min 1.00 -0.29
## Reduce income diffs -0.29 1.00
## Large companies staterun -0.34 0.36
## Liberalize taxi law 0.25 -0.11
## Abortion right -0.01 -0.06
## Punish racist speech 0.08 0.10
## Blasphemy legal -0.09 -0.01
## Legal cannabis -0.04 0.16
## Prohibit LSD -0.02 -0.06
## Illegal sex work -0.05 0.11
## Punish flag burning 0.19 -0.06
## Legal motercycle no helmet -0.01 0.00
## Legal car no seatbelt 0.01 0.00
## Restrict access porn 0.00 0.14
## econ freedom fa score 0.61 -0.78
## pers freedom fa score -0.05 -0.07
## Large companies staterun Liberalize taxi law
## CA irt -0.07 0.00
## Edu num 0.01 -0.04
## Gender fct -0.07 0.04
## Age 0.06 -0.11
## Not ensure jobs -0.15 0.16
## Higher min wage 0.23 -0.20
## Not protectionism -0.11 0.14
## Max salary 0.39 -0.08
## Decrease income tax -0.23 0.19
## Increase property tax 0.23 0.02
## Keep regulations to min -0.34 0.25
## Reduce income diffs 0.36 -0.11
## Large companies staterun 1.00 -0.09
## Liberalize taxi law -0.09 1.00
## Abortion right -0.06 -0.03
## Punish racist speech 0.02 0.01
## Blasphemy legal 0.08 -0.02
## Legal cannabis 0.02 0.26
## Prohibit LSD -0.04 -0.08
## Illegal sex work 0.10 -0.12
## Punish flag burning -0.12 -0.07
## Legal motercycle no helmet 0.04 0.07
## Legal car no seatbelt 0.06 0.09
## Restrict access porn 0.10 -0.05
## econ freedom fa score -0.63 0.31
## pers freedom fa score -0.01 0.13
## Abortion right Punish racist speech
## CA irt 0.08 0.09
## Edu num 0.02 -0.04
## Gender fct 0.03 0.05
## Age 0.03 0.04
## Not ensure jobs 0.10 -0.03
## Higher min wage -0.02 0.10
## Not protectionism 0.09 -0.12
## Max salary -0.10 -0.09
## Decrease income tax -0.08 -0.01
## Increase property tax 0.08 0.03
## Keep regulations to min -0.01 0.08
## Reduce income diffs -0.06 0.10
## Large companies staterun -0.06 0.02
## Liberalize taxi law -0.03 0.01
## Abortion right 1.00 0.03
## Punish racist speech 0.03 1.00
## Blasphemy legal 0.10 -0.32
## Legal cannabis 0.17 0.00
## Prohibit LSD -0.02 0.04
## Illegal sex work -0.22 0.15
## Punish flag burning -0.10 0.00
## Legal motercycle no helmet 0.00 -0.10
## Legal car no seatbelt -0.11 -0.10
## Restrict access porn -0.28 0.14
## econ freedom fa score 0.06 -0.05
## pers freedom fa score 0.35 -0.37
## Blasphemy legal Legal cannabis Prohibit LSD
## CA irt 0.19 0.05 0.00
## Edu num 0.13 -0.13 0.16
## Gender fct 0.11 -0.04 -0.09
## Age -0.09 -0.06 0.10
## Not ensure jobs -0.03 -0.09 0.09
## Higher min wage -0.10 0.08 -0.01
## Not protectionism 0.15 0.02 -0.11
## Max salary -0.02 0.05 -0.08
## Decrease income tax -0.14 -0.06 0.02
## Increase property tax 0.08 0.08 -0.05
## Keep regulations to min -0.09 -0.04 -0.02
## Reduce income diffs -0.01 0.16 -0.06
## Large companies staterun 0.08 0.02 -0.04
## Liberalize taxi law -0.02 0.26 -0.08
## Abortion right 0.10 0.17 -0.02
## Punish racist speech -0.32 0.00 0.04
## Blasphemy legal 1.00 0.18 -0.09
## Legal cannabis 0.18 1.00 -0.22
## Prohibit LSD -0.09 -0.22 1.00
## Illegal sex work -0.23 -0.22 0.09
## Punish flag burning -0.26 -0.17 0.11
## Legal motercycle no helmet 0.19 0.10 -0.10
## Legal car no seatbelt 0.13 0.17 -0.14
## Restrict access porn -0.31 -0.10 -0.02
## econ freedom fa score -0.03 -0.10 0.05
## pers freedom fa score 0.68 0.43 -0.22
## Illegal sex work Punish flag burning
## CA irt -0.11 -0.07
## Edu num -0.05 -0.04
## Gender fct -0.34 0.07
## Age 0.03 0.23
## Not ensure jobs -0.09 0.15
## Higher min wage 0.04 0.05
## Not protectionism -0.02 -0.11
## Max salary 0.14 0.03
## Decrease income tax -0.07 0.19
## Increase property tax 0.00 -0.21
## Keep regulations to min -0.05 0.19
## Reduce income diffs 0.11 -0.06
## Large companies staterun 0.10 -0.12
## Liberalize taxi law -0.12 -0.07
## Abortion right -0.22 -0.10
## Punish racist speech 0.15 0.00
## Blasphemy legal -0.23 -0.26
## Legal cannabis -0.22 -0.17
## Prohibit LSD 0.09 0.11
## Illegal sex work 1.00 0.01
## Punish flag burning 0.01 1.00
## Legal motercycle no helmet -0.17 -0.04
## Legal car no seatbelt -0.10 0.02
## Restrict access porn 0.46 0.16
## econ freedom fa score -0.14 0.13
## pers freedom fa score -0.70 -0.30
## Legal motercycle no helmet
## CA irt 0.05
## Edu num 0.02
## Gender fct 0.13
## Age -0.01
## Not ensure jobs 0.08
## Higher min wage -0.01
## Not protectionism -0.02
## Max salary 0.13
## Decrease income tax 0.09
## Increase property tax 0.03
## Keep regulations to min -0.01
## Reduce income diffs 0.00
## Large companies staterun 0.04
## Liberalize taxi law 0.07
## Abortion right 0.00
## Punish racist speech -0.10
## Blasphemy legal 0.19
## Legal cannabis 0.10
## Prohibit LSD -0.10
## Illegal sex work -0.17
## Punish flag burning -0.04
## Legal motercycle no helmet 1.00
## Legal car no seatbelt 0.56
## Restrict access porn -0.07
## econ freedom fa score -0.01
## pers freedom fa score 0.42
## Legal car no seatbelt Restrict access porn
## CA irt 0.04 -0.05
## Edu num -0.08 -0.15
## Gender fct 0.06 -0.32
## Age -0.03 0.20
## Not ensure jobs 0.02 0.03
## Higher min wage 0.04 0.19
## Not protectionism 0.04 -0.09
## Max salary 0.11 0.24
## Decrease income tax -0.03 -0.08
## Increase property tax 0.05 0.00
## Keep regulations to min 0.01 0.00
## Reduce income diffs 0.00 0.14
## Large companies staterun 0.06 0.10
## Liberalize taxi law 0.09 -0.05
## Abortion right -0.11 -0.28
## Punish racist speech -0.10 0.14
## Blasphemy legal 0.13 -0.31
## Legal cannabis 0.17 -0.10
## Prohibit LSD -0.14 -0.02
## Illegal sex work -0.10 0.46
## Punish flag burning 0.02 0.16
## Legal motercycle no helmet 0.56 -0.07
## Legal car no seatbelt 1.00 0.02
## Restrict access porn 0.02 1.00
## econ freedom fa score -0.03 -0.17
## pers freedom fa score 0.33 -0.67
## econ freedom fa score pers freedom fa score
## CA irt 0.07 0.14
## Edu num 0.08 0.08
## Gender fct 0.19 0.27
## Age -0.03 -0.15
## Not ensure jobs 0.50 0.00
## Higher min wage -0.63 -0.11
## Not protectionism 0.29 0.14
## Max salary -0.54 -0.08
## Decrease income tax 0.44 -0.03
## Increase property tax -0.36 0.08
## Keep regulations to min 0.61 -0.05
## Reduce income diffs -0.78 -0.07
## Large companies staterun -0.63 -0.01
## Liberalize taxi law 0.31 0.13
## Abortion right 0.06 0.35
## Punish racist speech -0.05 -0.37
## Blasphemy legal -0.03 0.68
## Legal cannabis -0.10 0.43
## Prohibit LSD 0.05 -0.22
## Illegal sex work -0.14 -0.70
## Punish flag burning 0.13 -0.30
## Legal motercycle no helmet -0.01 0.42
## Legal car no seatbelt -0.03 0.33
## Restrict access porn -0.17 -0.67
## econ freedom fa score 1.00 0.07
## pers freedom fa score 0.07 1.00#sex diff
GG_denhist(d_combined, "CA_irt", group = "Gender")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
SMD_matrix(d_combined$CA_irt, group = d_combined$Gender)## Female Male
## Female NA -0.44
## Male -0.44 NA#difference of correlations
cors = d_combined[c("CA_irt", "econ_freedom_fa_score", "pers_freedom_fa_score")] %>%
cor %>%
#correct for measurement error
psych::correct.cor(y = c(ctt_iq_alpha$total$raw_alpha, ctt_econ_alpha$total$raw_alpha, ctt_pers_alpha$total$raw_alpha))
psychometric::CIrdif(cors[2, 1], cors[3, 1], n1 = nrow(d_combined), n2 = nrow(d_combined))## DifR SED LCL UCL
## 1 -0.072 0.087 -0.24 0.099psychometric::CIrdif(cors[1, 2], cors[1, 3], n1 = nrow(d_combined), n2 = nrow(d_combined))## DifR SED LCL UCL
## 1 -0.12 0.086 -0.29 0.046