Load Packages
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.1
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
Read data and verify values
Nest pilotdata_all.csv into “d” for easier implementation into functions. lapply() applies a function(x) to each column which checks whether each column has a character which is numerical in value, if not, then the value returns to x. This was done to confirm that data input was corre
d <- read.csv("C:/Users/Leon/Downloads/pilot/pilotdata_all.csv")
d[] <- lapply(d, function(x) {
if(is.factor(x)) as.numeric(as.character(x)) else x
}
)
Confirm controversial ratings are above 4
In this section of the pilotstudy data, the author wanted to confirm that controversial ratings for all 22 topics were above a score of 4 for everyone, Democrats, Republicans, and Independents. Comments below will describe what the author proceeded to do. A thing that was unique in this section is how they didn’t use the pipe function to filter the columns and then use group_by then summarise() functions to obtain these values which would have increased the coding lines needed.
#In this part the researcher filtered for Democrats (Ds) = 1, Republicans (Rs) = 2, and Independents (Is) = 3 by stating "(d$PA == x)" where x = 1,2,3.
#The first line can be read as "Let Ds be equal to when PA (Political Affinity) is equal to 1"
Ds = d[which(d$PA == 1),]
Rs = d[which(d$PA == 2),]
Is = d[which(d$PA == 3),]
#This section is apparently used to initalise the vectors to empty vectors according to ChatGPT. From further research, this is used to ensure that the vector is in a ready state to store elements
overallmeans = c()
Dmeans = c()
Rmeans = c()
Imeans = c()
#The author finds the mean for the different political affinities and overall mean for columns 9 to 30 (i.e., the controversial ratings) as specified by "for (x in 9:30)".
#The author starts by describing a Mean function "colMeans(d[x], na.rm = TRUE)" which finds the mean of column means for columns 9 to 30 for all political affinities and where any NA values are removed from "na.rm = TRUE". The value of "d" is swapped with Ds, Rs, Is for the means of the other political affinities.
#This Mean function is then followed by the creation of a single column dataframe e.g., "name = c(name, 'Mean function')". The Mean function and dataframe creation are then adjusted for each political affinity
for (x in 9:30) {
Mean = colMeans(d[x],na.rm = TRUE)
overallmeans = c(overallmeans,Mean)
Mean = colMeans(Ds[x],na.rm = TRUE)
Dmeans = c(Dmeans,Mean)
Mean = colMeans(Rs[x],na.rm = TRUE)
Rmeans = c(Rmeans,Mean)
Mean = colMeans(Is[x],na.rm = TRUE)
Imeans = c(Imeans,Mean)
}
As all the values of controversial ratings are above 4 except for Q6_12 and Q6_4, this indicates that construct validity is sufficient for 20 of those topics.
Measure percentage of correct rankings of conservative to liberal attitudes on the controversial topics
Taking “healthcare” code as an example. The first line nests a function into x using the ifelse() function. This function checks the conditions of the columns Q22_y where y = 1,2,3,4 and whether they are equal to the correct values of 1-5 from most conservative (1) to most liberal (5). If all are correct it assigns a 1 value but if not 0. Then the mean percentage of correct answers is calculated with NA values being removed from the equation.
#healthcare
x <- ifelse((d[,'Q22_1']==5)&(d[,'Q22_2']==4)&(d[,'Q22_3']==3)&(d[,'Q22_4']==2),1,0)
healthcare_percent=mean(x,na.rm = TRUE)
#immigration
x <- ifelse((d[,'Q15_1']==1)&(d[,'Q15_2']==2)&(d[,'Q15_3']==3)&(d[,'Q15_4']==4),1,0)
imm_percent=mean(x,na.rm = TRUE)
#abortion
x <- ifelse((d[,'Q16_1']==5)&(d[,'Q16_2']==4)&(d[,'Q16_3']==3)&(d[,'Q16_4']==2),1,0)
abortion_percent=mean(x,na.rm = TRUE)
#vote
x <- ifelse((d[,'Q18_1']==4)&(d[,'Q18_2']==3)&(d[,'Q18_3']==2)&(d[,'Q18_4']==1),1,0)
vote_percent=mean(x,na.rm = TRUE)
#tax
x <- ifelse((d[,'Q19_1']==5)&(d[,'Q19_2']==4)&(d[,'Q19_3']==3)&(d[,'Q19_4']==2),1,0)
tax_percent=mean(x,na.rm = TRUE)
#torture
x <- ifelse((d[,'Q20_1']==4)&(d[,'Q20_2']==3)&(d[,'Q20_3']==2)&(d[,'Q20_4']==1),1,0)
torture_percent=mean(x,na.rm = TRUE)
#affirmative action
x <- ifelse((d[,'Q21_1']==1)&(d[,'Q21_2']==2)&(d[,'Q21_3']==3)&(d[,'Q21_4']==4),1,0)
affirm_percent=mean(x,na.rm = TRUE)
#religious beliefs
x <- ifelse((d[,'Q22_1']==1)&(d[,'Q22_2']==2)&(d[,'Q22_3']==3)&(d[,'Q22_4']==4),1,0)
relig_percent=mean(x,na.rm = TRUE)
#gay couple adoption
x <- ifelse((d[,'Q23_1']==1)&(d[,'Q23_2']==2)&(d[,'Q23_3']==3)&(d[,'Q23_4']==4),1,0)
adopt_percent=mean(x,na.rm = TRUE)
#planned parenthood
x <- ifelse((d[,'Q24_1']==1)&(d[,'Q24_2']==2)&(d[,'Q24_3']==3)&(d[,'Q24_4']==4),1,0)
PP_percent=mean(x,na.rm = TRUE)
#death penalty
x <- ifelse((d[,'Q26_1']==1)&(d[,'Q26_2']==2)&(d[,'Q26_3']==3)&(d[,'Q26_4']==4),1,0)
DP_percent=mean(x,na.rm = TRUE)
#confederate flag
x <- ifelse((d[,'Q27_1']==1)&(d[,'Q27_2']==2)&(d[,'Q27_3']==3)&(d[,'Q27_4']==4),1,0)
flag_percent=mean(x,na.rm = TRUE)
#euthanasia
x <- ifelse((d[,'Q29_1']==1)&(d[,'Q29_2']==2)&(d[,'Q29_3']==3)&(d[,'Q29_4']==4),1,0)
euth_percent=mean(x,na.rm = TRUE)
#university safe space and trigger warnings
x <- ifelse((d[,'Q30_1']==1)&(d[,'Q30_2']==2)&(d[,'Q30_3']==3)&(d[,'Q30_4']==4),1,0)
uni_percent=mean(x,na.rm = TRUE)
#tuition
x <- ifelse((d[,'Q31_1']==1)&(d[,'Q31_2']==2)&(d[,'Q31_3']==3)&(d[,'Q31_4']==4),1,0)
tuit_percent=mean(x,na.rm = TRUE)
#military spending
x <- ifelse((d[,'Q32_1']==1)&(d[,'Q32_2']==2)&(d[,'Q32_3']==3)&(d[,'Q32_4']==4),1,0)
military_percent=mean(x,na.rm = TRUE)
#environmental regulations
x <- ifelse((d[,'Q33_1']==1)&(d[,'Q33_2']==2)&(d[,'Q33_3']==3)&(d[,'Q33_4']==4),1,0)
enviro_percent=mean(x,na.rm = TRUE)
#gun regulation
x <- ifelse((d[,'Q34_1']==1)&(d[,'Q34_2']==2)&(d[,'Q34_3']==3)&(d[,'Q34_4']==4),1,0)
gun_percent=mean(x,na.rm = TRUE)
#covid19 serious
x <- ifelse((d[,'Q41_1']==1)&(d[,'Q41_2']==2)&(d[,'Q41_3']==3)&(d[,'Q41_4']==4),1,0)
covid_percent=mean(x,na.rm = TRUE)
#covid19 government handling
x <- ifelse((d[,'Q42_1']==1)&(d[,'Q42_2']==2)&(d[,'Q42_3']==3)&(d[,'Q42_4']==4),1,0)
covidgov_percent=mean(x,na.rm = TRUE)
The author of the main study is specifically looking for values above
0.5 to, I believe, use as a measure of construct validity. Manually
counting the controversial topics that were above 0.5 there are 8:
-immigration
-abortion
-voting
-tax
-torture
-affirmative action
-military spending
-government handling of COVID-19
Solvable Problems
The problem is that the scales go from 1 to 5 but the specified conditions only range from 1-4 i.e., Q22_x where x = 1,2,3,4 but not 5 which is the number of items on the scale. This is because inputting the value for Q22_5 would be redundant. For example, you have a lock with 5 numbers and you have clues to solve all 5 numbers, however, you only need to solve clues for 4 numbers as you can just fill in the last number as there is only 10 numbers to try. Therefore, there is no need to write code specifying the value of the remaining scale item which seems like a very smart method of reducing code written
Problems
For healthcare, abortion, vote, tax, and torture scales, the value given to the scale items are in descending order compared to the rest which are all in ascending order which implies the options in the scale items are also in descending or ascending order of most conservative to most liberal which is confusing as we expect the options to be random at least to prevent random guessing. And sometimes the most “conservative” and most “liberal” responses don’t seem to match the values given above. The only solution is most likely a discrepancy between what was presented on the survey and what was coded to which we don’t know.