--- title: '' output: bookdown::pdf_document2: default --- # Methods \vspace{0.5cm} ## Research method and data collection      Given that it is technically and ethically challenging to obtain people’s sharing behavioral data on social media, I designed an online survey experiment to simulate the virtual environment in which participants were given fabricated social media postings to read and were asked to report their behavioral responses afterwards. The survey was web‐based and developed using the Qualtrics survey software provided by the University of Chicago, Illinois, USA. Survey participates were recruited using Amazon Mechanical Turk crowdsourcing platform (MTurk). The survey was fielded by the researcher in April, 2020^[The project had obtained full ethics approval for data collection from the Institutional Review Boards at the University of Chicago before it was fielded.]. ### Amazon Mechanical Turk (MTurk)      Amazon’s MTurk is one of the most popular survey methods for participant recruitment and data collection in experimental research due to the following advantages:      1.Conducting research using MTurk is relatively affordable compared to traditional experimental approaches, especially laboratory experiments [@berinsky2012evaluating;@horton2011online;@stritch2017opportunities].      2.The quality of data obtained from MTurk subject pools has been confirmed to be robust. Multiple empirical studies show that research results drawing on MTurk data are consistent with laboratory-based research results [@buhrmester2016amazon;@paolacci2010running].      3.Compared to traditional experimental approaches, MTurk does not require face to face interaction. Without physical contact, the virtual experimental environment ensures that the presence of researchers does not contaminate research results. This method of recruitment is particularly useful when the research itself can be conducted online or under some circumstances (such as the COVID–19 pandemic), or has to be conducted online to avoid physical interaction [@cunningham2017using].      4.MTurk subjects are more demographically diverse than internet samples and college student samples. As @berinsky2012evaluating put it, “MTurk subjects are often more representative of the general population and substantially less expensive to recruit. (p. 366).” In addition, @hauser2016attentive's study shows that MTurk participants have a significantly higher rate of passing attention checks in surveys than online subject pool participants. All told, MTurk is a feasible means to obtain reliable and valid survey data in experimental research. ### Sample size      To optimally estimate the proportion of likely American adults who would share political disinformation on social media, I set the sample size level at 500, which constructs a 95% confidence interval with a margin of error of ± 4.4%.      After the appropriate sample size was determined, I posted an advertisement on MTurk to recruit 500 participants for my experimental study. Intended participants were restricted to those who met the following eligibility criteria: American residents; 18 or older. Due to my financial constraints, respondents were each paid 0.2 U.S. dollars each for their completed work.      The survey was distributed on Qualtrics. All of the 500 respondents (n = 500) have completed the survey and passed the attention checks, with one respondent withdrawing from the survey pool after completion. Therefore, the ultimate total sample size is 499, which still renders a representative sample with an approximate Margin of Error ±4.4%. ### Sample weighting adjustment      Ideally, a selected survey sample is a miniature of the population from which it draws. However, due to factors such as time and budget constraints and selection biases, mismatch between the characteristics of the survey respondents and those of the target population may occur. In order to mitigate the effects of response biases and sampling imbalances, I employed the raking weighting method to adjust my survey sample.      Also known as random iterative method (RIM) weighting or iterative proportional fitting, raking is a statistical technique widely used to address post-stratification problems for public opinion surveys [@kalton1983compensating]. With raking, researchers manage to select a set of variables, usually demographic or socioeconomic variables as a source for the control totals. In this study, raked weights based on the 2019 United States Census data were estimated for the sample with respect to age group and party identification. Specifically, the adjustment to control totals was achieved by creating a cross-classification of the categorical control variables (age group × party identification categories) and then matching the total of the weights in each cell to the control total. ```{r packages,echo = FALSE, message = FALSE,results = "hide"} library(weights) library(ggplot2) library(tidyr) library(scales) library(sjPlot) library(sjmisc) library(psych) library(likert) library(MASS) library(reshape2) library(reshape) library(ggpubr) library(tidyverse) library(tigerstats) library(carData) library(effects) library(car) library(MASS) library(splines) library(kableExtra) library(stargazer) library(apaTables) library(gtsummary) library(papaja) ``` ```{r Data,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #Read in misinformation sharing dataset # Please use here package to read in the dataset Misinformation<- read.csv("Misinformation sharing.csv",header =T,stringsAsFactors=T) Misinformation <- Misinformation %>% as_tibble() ``` ```{r remane key variables,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # rename key variables Misinformation <- Misinformation %>% dplyr::rename(partyid = Q88, age = Q93, sex = Q94, race = Q95) #change the variable labels from "Democrat", "Independent", "Republican" to the #following levels(Misinformation$partyid) <- c("Dem", "Ind", "Rep") # rowPerc(xtabs(~ Q88,data = survey_recoded)) # perc_Dem perc_Ind perc_Rep # 46.89379 25.25050 27.85571 ``` ```{r Education recode,echo = FALSE, message = FALSE,eval=FALSE} #Education column rename Misinformation <- Misinformation %>% dplyr::rename(educ = Q96) #recode levels # Misinformation$educ <- factor(Misinformation$educ, levels = c("Less than high school", "High school graduate", "2 year degree","Some college","4 year degree", "Professional degree","Doctorate")) #combine as "graduate degree" library(forcats) Misinformation$educ <- Misinformation$educ %>% fct_collapse("Graduate degree" = c("Professional degree","Doctorate")) # reorder levels Misinformation$educ <- factor(Misinformation$educ, levels = c("Less than high school", "High school graduate", "2 year degree","Some college","4 year degree", "Graduate degree")) ``` ```{r Education recoded,echo = FALSE, message = FALSE,eval=FALSE} # ftable(Misinformation$sex) # Female Male Other # # 258 240 1 # In my study, I include 3 options for gender identification, which are female, # male, other. However, given that there is only 1 person who identifies as # "Other," I decided to exclude this case and make comparisons between women and # men (which is to test one of my hypotheses.) Misinformation <- Misinformation %>% filter(sex != "Other") # drop the "Other" level since it's not used anymore Misinformation$sex <- droplevels(Misinformation$sex) ``` ```{r echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #save file save(Misinformation,file="Misinformation.Rda") ``` ```{r Political Knowledge score, echo = FALSE, message = FALSE,results = "hide",eval=FALSE} ##convert the political knowledge related survey items into a continuous #variable The purpose of such a conversion is to turn the political knowledge #related variables into scored items: The correct answer was coded as "1" while #the others as "0" survey_recoded <- Misinformation %>% mutate(polikn1 = recode_factor (Q77, "Mike Pompeo" = 1, "John Kerry" = 0, "Mitt Romney" = 0, "Rex Tillerson" = 0)) %>% mutate (polikn2 = recode_factor(Q79, "Emmanuel Macron" = 1, "Boris Johnson" = 0, "Justin Trudeau" = 0, "Malcolm Turnbull" = 0)) %>% mutate (polikn3 = recode_factor(Q80, "a Supreme Court justice" = 1, "the head of the EPA" = 0, "a Senator" = 0, "the Solicitor General" = 0)) %>% mutate (polikn4 = recode_factor(Q81, "Robert Mueller" = 1, "James Comey" = 0, "Sally Yates" = 0, "Sean Spicer" = 0)) %>% mutate (polikn5 = recode_factor(Q82, "Lead" = 1, "Arsenic" = 0, "Asbestos" = 0, "Mold" = 0)) %>% mutate (polikn6 = recode_factor (Q83, "The Freedom Caucus" = 1, "The Blue Dogs" = 0, "The Lincoln Group" = 0, "The Tuesday Group" = 0)) %>% mutate (polikn7 = recode_factor(Q84, "The United Kingdom" = 1, "Germany" = 0, "Greece" = 0, "Hungary" = 0)) %>% mutate (polikn8 = recode_factor(Q85, "Mosquitoes" = 1, "Contaminated water" = 0, "Rodents" = 0, "Spoiled food" = 0)) %>% mutate (polikn9 = recode_factor (Q86, "Paul Ryan" = 1, "Jason Chaffetz" = 0, "Mitch McConnell" = 0, "Nancy Pelosi" = 0)) %>% mutate (polikn10 = recode_factor(Q87, "2.70%" = 1, "1.40%" = 0, "14%" = 0, "27%" = 0)) # Further convert the scored items into numeric variables and added them up. # Therefore, "poli_knowledge" is the political knowledge score each respondent # received. survey_recoded['poli_knowledge'] <- as.numeric(as.character(survey_recoded$polikn1)) + as.numeric(as.character(survey_recoded$polikn2)) + as.numeric(as.character(survey_recoded$polikn3)) + as.numeric(as.character(survey_recoded$polikn4)) + as.numeric(as.character(survey_recoded$polikn5)) + as.numeric(as.character(survey_recoded$polikn6)) + as.numeric(as.character(survey_recoded$polikn7)) + as.numeric(as.character(survey_recoded$polikn8)) + as.numeric(as.character(survey_recoded$polikn10)) survey_recoded$poli <- (survey_recoded$poli_knowledge - min(survey_recoded$poli_knowledge)) / (max(survey_recoded$poli_knowledge) - min(survey_recoded$poli_knowledge)) round(survey_recoded$poli, digits = 3) ``` ```{r Social media engagement score,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #Likewise, respondents' social media engament was also recoded and assigned a #score order: Several times a day, about once a day, a few times a week, every #few weeks or less often survey_recoded$Q92_1 <- factor(survey_recoded$Q92_1, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_2 <- factor(survey_recoded$Q92_2, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_3 <- factor(survey_recoded$Q92_3, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_4 <- factor(survey_recoded$Q92_4, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_5 <- factor(survey_recoded$Q92_5, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_6 <- factor(survey_recoded$Q92_6, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_7 <- factor(survey_recoded$Q92_7, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_8 <- factor(survey_recoded$Q92_8, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) survey_recoded$Q92_9 <- factor(survey_recoded$Q92_9, levels = c("Less often", "Every few weeks", "A few times a week", "About once a day", "Several times a day")) # merge all the items to crate a score for social media angagement,the higher # the score, the individual is more engaged in social media survey_recoded['social_media'] <- as.numeric(survey_recoded$Q92_1) + as.numeric(survey_recoded$Q92_2) + as.numeric(survey_recoded$Q92_3) + as.numeric(survey_recoded$Q92_4) + as.numeric(survey_recoded$Q92_5) + as.numeric(survey_recoded$Q92_6) + as.numeric(survey_recoded$Q92_7) + as.numeric(survey_recoded$Q92_8) + as.numeric(survey_recoded$Q92_9) survey_recoded$social <- (survey_recoded$social_media - min(survey_recoded$social_media)) / (max(survey_recoded$social_media) - min(survey_recoded$social_media)) round(survey_recoded$social, digits = 3) ``` ```{r rename variables,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # Education, which is 0 for did not graduate HS, 1 for HS grad, 2 for some # college, 3 for two year degree, 4 for college grad, and 5 for professional # degree or doctorate.) survey_recoded$edu <- as.numeric(as.ordered(survey_recoded$educ)) - 1 # recode to interval 0-1 as suggested by Prof. Hansen survey_recoded$edu <- (survey_recoded$edu - min(survey_recoded$edu )) / (max(survey_recoded$edu ) - min(survey_recoded$edu )) round(survey_recoded$edu, digits = 3) ```      In this study, I weighted the survey sample based on two variables, namely "age group" and "political identification." As mentioned earlier, researchers usually apply weights on demographic characteristics; however, studies conducted by Pew Research Center suggest that weighting based on other variables, such as political affiliation, can reduce sampling bias in some cases [@mercer2018for]. Given that political identification is a crucial variable of interest in my study, I include party identification as a key variable for the raking process. ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # sex: 1 male, 2 female # wpct(survey_recoded$sex) # Female Male Other # 0.517034068 0.480961924 0.002004008 # the data suggests that sex ratio is actually very close to the actual ratio, # so I won't change it ## US census gender ratio ## link[https://www.census.gov/quickfacts/fact/table/US/SEX255219] Female: 50.8% ``` ```{r Age Group, echo = FALSE, message = FALSE,results = "hide",eval=FALSE} agelabels <- c("18 to 24", "25 to 64", "Ages 65 and over") survey_recoded <- survey_recoded %>% filter(age>=18) %>% mutate(agegroup = cut(age, breaks = c(18,25,65,Inf), right = F,labels = agelabels)) # percs(survey_recoded$agegroup) # perc_18 to 24 perc_25 to 64 perc_Ages 65 and over # 13.453815 83.333333 3.212851 ``` ```{r table1, tab.cap= "Adult population by age group in the United States - 2019",echo = FALSE, message = FALSE,results='asis'} library(knitr) library(kableExtra) library(tidyverse) tab_age = data.frame( age_group = c("18 to 24", "25 to 64", "Ages 65 and over"), census_age = c("12%", "67%", "21%"), survey_age = c("13%", "83%", "3%")) tab_age %>% kable(format="latex", caption = "U.S. Adult Population by Age",escape=T,booktabs=TRUE,col.names = c("Age group", "U.S. census data 2019", "Survey results")) %>% kable_styling(latex_options="scale_down","striped",font_size = 9,full_width = F) %>% row_spec(0,bold=TRUE) ```      Although "sex" or "gender" is a popular choice in sampling weighting, the sex ratio of the respondents for this study accurately reflects the sex ratio of the United States. According to the demographic, economic and population data from the U.S. Census Bureau (2019) [@united2019population], 50.8% of the U.S. population identified as Female. In my sample, female respondents comprised 51.7% of respondents. Given that that the sex ratios are rather similar, weighting the survey data based on the sex variable is not necessary.      In terms of age distribution, Table \@ref(tab:table1) shows the results obtained from the U.S. Census Bureau^[Please direct to the following link to access the data https://www.census.gov/quickfacts/fact/table/US/PST045219] compared to those of the survey data. As the table shows, the age ratios of the sample survey results are generally skewed towards the younger age groups as merely three per cent of the survey respondents aged 65 and over, suggesting that the younger population was over sampled.      In addition to "age groups," party affiliation or identification of the respondents appeared to be another variable that is disproportionate to the U.S. population. As Table \@ref(tab:table2) shows, the sample is biased towards Democrats and Independents. The estimates of the U.S. population by party identification were obtained from the Pew Research Center^[Please direct to the following link to access the data https://www.pewresearch.org/politics/2018/03/20/1-trends-in-party-affiliation-among-demographic-groups/]. Therefore, in order to reduce inaccuracy and non response errors, I adjusted the survey data based on the variables "age group" and "party identification" so that the marginal totals match control totals. With raking, the ratios of age and party identification for the weighted survey sample have been adjusted to match the desired population distribution. ```{r table2,echo = FALSE, message = FALSE,results='asis'} ## Raking survey data # perc_Dem perc_Ind perc_Rep # 46.98795 25.10040 27.91165 library(knitr) library(kableExtra) library(tidyverse) tab_party = data.frame( partyid = c("Democrat", "Independent", "Republican"), census_party = c("33%", "41%", "26%"), survey_party = c("47%", "25%", "28%") ) tab_party %>% kable(format="latex", caption = "U.S. Adult Population by Party Identification",col.names = c("Party identification", "U.S. census data 2019", "Survey results"),escape=T,booktabs=TRUE) %>% kable_styling(latex_options="scale_down","striped",font_size = 9,full_width = F) %>% row_spec(0,bold=TRUE) ``` ```{r weights,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # The next step is to specify the population distribution of the selected variables in a target list. I use two sources to obtain population values: the US census 2019. library(weights) library(anesrake) # target <- with(acs_data, list( # sex = wpct(sex, hhwt), # age = wpct(age, hhwt) # )) # us census 2019 for age groups agegroup <- c(.12, .67, .21) # pew research center partyid <- c(.33, .41, .26) # definitions of target list targets <- list(agegroup,partyid) # important: to use the same variable names of the dataset names(targets) <- c("agegroup", "partyid") # id variable survey_recoded$caseid <- 1:length(survey_recoded$partyid) #label levels of targets# names(targets$agegroup) <- levels(survey_recoded$agegroup) names(targets$partyid) <- levels(survey_recoded$partyid) # change table type survey_recoded <- as.data.frame(survey_recoded) #measure variance in population vs sample anesrakefinder(targets, survey_recoded, choosemethod = "total") # agegroup partyid # 0.355743 0.317992 ``` ```{r echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #save file save(survey_recoded,file="survey.Rda") ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # I apply the anesrake function as follows: # # The maximum weight value is five, weights greater than five will be truncated (cap = 5). # The total differences between population and sample have to be greater than 0.05 so that to include a variable (pctlim = .05). # The maximum number of variables included in the raking procedure is five (nlim = 5). outsave <- anesrake(targets, survey_recoded, caseid = survey_recoded$caseid, verbose= FALSE, cap = 5, choosemethod = "total", type = "pctlim", pctlim = .05 , nlim = 5, iterate = TRUE , force1 = TRUE) summary(outsave) ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # add weights to the dataset survey_recoded$weightvec <- unlist(outsave[1]) n <- length(survey_recoded$partyid) # weighting loss ((sum(survey_recoded$weightvec ^ 2) / (sum(survey_recoded$weightvec)) ^ 2) * n) - 1 # 0.6498814 # the weighting loss approximation denotes an increase in the design effect lower than .5, what meets the recommendations mentioned above. However, it is important to keep in mind that this weighting procedure does not take into account any clustering effect associated with the sample design. ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # Merge all the questions that are negative about Repubulicans and positive about Democrats #Psychopathic_RD + Psychopathic_RD_credible # A recent study claims that Republicans are more likely to show traits associated with mental disorder than Democrats. Psychopathic_RD <- survey_recoded %>% dplyr::select(Q13_1:Q14_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Psychopathic_RD)[1]<-"informative" names(Psychopathic_RD)[2]<-"authoritative" names(Psychopathic_RD)[3]<-"useful" names(Psychopathic_RD)[4]<-"believable" names(Psychopathic_RD)[5]<-"interesting" names(Psychopathic_RD)[6]<-"relevant" names(Psychopathic_RD)[7]<-"important" names(Psychopathic_RD)[8]<-"like" names(Psychopathic_RD)[9]<-"repost" names(Psychopathic_RD)[10]<-"comment" Psychopathic_RD_credible <- survey_recoded %>% dplyr::select(Q17_1:Q18_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1")%>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables for Q17 names(Psychopathic_RD_credible)[1]<-"informative" names(Psychopathic_RD_credible)[2]<-"authoritative" names(Psychopathic_RD_credible)[3]<-"useful" names(Psychopathic_RD_credible)[4]<-"believable" names(Psychopathic_RD_credible)[5]<-"interesting" names(Psychopathic_RD_credible)[6]<-"relevant" names(Psychopathic_RD_credible)[7]<-"important" names(Psychopathic_RD_credible)[8]<-"like" names(Psychopathic_RD_credible)[9]<-"repost" names(Psychopathic_RD_credible)[10]<-"comment" ##Q21+Q27 IQ_RD + IQ_RD_credible Republicans have an average lower IQ than Dems #Psychopathic_DR + Psychopathic_DR_credible IQ_RD <- survey_recoded %>% dplyr::select(Q21_1:Q22_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(IQ_RD)[1]<-"informative" names(IQ_RD)[2]<-"authoritative" names(IQ_RD)[3]<-"useful" names(IQ_RD)[4]<-"believable" names(IQ_RD)[5]<-"interesting" names(IQ_RD)[6]<-"relevant" names(IQ_RD)[7]<-"important" names(IQ_RD)[8]<-"like" names(IQ_RD)[9]<-"repost" names(IQ_RD)[10]<-"comment" IQ_RD_credible <- survey_recoded %>% dplyr::select(Q27_1:Q28_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables for Q19 names(IQ_RD_credible)[1]<-"informative" names(IQ_RD_credible)[2]<-"authoritative" names(IQ_RD_credible)[3]<-"useful" names(IQ_RD_credible)[4]<-"believable" names(IQ_RD_credible)[5]<-"interesting" names(IQ_RD_credible)[6]<-"relevant" names(IQ_RD_credible)[7]<-"important" names(IQ_RD_credible)[8]<-"like" names(IQ_RD_credible)[9]<-"repost" names(IQ_RD_credible)[10]<-"comment" #Intolerant_DR dems are more intolerant than reps [reps are not intolerant] #Q29+Q33 #Intolerant_DR + Intolerant_DR_credible Intolerant_DR <- survey_recoded %>% dplyr::select(Q29_1:Q30_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Intolerant_DR)[1]<-"informative" names(Intolerant_DR)[2]<-"authoritative" names(Intolerant_DR)[3]<-"useful" names(Intolerant_DR)[4]<-"believable" names(Intolerant_DR)[5]<-"interesting" names(Intolerant_DR)[6]<-"relevant" names(Intolerant_DR)[7]<-"important" names(Intolerant_DR)[8]<-"like" names(Intolerant_DR)[9]<-"repost" names(Intolerant_DR)[10]<-"comment" Intolerant_DR_credible <- survey_recoded %>% dplyr::select(Q33_1:Q34_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1")%>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Intolerant_DR_credible)[1]<-"informative" names(Intolerant_DR_credible)[2]<-"authoritative" names(Intolerant_DR_credible)[3]<-"useful" names(Intolerant_DR_credible)[4]<-"believable" names(Intolerant_DR_credible)[5]<-"interesting" names(Intolerant_DR_credible)[6]<-"relevant" names(Intolerant_DR_credible)[7]<-"important" names(Intolerant_DR_credible)[8]<-"like" names(Intolerant_DR_credible)[9]<-"repost" names(Intolerant_DR_credible)[10]<-"comment" #dems are more charitable [reps are not charitable] #charitable_DR + charitable_DR_credible Charitable_DR <- survey_recoded %>% dplyr::select(Q43_1:Q44_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Charitable_DR)[1]<-"informative" names(Charitable_DR)[2]<-"authoritative" names(Charitable_DR)[3]<-"useful" names(Charitable_DR)[4]<-"believable" names(Charitable_DR)[5]<-"interesting" names(Charitable_DR)[6]<-"relevant" names(Charitable_DR)[7]<-"important" names(Charitable_DR)[8]<-"like" names(Charitable_DR)[9]<-"repost" names(Charitable_DR)[10]<-"comment" Charitable_DR_credible <- survey_recoded %>% dplyr::select(Q39_1:Q40_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Charitable_DR_credible)[1]<-"informative" names(Charitable_DR_credible)[2]<-"authoritative" names(Charitable_DR_credible)[3]<-"useful" names(Charitable_DR_credible)[4]<-"believable" names(Charitable_DR_credible)[5]<-"interesting" names(Charitable_DR_credible)[6]<-"relevant" names(Charitable_DR_credible)[7]<-"important" names(Charitable_DR_credible)[8]<-"like" names(Charitable_DR_credible)[9]<-"repost" names(Charitable_DR_credible)[10]<-"comment" #Receptive_DR + Receptive_DR_credible #Q49 + Q47 # dems are more receptive to criticism than reps Receptive_DR <- survey_recoded %>% dplyr::select(Q49_1:Q50_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Receptive_DR)[1]<-"informative" names(Receptive_DR)[2]<-"authoritative" names(Receptive_DR)[3]<-"useful" names(Receptive_DR)[4]<-"believable" names(Receptive_DR)[5]<-"interesting" names(Receptive_DR)[6]<-"relevant" names(Receptive_DR)[7]<-"important" names(Receptive_DR)[8]<-"like" names(Receptive_DR)[9]<-"repost" names(Receptive_DR)[10]<-"comment" Receptive_DR_credible <- survey_recoded %>% dplyr::select(Q47_1:Q48_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Receptive_DR_credible)[1]<-"informative" names(Receptive_DR_credible)[2]<-"authoritative" names(Receptive_DR_credible)[3]<-"useful" names(Receptive_DR_credible)[4]<-"believable" names(Receptive_DR_credible)[5]<-"interesting" names(Receptive_DR_credible)[6]<-"relevant" names(Receptive_DR_credible)[7]<-"important" names(Receptive_DR_credible)[8]<-"like" names(Receptive_DR_credible)[9]<-"repost" names(Receptive_DR_credible)[10]<-"comment" #dems are more open - minded #Openminded_DR + Openminded_DR_credible # Openminded_DR <- survey_recoded %>% # dplyr::select(Q55_1:Q56_3,partyid,sex,age,edu,poli,social) %>% # mutate(credibility = "0") %>% #Without credible source # # recode empty strings "" by NAs # na_if("") %>% # # remove NAs # na.omit # # #rename variables # names(Openminded_DR)[1]<-"informative" # names(Openminded_DR)[2]<-"authoritative" # names(Openminded_DR)[3]<-"useful" # names(Openminded_DR)[4]<-"believable" # names(Openminded_DR)[5]<-"interesting" # names(Openminded_DR)[6]<-"relevant" # names(Openminded_DR)[7]<-"important" # names(Openminded_DR)[8]<-"like" # names(Openminded_DR)[9]<-"repost" # names(Openminded_DR)[10]<-"comment" # # # Openminded_DR_credible <- survey_recoded %>% # dplyr::select(Q53_1:Q54_3,partyid,sex,age,edu,poli,social) %>% # mutate(credibility = "1") %>% #Without credible source # # recode empty strings "" by NAs # na_if("") %>% # # remove NAs # na.omit # # #rename variables # names(Openminded_DR_credible)[1]<-"informative" # names(Openminded_DR_credible)[2]<-"authoritative" # names(Openminded_DR_credible)[3]<-"useful" # names(Openminded_DR_credible)[4]<-"believable" # names(Openminded_DR_credible)[5]<-"interesting" # names(Openminded_DR_credible)[6]<-"relevant" # names(Openminded_DR_credible)[7]<-"important" # names(Openminded_DR_credible)[8]<-"like" # names(Openminded_DR_credible)[9]<-"repost" # names(Openminded_DR_credible)[10]<-"comment" #Sciencedenial_RD + Sciencedenial_RD_credible #reps are more prone to science denial Sciencedenial_RD <- survey_recoded %>% dplyr::select(Q65_1:Q66_3,partyid,sex,edu,age,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Sciencedenial_RD)[1]<-"informative" names(Sciencedenial_RD)[2]<-"authoritative" names(Sciencedenial_RD)[3]<-"useful" names(Sciencedenial_RD)[4]<-"believable" names(Sciencedenial_RD)[5]<-"interesting" names(Sciencedenial_RD)[6]<-"relevant" names(Sciencedenial_RD)[7]<-"important" names(Sciencedenial_RD)[8]<-"like" names(Sciencedenial_RD)[9]<-"repost" names(Sciencedenial_RD)[10]<-"comment" Sciencedenial_RD_credible <- survey_recoded %>% dplyr::select(Q61_1:Q62_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Sciencedenial_RD_credible)[1]<-"informative" names(Sciencedenial_RD_credible)[2]<-"authoritative" names(Sciencedenial_RD_credible)[3]<-"useful" names(Sciencedenial_RD_credible)[4]<-"believable" names(Sciencedenial_RD_credible)[5]<-"interesting" names(Sciencedenial_RD_credible)[6]<-"relevant" names(Sciencedenial_RD_credible)[7]<-"important" names(Sciencedenial_RD_credible)[8]<-"like" names(Sciencedenial_RD_credible)[9]<-"repost" names(Sciencedenial_RD_credible)[10]<-"comment" #Q69+Q75 Lies_RD +Lies_RD_credible #reps are more susceptable to beliving lies Lies_RD <- survey_recoded %>% dplyr::select(Q69_1:Q70_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Lies_RD)[1]<-"informative" names(Lies_RD)[2]<-"authoritative" names(Lies_RD)[3]<-"useful" names(Lies_RD)[4]<-"believable" names(Lies_RD)[5]<-"interesting" names(Lies_RD)[6]<-"relevant" names(Lies_RD)[7]<-"important" names(Lies_RD)[8]<-"like" names(Lies_RD)[9]<-"repost" names(Lies_RD)[10]<-"comment" Lies_RD_credible <- survey_recoded %>% dplyr::select(Q75_1:Q76_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Lies_RD_credible)[1]<-"informative" names(Lies_RD_credible)[2]<-"authoritative" names(Lies_RD_credible)[3]<-"useful" names(Lies_RD_credible)[4]<-"believable" names(Lies_RD_credible)[5]<-"interesting" names(Lies_RD_credible)[6]<-"relevant" names(Lies_RD_credible)[7]<-"important" names(Lies_RD_credible)[8]<-"like" names(Lies_RD_credible)[9]<-"repost" names(Lies_RD_credible)[10]<-"comment" ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} ###Bind rows Rep_negative <- rbind(Psychopathic_RD,Psychopathic_RD_credible,IQ_RD,IQ_RD_credible,Intolerant_DR,Intolerant_DR_credible,Charitable_DR,Charitable_DR_credible,Receptive_DR,Receptive_DR_credible,Sciencedenial_RD,Sciencedenial_RD_credible,Lies_RD,Lies_RD_credible) #drop unused levels "" Rep_negative$like <- droplevels(Rep_negative$like) Rep_negative$repost <- droplevels(Rep_negative$repost) Rep_negative$comment <- droplevels(Rep_negative$comment) #reorder factor levelsd[like, repost, comment] https://rpubs.com/sediaz/reorder_levels # Rep_negative$like <- factor(Rep_negative$like,levels(Rep_negative$like)[c(2,5,3,4,1)]) # Rep_negative$repost <- factor(Rep_negative$repost,levels(Rep_negative$repost )[c(2,5,3,4,1)]) # Rep_negative$comment <- factor(Rep_negative$comment,levels(Rep_negative$comment)[c(2,5,3,4,1)]) # reorder levels Rep_negative$like <- factor(Rep_negative$like, levels = c("Extremely unlikely", "Somewhat unlikely", "Neither likely nor unlikely","Somewhat likely", "Extremely likely")) Rep_negative$repost <- factor(Rep_negative$repost, levels = c("Extremely unlikely", "Somewhat unlikely", "Neither likely nor unlikely","Somewhat likely", "Extremely likely")) Rep_negative$comment <- factor(Rep_negative$comment, levels = c("Extremely unlikely", "Somewhat unlikely", "Neither likely nor unlikely","Somewhat likely", "Extremely likely")) #convert numericals to factors Rep_negative$informative <- factor(Rep_negative$informative) Rep_negative$authoritative <- factor(Rep_negative$authoritative) Rep_negative$useful <- factor(Rep_negative$useful) Rep_negative$believable <- factor(Rep_negative$believable) Rep_negative$interesting <- factor(Rep_negative$interesting) Rep_negative$relevant <- factor(Rep_negative$relevant) Rep_negative$important <- factor(Rep_negative$important) #reorder levels Rep_negative$informative <- factor(Rep_negative$informative,levels(Rep_negative$informative)[c(5,4,3,2,1)]) Rep_negative$authoritative <- factor(Rep_negative$authoritative,levels(Rep_negative$authoritative)[c(5,4,3,2,1)]) Rep_negative$useful <- factor(Rep_negative$useful,levels(Rep_negative$useful)[c(5,4,3,2,1)]) Rep_negative$believable <- factor(Rep_negative$believable,levels(Rep_negative$believable)[c(5,4,3,2,1)]) Rep_negative$interesting <- factor(Rep_negative$interesting,levels(Rep_negative$interesting)[c(5,4,3,2,1)]) Rep_negative$relevant <- factor(Rep_negative$important,levels(Rep_negative$relevant)[c(5,4,3,2,1)]) Rep_negative$important <- factor(Rep_negative$important,levels(Rep_negative$important)[c(5,4,3,2,1)]) # create a Rep_unfav variable to indicate the nature of the tweet Rep_negative$Rep_unfav <- 1 ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #Psychopathic_DR + Psychopathic_DR_credible #Q15+Q19 #dems are more likely to show traits associated with mental disorder than reps Psychopathic_DR <- survey_recoded %>% dplyr::select(Q15_1:Q16_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Psychopathic_DR)[1]<-"informative" names(Psychopathic_DR)[2]<-"authoritative" names(Psychopathic_DR)[3]<-"useful" names(Psychopathic_DR)[4]<-"believable" names(Psychopathic_DR)[5]<-"interesting" names(Psychopathic_DR)[6]<-"relevant" names(Psychopathic_DR)[7]<-"important" names(Psychopathic_DR)[8]<-"like" names(Psychopathic_DR)[9]<-"repost" names(Psychopathic_DR)[10]<-"comment" Psychopathic_DR_credible <- survey_recoded %>% dplyr::select(Q19_1:Q20_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1")%>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Psychopathic_DR_credible)[1]<-"informative" names(Psychopathic_DR_credible)[2]<-"authoritative" names(Psychopathic_DR_credible)[3]<-"useful" names(Psychopathic_DR_credible)[4]<-"believable" names(Psychopathic_DR_credible)[5]<-"interesting" names(Psychopathic_DR_credible)[6]<-"relevant" names(Psychopathic_DR_credible)[7]<-"important" names(Psychopathic_DR_credible)[8]<-"like" names(Psychopathic_DR_credible)[9]<-"repost" names(Psychopathic_DR_credible)[10]<-"comment" #dems have a lower IQ than reps #Q23 + Q25 #IQ_DR + IQ_DR_credible IQ_DR <- survey_recoded %>% dplyr::select(Q23_1:Q24_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(IQ_DR)[1]<-"informative" names(IQ_DR)[2]<-"authoritative" names(IQ_DR)[3]<-"useful" names(IQ_DR)[4]<-"believable" names(IQ_DR)[5]<-"interesting" names(IQ_DR)[6]<-"relevant" names(IQ_DR)[7]<-"important" names(IQ_DR)[8]<-"like" names(IQ_DR)[9]<-"repost" names(IQ_DR)[10]<-"comment" IQ_DR_credible <- survey_recoded %>% dplyr::select(Q25_1:Q26_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(IQ_DR_credible)[1]<-"informative" names(IQ_DR_credible)[2]<-"authoritative" names(IQ_DR_credible)[3]<-"useful" names(IQ_DR_credible)[4]<-"believable" names(IQ_DR_credible)[5]<-"interesting" names(IQ_DR_credible)[6]<-"relevant" names(IQ_DR_credible)[7]<-"important" names(IQ_DR_credible)[8]<-"like" names(IQ_DR_credible)[9]<-"repost" names(IQ_DR_credible)[10]<-"comment" #reps are more tolerant/dems are not # Intolerant_RD + Intolerant_RD_credible #Q31 + Q35 Intolerant_RD <- survey_recoded %>% dplyr::select(Q31_1:Q32_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Intolerant_RD)[1]<-"informative" names(Intolerant_RD)[2]<-"authoritative" names(Intolerant_RD)[3]<-"useful" names(Intolerant_RD)[4]<-"believable" names(Intolerant_RD)[5]<-"interesting" names(Intolerant_RD)[6]<-"relevant" names(Intolerant_RD)[7]<-"important" names(Intolerant_RD)[8]<-"like" names(Intolerant_RD)[9]<-"repost" names(Intolerant_RD)[10]<-"comment" Intolerant_RD_credible <- survey_recoded %>% dplyr::select(Q35_1:Q36_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1")%>% #With credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Intolerant_RD_credible)[1]<-"informative" names(Intolerant_RD_credible)[2]<-"authoritative" names(Intolerant_RD_credible)[3]<-"useful" names(Intolerant_RD_credible)[4]<-"believable" names(Intolerant_RD_credible)[5]<-"interesting" names(Intolerant_RD_credible)[6]<-"relevant" names(Intolerant_RD_credible)[7]<-"important" names(Intolerant_RD_credible)[8]<-"like" names(Intolerant_RD_credible)[9]<-"repost" names(Intolerant_RD_credible)[10]<-"comment" # charitable_RD + charitable_RD_credible # Q41 + Q37 # reps are more charitable than dems Charitable_RD <- survey_recoded %>% dplyr::select(Q41_1:Q42_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Charitable_RD)[1]<-"informative" names(Charitable_RD)[2]<-"authoritative" names(Charitable_RD)[3]<-"useful" names(Charitable_RD)[4]<-"believable" names(Charitable_RD)[5]<-"interesting" names(Charitable_RD)[6]<-"relevant" names(Charitable_RD)[7]<-"important" names(Charitable_RD)[8]<-"like" names(Charitable_RD)[9]<-"repost" names(Charitable_RD)[10]<-"comment" Charitable_RD_credible <- survey_recoded %>% dplyr::select(Q37_1:Q38_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Charitable_RD_credible)[1]<-"informative" names(Charitable_RD_credible)[2]<-"authoritative" names(Charitable_RD_credible)[3]<-"useful" names(Charitable_RD_credible)[4]<-"believable" names(Charitable_RD_credible)[5]<-"interesting" names(Charitable_RD_credible)[6]<-"relevant" names(Charitable_RD_credible)[7]<-"important" names(Charitable_RD_credible)[8]<-"like" names(Charitable_RD_credible)[9]<-"repost" names(Charitable_RD_credible)[10]<-"comment" #Receptive_RD + Receptive_RD_credible #Q51 + Q45 #reps are more receptive to criticism than dems/dems are not Receptive_RD <- survey_recoded %>% dplyr::select(Q51_1:Q52_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Receptive_RD)[1]<-"informative" names(Receptive_RD)[2]<-"authoritative" names(Receptive_RD)[3]<-"useful" names(Receptive_RD)[4]<-"believable" names(Receptive_RD)[5]<-"interesting" names(Receptive_RD)[6]<-"relevant" names(Receptive_RD)[7]<-"important" names(Receptive_RD)[8]<-"like" names(Receptive_RD)[9]<-"repost" names(Receptive_RD)[10]<-"comment" Receptive_RD_credible <- survey_recoded %>% dplyr::select(Q45_1:Q46_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Receptive_RD_credible)[1]<-"informative" names(Receptive_RD_credible)[2]<-"authoritative" names(Receptive_RD_credible)[3]<-"useful" names(Receptive_RD_credible)[4]<-"believable" names(Receptive_RD_credible)[5]<-"interesting" names(Receptive_RD_credible)[6]<-"relevant" names(Receptive_RD_credible)[7]<-"important" names(Receptive_RD_credible)[8]<-"like" names(Receptive_RD_credible)[9]<-"repost" names(Receptive_RD_credible)[10]<-"comment" #Openminded_RD + Openminded_RD_credible #Q57 + Q59 #reps are more open - minded than dems/dems are not # Openminded_RD <- survey_recoded %>% # dplyr::select(Q57_1:Q58_3,partyid,sex,age,edu,poli,social) %>% # mutate(credibility = "0") %>% #Without credible source # # recode empty strings "" by NAs # na_if("") %>% # # remove NAs # na.omit # # #rename variables # names(Openminded_RD)[1]<-"informative" # names(Openminded_RD)[2]<-"authoritative" # names(Openminded_RD)[3]<-"useful" # names(Openminded_RD)[4]<-"believable" # names(Openminded_RD)[5]<-"interesting" # names(Openminded_RD)[6]<-"relevant" # names(Openminded_RD)[7]<-"important" # names(Openminded_RD)[8]<-"like" # names(Openminded_RD)[9]<-"repost" # names(Openminded_RD)[10]<-"comment" # # # Openminded_RD_credible <- survey_recoded %>% # dplyr::select(Q59_1:Q60_3,partyid,sex,age,edu,poli,social) %>% # mutate(credibility = "1") %>% #Without credible source # # recode empty strings "" by NAs # na_if("") %>% # # remove NAs # na.omit # # #rename variables # names(Openminded_RD_credible)[1]<-"informative" # names(Openminded_RD_credible)[2]<-"authoritative" # names(Openminded_RD_credible)[3]<-"useful" # names(Openminded_RD_credible)[4]<-"believable" # names(Openminded_RD_credible)[5]<-"interesting" # names(Openminded_RD_credible)[6]<-"relevant" # names(Openminded_RD_credible)[7]<-"important" # names(Openminded_RD_credible)[8]<-"like" # names(Openminded_RD_credible)[9]<-"repost" # names(Openminded_RD_credible)[10]<-"comment" #Sciencedenial_DR + Sciencedenial_DR_credible #Q63 + Q67 #dems are more prone to science denial Sciencedenial_DR <- survey_recoded %>% dplyr::select(Q63_1:Q64_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Sciencedenial_DR)[1]<-"informative" names(Sciencedenial_DR)[2]<-"authoritative" names(Sciencedenial_DR)[3]<-"useful" names(Sciencedenial_DR)[4]<-"believable" names(Sciencedenial_DR)[5]<-"interesting" names(Sciencedenial_DR)[6]<-"relevant" names(Sciencedenial_DR)[7]<-"important" names(Sciencedenial_DR)[8]<-"like" names(Sciencedenial_DR)[9]<-"repost" names(Sciencedenial_DR)[10]<-"comment" Sciencedenial_DR_credible <- survey_recoded %>% dplyr::select(Q67_1:Q68_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Sciencedenial_DR_credible)[1]<-"informative" names(Sciencedenial_DR_credible)[2]<-"authoritative" names(Sciencedenial_DR_credible)[3]<-"useful" names(Sciencedenial_DR_credible)[4]<-"believable" names(Sciencedenial_DR_credible)[5]<-"interesting" names(Sciencedenial_DR_credible)[6]<-"relevant" names(Sciencedenial_DR_credible)[7]<-"important" names(Sciencedenial_DR_credible)[8]<-"like" names(Sciencedenial_DR_credible)[9]<-"repost" names(Sciencedenial_DR_credible)[10]<-"comment" #dems are more susceptable to believing in lies #Lies_DR + Lies_DR_credible #Q73 + Q71 Lies_DR <- survey_recoded %>% dplyr::select(Q73_1:Q74_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "0") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Lies_DR)[1]<-"informative" names(Lies_DR)[2]<-"authoritative" names(Lies_DR)[3]<-"useful" names(Lies_DR)[4]<-"believable" names(Lies_DR)[5]<-"interesting" names(Lies_DR)[6]<-"relevant" names(Lies_DR)[7]<-"important" names(Lies_DR)[8]<-"like" names(Lies_DR)[9]<-"repost" names(Lies_DR)[10]<-"comment" Lies_DR_credible <- survey_recoded %>% dplyr::select(Q71_1:Q72_3,partyid,sex,age,edu,poli,social,weightvec) %>% mutate(credibility = "1") %>% #Without credible source # recode empty strings "" by NAs na_if("") %>% # remove NAs na.omit #rename variables names(Lies_DR_credible)[1]<-"informative" names(Lies_DR_credible)[2]<-"authoritative" names(Lies_DR_credible)[3]<-"useful" names(Lies_DR_credible)[4]<-"believable" names(Lies_DR_credible)[5]<-"interesting" names(Lies_DR_credible)[6]<-"relevant" names(Lies_DR_credible)[7]<-"important" names(Lies_DR_credible)[8]<-"like" names(Lies_DR_credible)[9]<-"repost" names(Lies_DR_credible)[10]<-"comment" ###Bind rows Dem_negative <- rbind(Psychopathic_DR,Psychopathic_DR_credible,IQ_DR,IQ_DR_credible,Intolerant_RD,Intolerant_RD_credible,Charitable_RD,Charitable_RD_credible,Receptive_RD,Receptive_RD_credible,Sciencedenial_DR,Sciencedenial_DR_credible,Lies_DR,Lies_DR_credible) ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #drop unused levels "" Dem_negative$like <- droplevels(Dem_negative$like) Dem_negative$repost <- droplevels(Dem_negative$repost) Dem_negative$comment <- droplevels(Dem_negative$comment) #reorder factor levelsd[like, repost, comment] https://rpubs.com/sediaz/reorder_levels Dem_negative$like <- factor(Dem_negative$like,levels(Dem_negative$like)[c(2,5,3,4,1)]) Dem_negative$repost <- factor(Dem_negative$repost,levels(Dem_negative$repost)[c(2,5,3,4,1)]) Dem_negative$comment <- factor(Dem_negative$comment,levels(Dem_negative$comment)[c(2,5,3,4,1)]) # factorize and numericalize like, repost, and comment # Dem_negative$like <- as.numeric(as_factor(Dem_negative$like)) # Dem_negative$repost <- as.numeric(as_factor(Dem_negative$repost)) # Dem_negative$lcomment <- as.numeric(as_factor(Dem_negative$comment)) #convert numericals to factors Dem_negative$informative <- factor(Dem_negative$informative) Dem_negative$authoritative <- factor(Dem_negative$authoritative) Dem_negative$useful <- factor(Dem_negative$useful) Dem_negative$believable <- factor(Dem_negative$believable) Dem_negative$interesting <- factor(Dem_negative$interesting) Dem_negative$relevant <- factor(Dem_negative$relevant) Dem_negative$important <- factor(Dem_negative$important) #reorder levels Dem_negative$informative <- factor(Dem_negative$informative,levels(Dem_negative$informative)[c(5,4,3,2,1)]) Dem_negative$authoritative <- factor(Dem_negative$authoritative,levels(Dem_negative$authoritative)[c(5,4,3,2,1)]) Dem_negative$useful <- factor(Dem_negative$useful,levels(Dem_negative$useful)[c(5,4,3,2,1)]) Dem_negative$believable <- factor(Dem_negative$believable,levels(Dem_negative$believable)[c(5,4,3,2,1)]) Dem_negative$interesting <- factor(Dem_negative$interesting,levels(Dem_negative$interesting)[c(5,4,3,2,1)]) Dem_negative$relevant <- factor(Dem_negative$important,levels(Dem_negative$important)[c(5,4,3,2,1)]) # unfavorable towards dems = fav towards reps Dem_negative$Rep_unfav <- 0 ``` ```{r,echo = FALSE, message = FALSE,results = "hide",eval=FALSE} # Merge negative and positive rbind_all <- rbind(Rep_negative,Dem_negative) # make categorical rbind_all$credibility <- as_factor(rbind_all$credibility) rbind_all$Rep_unfav <- as_factor(rbind_all$Rep_unfav) ``` ```{r echo = FALSE, message = FALSE,results = "hide",eval=FALSE} #save file save(rbind_all,file="rbind_all.Rda") ``` ## Survey structure      An experimental survey was designed to investigate how an individual's party identification and level of political knowledge shape disinformation sharing behavior. Other independent variables, including sex (gender),age, educational level, social media engagement, information credibility are also included in the survey experiment to see what predicts individuals' disinformation sharing behavior. To ensure the viability of the survey, I conducted a pilot study before I formally launched the survey with 36 undergraduate and graduate students from the University of Chicago and the University of California, Los Angeles, where students were presented with the 16 social media postings (See Table \@ref(tab:table3) and \@ref(tab:table4)) and were asked to report how they would share the postings. The pilot testing results show that 100% of test participants fully understood each question and were able to provide clear answers to the questions. Given that the feasibility of the survey was guaranteed, I proceeded with the survey on a large scale by recruiting 500 human subjects and randomly assigning them to four conditions. The survey consists of 3 parts: Part 1 includes 16 questions designated to investigate how respondents shared political disinformation; Part 2 is a battery of questions adapted from a Pew public knowledge survey; Part 3 are demographic questions. Additionally, attention check questions were inserted in the survey and appeared randomly. ### Part 1      To examine how respondents reacted to and acted upon partisan cues, respondent were randomly assigned to four groups, in which each respondent was asked to rate the following types of fabricated posts. For the first group, respondents received a fabricated social media post without referencing credible source, such as "A recent study claims that *Republicans* are more likely to show traits associated with mental disorder than *Democrats*." Respondents in the second group received the same information but the order in which the question was asked was rotated. Therefore, respondents in this group received the information as "A recent study claims that *Democrats* are more likely to show traits associated with mental disorder than *Republicans*." Likewise, the third group of respondents were presented with a similar post from the first group but the information was in reference to a credible source: "**Scientists from Harvard University** found that *Republicans* are more likely to show traits associated with mental disorder than *Democrats*." The credible source in this post refers to "Harvard University" as a reputable academic institution. Finally, respondents in the fourth group received the information as follows, "**Scientists from Harvard University** found that *Democrats* are more likely to show traits associated with mental disorder than *Republicans*." Please see Table \@ref(tab:table3) and \@ref(tab:table4) for the battery of questions used in the survey to measure political disinformation sharing behavior.      One of the purposes of the experimental study was to examine how the authority or credibility of information sources influences individuals' tendency to share political disinformation, which is why two groups received social media posts in reference to credible information sources while the other two did not. It is widely assumed that individuals tend to seek information from credible sources. To test if this presumption holds true, I include a few elite research institutions, including Harvard, Yale, Princeton Universities; and some top academic journals as the information sources to examine how participants shared disinformation. There are two reasons to treat them as trusted information sources. 1)Research institutions and academic journals are considered highly authoritative, especially Harvard, Yale, and Princeton are all well-known institutions in the United States; 2)Due to its nonprofit nature, research institutions tend to be perceived as non-partisan sources in comparison to other information sources, such as media outlets and government agencies.      Respondents were then asked to report how likely they would share the fabricated social media postings on a scale from 1 to 5, with 1 being extremely unlikely to share, and 5 being extremely likely to share. Two attention check questions were inserted into the survey to ensure that respondents paid attention and fully engaged in completing the survey. All the respondents successfully passed the attention checks. It should be noted that the social media posts were fabricated disinformation rather than existing disinformation; the rationale for that is to rule out the possibility that some respondents may have had possessed prior knowledge of existing disinformation, which could potentially violate the reliability and validity of the experimental results. ```{r table3, echo = FALSE, message=FALSE, warning = FALSE,results='asis'} library(papaja) library(tinylabels) library(kableExtra) audit_table <- structure( list( Questions = c( "A recent study claims that Republicans/Democrats are more likely to show traits associated with mental disorder than Democrats/Republicans.", "New study shows that Republicans/Democrats have a lower average IQ than Democrats/Republicans.", "A study published last week found Republicans/Democrats are far more tolerant of other viewpoints than Democrats/Republicans.", "Recent research on charitable participation and giving shows that Republicans/Democrats are more charitable than Democrats/Republicans.", "Republicans/Democrats are more receptive to criticism than Democrats/Republicans, a new study says.", "New research suggests that Republicans/Democrats are more open-minded than Republicans/Democrats.", "New study shows that Republicans/Democrats are more likely than Republicans/Democrats to be prone to science denial.", "A new study suggests that Republicans/Democrats are more susceptible to beliving in lies than Republicans/Democrats." ), `1` = c(rep("Extremely unlikely",8)), `2` = c(rep("Somewhat unlikely",8)), `3` = c(rep("Neither likely nor unlikely",8)), `4` = c(rep("Somewhat likely",8)), `5` = c(rep("Extremely likely",8)) ), class = "data.frame", row.names = c(NA, 8L) ) library(stargazer) audit_table %>% kable(format="latex", longtable = T, caption = "Survey Questions (Part 1)",escape=T,booktabs=TRUE) %>% kable_styling(latex_options="scale_down","striped",font_size = 9,full_width = F) %>% row_spec(0,bold=TRUE) %>% column_spec(1, width = "16em") %>% column_spec(2, width = "6em") %>% column_spec(3, width = "6em") %>% column_spec(4, width = "6em") %>% column_spec(5, width = "6em") ``` ```{r table4,echo = FALSE, message=FALSE, warning = FALSE,results='asis'} library(papaja) library(tinylabels) library(kableExtra) audit1_table <- structure( list( Questions = c( "Scientists from Harvard University found that Republicans/Democrats are more likely to show traits associated with mental disorder than Democrats/Republicans.", "A new study recently published in Political Psychology shows that Republicans/Democrats have a lower average IQ than Democrats/Republicans.", "A Princeton study published last week found Republicans/Democrats are far more tolerant of other viewpoints than Republicans.", "A recent Harvard study of charitable participation and giving shows that Republicans/Democrats are more charitable than Democrats/Republicans.", "Republicans/Democrats are more receptive to criticism than Democrats/Republicans, a new study published in American Politics says.", "Republicans/Democrats are more open-minded than Republicans/Democrats,according to a new study published in the Journal of Political Behavior.", "In a new study,Yale researchers found that Republicans/Democrats are more likely than Republicans/Democrats to be prone to science denial.", "A new Harvard study suggests that Republicans/Democrats are more susceptible to beliving in lies than Republicans/Democrats." ), `1` = c(rep("Extremely unlikely",8)), `2` = c(rep("Somewhat unlikely",8)), `3` = c(rep("Neither likely nor unlikely",8)), `4` = c(rep("Somewhat likely",8)), `5` = c(rep("Extremely likely",8)) ), class = "data.frame", row.names = c(NA, 8L) ) # apa_table( # audit1_table, # font_size = "small", # caption = "Survey (Part 2)", # align = c("m{8cm}", rep("m{2cm}", 5)), # col_spanners = list("Score" = c(2,6)), # note = "Item scores are summed. Women who score 3+ and men who score 4+ are at-risk", # landscape = TRUE # ) # kable_styling(font_size = 10, # latex_options = "HOLD_position") # # landscape( margin = NULL) audit1_table %>% kable(format="latex", longtable = T, caption = "Survey Questions (Part 2)",escape=T,booktabs=TRUE) %>% kable_styling(latex_options="scale_down","striped",font_size = 9,full_width = F) %>% row_spec(0,bold=TRUE) %>% column_spec(1, width = "16em") %>% column_spec(2, width = "6em") %>% column_spec(3, width = "6em") %>% column_spec(4, width = "6em") %>% column_spec(5, width = "6em") ``` ### Part 2      In terms of political knowledge level, ten multiple-choice questions adapted from @pew2019the were used in this study to measure the respondents' level of political knowledge. The battery of the survey questions have been widely used in previous social science research to gauge one's political knowledge level [@johnson2011voices;@ran2016media]. Please see Table \@ref(tab:table5) for the adapted version of the survey questions. ```{r table5, echo = FALSE, message=FALSE, warning = FALSE,results='asis'} library(papaja) library(tinylabels) library(kableExtra) question_table <- structure( list( Questions = c( "1. Who is the current Secretary of State? ", "2. Who is the current President of France? ", "3. Is Neil Gorsuch… ", "4. Who was appointed as special counsel overseeing an investigation into allegations of Russian interference in the 2016 U.S. presidential election?", "5. The tap water in Flint, Michigan is unsafe because it contains too much… ", "6. Many conservative Republicans in the House of Representatives are members of which of the following groups? ", "7. Which of the following countries has officially started the process of leaving the European Union? ", "8. According to the CDC, humans are infected with the Zika virus primarily by… ", "9. Do you happen to know the name of the current Speaker of the U.S. House of Representatives? Is it ", "10. What is the percentage of the Jewish population of the United States?" ), `1` = c("Mitt Romney","Emmanuel Macron","a Supreme Court justice","James Comey","Lead","The Tuesday Group","Greece","Mosquitoes","Paul Ryan","1.4%"), `2` = c("John Kerry","Justin Trudeau","a Senator","Sean Spicer","Arsenic","The Lincoln Group","Germany","Rodents","Nancy Pelosi","14%"), `3` = c("Rex Tillerson","Malcolm Turnbull","the Solicitor General","Sally Yates","Asbestos","The Freedom Caucus","Hungary","Spoiled food","Jason Chaffetz","2.7%"), `4` = c("Mike Pompeo","Boris Johnson","the head of the EPA","Robert Mueller","Mold","The Blue Dogs","The United Kingdom","Contaminated water","Mitch McConnell","27%") ), class = "data.frame", row.names = c(NA, 10L) ) # # apa_table( # audit_table, # font_size = "small", # caption = "Survey (Part 1)", # align = c("m{8cm}", rep("m{2cm}", 5)), # col_spanners = list("Score" = c(2,6)), # # note = "Item scores are summed. Women who score 3+ and men who score 4+ are at-risk", # landscape = TRUE # ) # kable_styling(font_size = 10, # latex_options = "HOLD_position") # landscape() question_table %>% kable(format="latex", longtable = T, caption = "Political Lnowledge Questions",escape=T,booktabs=TRUE) %>% kable_styling(latex_options="scale_down","striped",font_size = 9,full_width = F) %>% row_spec(0,bold=TRUE) %>% column_spec(1, width = "16em") %>% column_spec(2, width = "8em") %>% column_spec(3, width = "8em") %>% column_spec(4, width = "8em") %>% column_spec(5, width = "8em") ``` ### Part 3      Demographic questions, including age, sex, education, political identity, and social media engagement were gathered in Part 3 of the survey. In this study, social media engagement is quantified as the amount of time individuals spend on ten common social media platforms, including Facebook, Twitter, Snapchat, Instagram, YouTube, Reddit, Tumblr, Pinterest, TikTok, and WhatsApp. ### Dependent variable      In this survey experiment, the research participants are asked to report how likely they would be sharing the fabricated postings shown to them on a scale of 1 – 5, ranging from "extremely unlikely" to "extremely likely (to repost)." Since the response variable "repost" is ordinal in nature, an ordinal logistic regression (henceforth, OLS) - proportional odds model (POM) is developed to find predictors of the dependent variable. ### Independent Variables      The predictors used as statistical controls to measure respondents’ disinformation sharing behavior are as follows,       *Party identification (Party ID)*: The survey asks the respondents to self-identify and self–classify themselves in one of the 3 categories: Democrat, Republican, and Independent. In the model section, I further dummy code "Democrat" and "Republican" while treating "Independent" as the omitted category.       *Sex (Gender)*: Sex is measured with three categorical variable, namely male, female, and other. However, given that only one respondent in the survey identifies as "other," I removed the only case in which the response for gender identification is recorded as "other," which also allows me to make comparisons on disinformation sharing behavior between female and male individuals (H5).       *Age*: Age is measured on a ratio numeric scale by asking respondents to self-report their age.       *Education*: Education is measured by a 7-point scale item ranging from "less than high school" to "doctorate degree", and is further converted into an interval scale between 0 and 1. The coding process is specified as follows: 0 = "Less than high school", 1 = "High school graduate", 2= "Some college", 3 ="2 year degree", 4 = "4 year degree", 5 = "Professional degree" or "Doctorate" in an ordinal order. Then these items are recoded to a 0 to 1 interval^[The variable is recoded to a 0 to 1 interval using the formula: [Variable - lowest (Variable)]/[highest value (Variable) - lowest value (Variable)].].       *Political knowledge*: The variable is measured by 10 questions. On a scale of 0 to 10, respondents who provide correct answers to all the 10 questions receive a score of 10, indicating that they have the highest levels of political knowledge. By contrast, respondents who fail to answer any of the questions receive a score of 0, suggesting that they possess the lowest levels of political knowledge. Similar to education, this variable is recoded to an interval variable between 0 and 1.       *Social media engagement*: This numerical variable is measured on 5-point ordinal scale, based on which experimental subjects are asked to report the amount of time they spend on social media. In ascending order, the options include: Less often, Every few weeks, A few times a week, About once a day, Several times a day. Again, this variable is also recoded to an interval between 0 and 1 for data analyses.       *Information credibility*: This variable consists of two categories, namely "non – credible" and "credible" sources. "Non credible" refers to information without a credible source, which is coded as "0." In this case, human subjects are presented with social media postings without referencing any information sources. On the contrary, credible information refers to information with a credible source, which is coded as "1." In this study, credible information sources are operationalized as prestigious academic institutions and well-established academic journals.