Final Paper
Anika
5/12/2021
1. Introduction of Research Topic
I will be using data from a Janurary 2019 Electorate Research Survey conducted by the democracy fund, to explore how democrats and republicans differ in their attitudes towards wealthy people.
2. Description of Variables & Data Preparation
Below are the variables that I will be using:
partyreg_baseline ->Party Registration- Democrat & Republican
wealth6_2019->Describe wealthy people - Help others by giving to charities - 2019
wealth4_2019->Describe wealthy people - Create jobs - 2019
rwm_2019->Feeling Thermometer – Rich white men - 2019
Import Data
VD2019<-read.csv("/Volumes/FLASHDRIVE/Data 333/Voter Data 2019.csv")
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)Recode & Select Data
VD2019_recoded<-VD2019%>%
mutate(WealthCharity = ifelse(wealth6_2019==1,"Very well",
ifelse(wealth6_2019==2,"Somewhat well",
ifelse(wealth6_2019==3,"Not very well",
ifelse(wealth6_2019==4,"Not at all well",NA)))),
Wealthjobs = ifelse(wealth4_2019==1,"Very well",
ifelse(wealth4_2019==2,"Somewhat well",
ifelse(wealth4_2019==3,"Not very well",
ifelse(wealth4_2019==4,"Not at all well",NA)))),
WealthyWhiteMen = ifelse(rwm_2019>100,NA,rwm_2019),
WealthywhiteWomen = ifelse(rww_2019>100,NA,rww_2019),
WealthyBlackMen = ifelse(rbm_2019>100,NA,rbm_2019),
WealthyBlackWomen = ifelse(rbw_2019>100,NA,rbw_2019),
Party=ifelse(partyreg_baseline==1,"Democrat",
ifelse(partyreg_baseline==2,"Republican",NA)))%>%
select(Party, WealthCharity, Wealthjobs,
WealthyWhiteMen,WealthywhiteWomen,WealthyBlackMen,WealthyBlackWomen) %>%
filter (Party %in% c("Democrat", "Republican"))
head(VD2019_recoded)## Party WealthCharity Wealthjobs WealthyWhiteMen WealthywhiteWomen
## 1 Republican <NA> <NA> NA NA
## 2 Democrat Not very well Not very well NA NA
## 3 Democrat Not very well Not very well NA NA
## 4 Democrat <NA> <NA> NA NA
## 5 Democrat <NA> <NA> NA NA
## 6 Democrat Not very well Not very well NA NA
## WealthyBlackMen WealthyBlackWomen
## 1 NA NA
## 2 50 NA
## 3 85 NA
## 4 NA NA
## 5 NA NA
## 6 90 NA3. Analysis: Group Variable (Party Registration) x Catergorical Variable #1 ( Charities)
Crosstab
table(VD2019_recoded$WealthCharity,VD2019_recoded$Party) %>%
prop.table(1)##
## Democrat Republican
## Not at all well 0.7763158 0.2236842
## Not very well 0.7611203 0.2388797
## Somewhat well 0.5021349 0.4978651
## Very well 0.2871287 0.7128713Visualization: Stacked Barchart
library(ggplot2)ggplot(VD2019_recoded,aes(x=WealthCharity,fill=Party)) +
geom_bar(position="fill") +
theme_classic() +
theme(plot.title =element_text(hjust=0.5),plot.subtitle=element_text(hjust=0.5)) +
labs(x="Agreement", y="Percent",title="How Well Do You Agree?: Wealthy People Give to Charities", subtitle="Anika Lewis") +
scale_fill_manual ("Party Registration",values =c("Democrat"="blue","Republican"="red"))
Statistical Test: Chi-Square test
chisq.test(VD2019_recoded$WealthCharity,VD2019_recoded$Party)##
## Pearson's Chi-squared test
##
## data: VD2019_recoded$WealthCharity and VD2019_recoded$Party
## X-squared = 290.33, df = 3, p-value < 2.2e-16Interpretation
- There is a significant trend in which republicans are more likely to agree that wealthy people donate to charities. Democrats are more likely to disagree with that statement.
4. Analysis: Group Variable (Party Registration) x Categorical Variable #2 (Create jobs)
Crosstab
table(VD2019_recoded$Wealthjobs,VD2019_recoded$Party) %>%
prop.table(1)##
## Democrat Republican
## Not at all well 0.8914286 0.1085714
## Not very well 0.8116788 0.1883212
## Somewhat well 0.5273973 0.4726027
## Very well 0.2000000 0.8000000Visualization: Stacked Barchart
ggplot(VD2019_recoded,aes(x=Wealthjobs,fill=Party)) +
geom_bar(position="fill") +
theme_classic() +
theme(plot.title =element_text(hjust=0.5),plot.subtitle=element_text(hjust=0.5)) +
labs(x="Agreement", y="Percent",title="How Well Do You Agree?: Wealthy People Create Jobs", subtitle="Anika Lewis")+
scale_fill_manual ("Party Registration",values =c("Democrat"="blue","Republican"="red"))
Statistical Test: Chi-Square test
chisq.test(VD2019_recoded$Wealthjobs,VD2019_recoded$Party)##
## Pearson's Chi-squared test
##
## data: VD2019_recoded$Wealthjobs and VD2019_recoded$Party
## X-squared = 616.75, df = 3, p-value < 2.2e-16Interpretation
- There is a significant trend in which republicans are more likely to agree with the idea that wealthy people create jobs. The democrats are more likely to disagree with this statement.
5. Analysis: Group Variable (Party) x Continuous Variable #1 (White Men)
Table Comparing Means
VD2019_recoded%>%
group_by(Party)%>%
summarize(WealthWhiteMen=mean(WealthyWhiteMen,na.rm=TRUE))## # A tibble: 2 x 2
## Party WealthWhiteMen
## * <chr> <dbl>
## 1 Democrat 36.3
## 2 Republican 60.4Visualization: Bar Chart Comparing Means
VD2019_recoded%>%
filter(Party %in% c("Democrat","Republican"))%>%
group_by(Party)%>%
summarize(WealthyWhiteMen=mean(WealthyWhiteMen,na.rm=TRUE))%>%
ggplot(aes(x=Party,y=WealthyWhiteMen,fill=Party)) +
geom_col() +
theme_classic()+
theme(plot.title =element_text(hjust=0.5),plot.subtitle=element_text(hjust=0.5)) +
labs(x="Party Registration", y="Count",title="Feeling Thermometer: Wealthy White Men", subtitle="Anika Lewis")+
scale_fill_manual ("Party Registration",values =c("Democrat"="blue","Republican"="red"))
Visualization: Histogram comparing population distributions
VD2019_recoded%>%
ggplot(aes(x=WealthyWhiteMen,fill=Party)) +
geom_histogram() +
facet_wrap(~Party) +
theme_classic() +
theme(plot.title =element_text(hjust=0.5),plot.subtitle=element_text(hjust=0.5)) +
labs(x="Feeling Thermometer", y="Count",title="Feeling Thermometer: Wealthy White Men", subtitle="Anika Lewis")+
scale_fill_manual ("Party Registration",values =c("Democrat"="blue","Republican"="red"))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 2767 rows containing non-finite values (stat_bin).
Visualization: Histogram comparing sampling distributions
Demdata<-VD2019_recoded%>%
filter(Party=="Democrat")
Repdata<-VD2019_recoded%>%
filter(Party=="Republican")sample(Demdata$WealthyWhiteMen,40)%>%
mean(na.rm=TRUE)## [1] 29.33333sample(Repdata$WealthyWhiteMen,40)%>%
mean(na.rm=TRUE)## [1] 67.33333replicate(10000,
sample(Demdata$WealthyWhiteMen,40)%>%
mean(na.rm=TRUE)
)%>%
data.frame()%>%
rename("mean"=1) %>%
ggplot()+
geom_histogram(aes(x=mean),fill="blue")+
theme_classic()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 2 rows containing non-finite values (stat_bin).
replicate(10000,
sample(Repdata$WealthyWhiteMen,40)%>%
mean(na.rm=TRUE)
)%>%
data.frame()%>%
rename("mean"=1) %>%
ggplot()+
geom_histogram(aes(x=mean),fill="red")+
theme_classic()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 1 rows containing non-finite values (stat_bin).
Statistical Test: T-test
VD2019_recodedww<-VD2019_recoded%>%
select(Party,WealthyWhiteMen)%>%
filter(Party %in% c("Democrat","Republican"))
head(VD2019_recoded)## Party WealthCharity Wealthjobs WealthyWhiteMen WealthywhiteWomen
## 1 Republican <NA> <NA> NA NA
## 2 Democrat Not very well Not very well NA NA
## 3 Democrat Not very well Not very well NA NA
## 4 Democrat <NA> <NA> NA NA
## 5 Democrat <NA> <NA> NA NA
## 6 Democrat Not very well Not very well NA NA
## WealthyBlackMen WealthyBlackWomen
## 1 NA NA
## 2 50 NA
## 3 85 NA
## 4 NA NA
## 5 NA NA
## 6 90 NAt.test(WealthyWhiteMen~Party,data=VD2019_recoded)##
## Welch Two Sample t-test
##
## data: WealthyWhiteMen by Party
## t = -10.92, df = 596.39, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -28.44641 -19.77399
## sample estimates:
## mean in group Democrat mean in group Republican
## 36.28155 60.39175Interpretation of the results of the above outputs
From the bar chart, I can see that the republicans have a higher average feel (60) towards wealthy white men than democrats (36).
The histogram of population distributions shows me that an overwhelming amount of republicans actually voted around 50, the 60 average is probably because there are also plenty of votes higher than 50,just not as concentrated.The democrats voted overwhelming around 25 but the second highest vote, 50 probably increased the average. Seeing this is quite interesting, despite what the average shows, it seems that a large amount of both republicans and democrats are nuetral in terms of their thoughts on wealthy white men.
The histogram of population sampling distributions agree with the average estimates.The mean of the republican bell curve seems to be a little higher than 60. The mean of the democrat bell curve seems to be around 40.
The t-test tells me that there is a significant correlation within these results.
6. Conclusions - Describe in writing the overall findings of your anlaysis.
- The original goal of this analysis was to examine the differences in democrat and republican sentiments towards wealthy people. The findings overall agreed with what I was expecting, replicans have a more favorable view in terms of wealthy people than democrats on all questions. So,republicans are more likely to agree that wealthy people donate to charity and create jobs than democrats. They also feel more favorably towards wealthy white men in terms of average. But, what surprised me was the distribution of answers in the feel thermometer population histogram. A large amount of both groups felt nuetral about wealthy white men.