Weighting
Next, we categorize variables according to our standard weighting
scheme.
#Define regions to put states in
northeast <- c('Connecticut', 'Maine','Massachusetts', 'New Hampshire', 'New Jersey', 'New York',"Pennsylvania",'Rhode Island', 'Vermont')
midwest <- c("Illinois","Indiana","Iowa", "Kansas", "Michigan", "Minnesota", "Missouri","Nebraska", "North Dakota", "Ohio","South Dakota","Wisconsin")
south <- c("Alabama","Arkansas",'Delaware',"Florida","Georgia","Kentucky","Louisiana","Maryland", "Mississippi","North Carolina","Oklahoma", "South Carolina","Tennessee","Texas","Virginia","West Virginia", 'Washington (District of Columbia)')
west <- c("Alaska","Arizona","California","Colorado","Hawaii","Idaho","Montana","Nevada", "New Mexico", "Oregon","Utah","Washington", "Wyoming")
# Define divisions to put states in
east_north_central<- c("Illinois","Indiana","Michigan", "Ohio","Wisconsin")
east_south_central<- c("Alabama","Kentucky","Mississippi","Tennessee")
middle_atlantic<- c('New Jersey', 'New York',"Pennsylvania")
mountain<- c("Arizona","Colorado","Idaho","Montana","Nevada", "New Mexico", "Utah","Wyoming")
new_england<- c('Connecticut', 'Maine','Massachusetts', 'New Hampshire','Rhode Island', 'Vermont')
pacific<- c("Alaska","California","Hawaii","Oregon","Washington")
south_atlantic<- c('Delaware',"Florida","Georgia","Maryland", "North Carolina","South Carolina","Virginia","West Virginia", 'Washington (District of Columbia)')
west_north_central<- c("Iowa", "Kansas", "Minnesota", "Missouri","Nebraska", "North Dakota", "South Dakota")
west_south_central<- c("Arkansas","Louisiana","Oklahoma", "Texas")
# create demographic groupings
aware_wt <- aware %>%
mutate(age_wt = case_when(age < 25 ~ "18-24",
age< 35 ~ "25-34",
age < 45 ~ "35-44",
age < 55 ~ "45-54",
age < 65 ~ "55-64",
age > 64 ~ "65+"),
age_wt = factor(age_wt,
levels = c("18-24","25-34","35-44", "45-54","55-64", "65+")),
sex_wt = case_when(sex == "Male" ~ "Male",
sex == "Female" ~ "Female"),
sex_wt = factor(sex,
levels = c("Female", "Male")),
male = case_when(sex == "Male" ~ .5,
sex == "Female" ~ -.5),
education_wt = case_when(education == "Some high school" ~ "Less than high school",
education == "Graduated from high school (Diploma/GED or equivalent)" ~ "Graduated from high school",
education == "Some college, no degree" ~ "Some college, no degree",
education == "Completed associates degree" ~ "Some college, no degree",
education == "Completed bachelors degree" ~ "Graduated from college",
education == "Completed masters degree" ~ "Completed graduate school",
education == "Completed professional degree beyond a bachelors degree (e.g., M.D., J.D.)" ~ "Completed graduate school",
education == "Completed doctorate degree" ~ "Completed graduate school"),
education_wt = factor(education_wt,
levels = c('Completed graduate school',
'Graduated from college',
'Some college, no degree',
'Graduated from high school',
'Less than high school')),
income_wt = case_when(income == "Under $15,000" ~ "Under $20,000",
income == "Between $15,000 and $19,999" ~ "Under $20,000",
income == "Between $20,000 and $49,999" ~ "Between $20,000 and $49,999",
income == "Between $50,000 and $74,999" ~ "Between $50,000 and $79,999",
income == "Between $75,000 and $79,999" ~ "Between $50,000 and $79,999",
income == "Between $80,000 and $99,999" ~ "Between $80,000 and $99,999",
income == "Between $100,000 and $150,000" ~ "Between $100,000 and $150,000",
income == "Over $150,000" ~ "Over $150,000"),
income_wt = factor(income_wt,
levels = c("Under $20,000",
"Between $20,000 and $49,999",
"Between $50,000 and $79,999",
"Between $80,000 and $99,999",
"Between $100,000 and $150,000",
"Over $150,000")),
race_wt = case_when(hispanic == "Yes" ~ 'Hispanic or Latino',
grepl('hite', race) == TRUE ~ 'White or Caucasian',
grepl('frican', race) == TRUE ~ 'Black or African American',
grepl('sian', race) == TRUE ~ 'Asian or Asian American',
grepl('two or more', race) == TRUE ~ 'Other',
grepl('ative', race) == TRUE ~ 'Other',
grepl('Other', race) == TRUE ~ 'Other'),
race_wt = factor(race_wt,
levels = c("White or Caucasian",
"Hispanic or Latino",
"Other",
"Black or African American",
"Asian or Asian American")),
region_wt = case_when(region_us %in% midwest == TRUE ~ 'Midwest',
region_us %in% northeast == TRUE ~ 'Northeast',
region_us %in% west == TRUE ~ 'West',
region_us %in% south == TRUE ~ 'South'),
region_wt = factor(region_wt,
levels = c("Northeast",
"Midwest",
"South",
"West")),
division_wt = case_when(region_us %in% east_north_central == TRUE ~ 'East North Central',
region_us %in% east_south_central == TRUE ~ 'East South Central',
region_us %in% middle_atlantic == TRUE ~ 'Middle Atlantic',
region_us %in% mountain == TRUE ~ 'Mountain',
region_us %in% new_england == TRUE ~ 'New England',
region_us %in% pacific == TRUE ~ 'Pacific',
region_us %in% south_atlantic == TRUE ~ 'South Atlantic',
region_us %in% west_north_central == TRUE ~ 'West North Central',
region_us %in% west_south_central == TRUE ~ 'West South Central'),
division_wt = factor(division_wt,
levels = c('East North Central',
'East South Central',
'Middle Atlantic',
'Mountain',
'New England',
'Pacific',
'South Atlantic',
'West North Central',
'West South Central')),
party_wt = case_when(party_raw == "Independent" ~ "Independent",
party_raw == "Democrat" ~ "Democrat",
party_raw == "Republican" ~ "Republican",
party_raw == "Other" ~ "Independent",
party_raw == "Not sure" ~ "Independent"),
party_wt = factor(party_wt,
levels = c("Republican", "Independent", "Democrat")),
bible_wt = case_when(grepl('ancient', bible) ~ "fables",
grepl('inspired', bible) ~ "inspired",
grepl('literal', bible) ~ "literal"),
bible_wt = factor(bible_wt,
levels = c("literal", "inspired", "fables")),
spanking_wt = factor(spanking,
levels = c("Strongly disagree",
"Disagree",
"Agree",
"Strongly agree")),
trust_wt = factor(trust,
levels = c("Can't be too careful", "Can trust people")))
How large are each of the categories on which we are weighting? Small
cells will result in large weights, meaning that a relatively small
number of respondents are standing in for poorly represented subgroups,
and have a relatively large influence on results. The standard errors
increase to offset the chance influence of respondents with large
weights. It is possible to reduce the mean squared error by collapsing
small categories together (Battaglia et al.,
2009). Although treating distinct categories as the same risks
biasing estimates, categories that possess few responses may not possess
sufficient signal to justify such large standard errors. Heuristic
minimums like 50 responses per cell are common. Rather than use some
numerical cut-off, which we suspected would be insufficient for keeping
the design effect manageable, we compared the proportions in the sample
and in the U.S. population. In cases where…
- there were large discrepancies due to the observed category being a
much smaller proportion than in the population,
- the observed category was small, and
- collapsing categories would not induce considerable bias given our
priors about how the weighting variables relate to rodenticide
attitudes
…we collapsed categories.
Below we compare our sample proportions to our weighting targets,
which are based on 2020 American Community Survey 5-year estimates, 2018
and 2021 General Social Survey Data, and Gallup data. For information on
how we created our weighting targets, see WeightingTargets.R.
###compare sample proportions of race to national proportions
race_nr <- matrix(c(0.630, 0.161, 0.0313, 0.120, 0.0573), ncol = 5)
colnames(race_nr)<-c("White or Caucasian", "Hispanic or Latino", "Other",
"Black or African American", "Asian or Asian American")
race_nr<-rbind(table(aware_wt$race_wt)/length(aware_wt$race_wt), race_nr)
row.names(race_nr) <- c("Sample", "National")
race_nr #no need to collapse categories
## White or Caucasian Hispanic or Latino Other
## Sample 0.6751033 0.09555785 0.05061983
## National 0.6300000 0.16100000 0.03130000
## Black or African American Asian or Asian American
## Sample 0.06559917 0.1012397
## National 0.12000000 0.0573000
###compare sample proportions of sex to national proportions
sex_nr <- matrix(c(0.513, 0.487, 0), ncol = 3)
colnames(sex_nr)<-c('Female', 'Male', 'Other identification')
sex_nr<-rbind(table(aware_wt$sex)/length(aware_wt$sex_wt), sex_nr)
row.names(sex_nr) <- c("Sample", "National")
sex_nr #no need to collapse categories, though other identification will be ignored in the weighting because the American Community aware data only has options for Female and Male
## Female Male Other identification
## Sample 0.4896694 0.4865702 0.01188017
## National 0.5130000 0.4870000 0.00000000
###compare sample proportions of age groups to national proportions
age_nr <- matrix(c(0.120, 0.179, 0.164, 0.164, 0.166, 0.207), ncol = 6)
colnames(age_nr)<-c("18-24","25-34","35-44", "45-54","55-64", "65+")
age_nr<-rbind(table(aware_wt$age_wt)/length(aware_wt$age_wt), age_nr)
row.names(age_nr) <- c("Sample", "National")
age_nr #18-24 and 25-34 are considerably over-represented, but this will just result in downweighting. Potentially more problematic is the small percentage of 65+ respondents relative to their population share.
## 18-24 25-34 35-44 45-54 55-64 65+
## Sample 0.1998967 0.3347107 0.2355372 0.1105372 0.07024793 0.03770661
## National 0.1200000 0.1790000 0.1640000 0.1640000 0.16600000 0.20700000
#Since 55-64 is also underrepresented, we collapse the two categories together.
aware_wt$age_co<-as.character(aware_wt$age_wt)
aware_wt$age_co[aware_wt$age_co == "55-64"] <- "55+"
aware_wt$age_co[aware_wt$age_co == "65+"] <- "55+"
aware_wt$age_co = factor(aware_wt$age_co,
levels = c("18-24","25-34","35-44", "45-54","55+"))
###compare sample proportions of educational attainment to national proportions
education_nr <- matrix(c(0.112, 0.190, 0.306, 0.275, 0.116), ncol = 5)
colnames(education_nr)<-c('Completed graduate school', 'Graduated from college',
'Some college, no degree', 'Graduated from high school',
'Less than high school')
education_nr<-rbind(table(aware_wt$education_wt)/length(aware_wt$education_wt), education_nr)
row.names(education_nr) <- c("Sample", "National")
education_nr # Combine lower two categories
## Completed graduate school Graduated from college
## Sample 0.1528926 0.3414256
## National 0.1120000 0.1900000
## Some college, no degree Graduated from high school
## Sample 0.2758264 0.09969008
## National 0.3060000 0.27500000
## Less than high school
## Sample 0.008780992
## National 0.116000000
#collapsing "Graduated from high school" and "Less than high school" into "Less than college"
aware_wt$education_co<-as.character(aware_wt$education_wt)
aware_wt$education_co[aware_wt$education_co == "Graduated from high school"] <- "Less than college"
aware_wt$education_co[aware_wt$education_co == "Less than high school"] <- "Less than college"
aware_wt$education_co = factor(aware_wt$education_co,
levels = c('Completed graduate school',
'Graduated from college',
'Some college, no degree',
'Less than college'))
###compare sample proportions of income bracket to national proportions
income_nr <- matrix(c(0.0965,0.214,0.203,0.110,0.183,0.194), ncol = 6)
colnames(income_nr)<-c('Under $20,000','Between $20,000 and $49,999','Between $50,000 and $79,999','Between $80,000 and $99,999', 'Between $100,000 and $150,000','Over $150,000')
income_nr<-rbind(table(aware_wt$income_wt)/length(aware_wt$income_wt), income_nr)
row.names(income_nr) <- c("Sample", "National")
income_nr #150k+ will likely increase design effect, but the issue is not severe.
## Under $20,000 Between $20,000 and $49,999 Between $50,000 and $79,999
## Sample 0.106405 0.213843 0.2246901
## National 0.096500 0.214000 0.2030000
## Between $80,000 and $99,999 Between $100,000 and $150,000
## Sample 0.1095041 0.1410124
## National 0.1100000 0.1830000
## Over $150,000
## Sample 0.08316116
## National 0.19400000
###compare sample divisions to national proportions
division_nr <- matrix(c(0.144,0.0584,0.128,0.0740,0.0470,0.163,0.202,0.0646,0.119), ncol = 9)
colnames(division_nr)<-c('East North Central',
'East South Central',
'Middle Atlantic',
'Mountain',
'New England',
'Pacific',
'South Atlantic',
'West North Central',
'West South Central')
division_nr<-rbind(table(aware_wt$division_wt)/length(aware_wt$division_wt), division_nr)
row.names(division_nr) <- c("Sample", "National")
division_nr #looks good
## East North Central East South Central Middle Atlantic Mountain
## Sample 0.1451446 0.05268595 0.1198347 0.0588843
## National 0.1440000 0.05840000 0.1280000 0.0740000
## New England Pacific South Atlantic West North Central
## Sample 0.04338843 0.1399793 0.1802686 0.0464876
## National 0.04700000 0.1630000 0.2020000 0.0646000
## West South Central
## Sample 0.09194215
## National 0.11900000
##We wouldn't collapse party affiliation together, so we don't examine sample-national comparison here.
###compare sample proportions of bible interpretation to national proportions
bible_nr <- matrix(c(0.310, 0.473, 0.217), ncol = 3)
colnames(bible_nr)<-c("literal", "inspired", "fables")
bible_nr<-rbind(table(aware_wt$bible_wt)/length(aware_wt$bible_wt), bible_nr)
row.names(bible_nr) <- c("Sample", "National")
bible_nr # need to combine literal and inspired. belief that bible stories are fables will be heavily downweighted.
## literal inspired fables
## Sample 0.06508264 0.3083678 0.5051653
## National 0.31000000 0.4730000 0.2170000
#collapsing "bible" into "believe" (literal, inspired) and "fables"
aware_wt$bible_co<-as.character(aware_wt$bible_wt)
aware_wt$bible_co[aware_wt$bible_co == "literal"] <- "believe"
aware_wt$bible_co[aware_wt$bible_co == "inspired"] <- "believe"
aware_wt$bible_co = factor(aware_wt$bible_co,
levels = c("believe",
"fables"))
###compare sample proportions of spanking attitudes to national proportions
spanking_nr <- matrix(c(0.170, 0.308, 0.364, 0.158), ncol = 4)
colnames(spanking_nr)<-c("Strongly disagree","Disagree","Agree","Strongly agree")
spanking_nr<-rbind(table(aware_wt$spanking_wt)/length(aware_wt$spanking_wt), spanking_nr)
row.names(spanking_nr) <- c("Sample", "National")
spanking_nr #combine into disagree and agree: "strongly agree" category is poorly represented
## Strongly disagree Disagree Agree Strongly agree
## Sample 0.3341942 0.3119835 0.2019628 0.03047521
## National 0.1700000 0.3080000 0.3640000 0.15800000
# collapsing "spanking" into agree and disagree
aware_wt$spanking_co<-as.character(aware_wt$spanking_wt)
aware_wt$spanking_co[aware_wt$spanking_co == "Strongly disagree"] <- "Disagree"
aware_wt$spanking_co[aware_wt$spanking_co == "Strongly agree"] <- "Agree"
aware_wt$spanking_co = factor(aware_wt$spanking_co,
levels = c("Disagree",
"Agree"))
###compare sample proportions of generalized trust to national proportions
trust_nr <- matrix(c(0.669, 0.331), ncol = 2)
colnames(trust_nr)<-c("Can't be too careful", "Can trust people")
trust_nr<-rbind(table(aware_wt$trust_wt)/length(aware_wt$trust_wt), trust_nr)
row.names(trust_nr) <- c("Sample", "National")
trust_nr #no need to collapse categories
## Can't be too careful Can trust people
## Sample 0.5501033 0.3285124
## National 0.6690000 0.3310000
Next, we set up the weighting categories. In cases where we collapsed
categories, we comment out the original categories and replace them with
the new categories. But first, we compute the only novel weighting
target for the present study: party affiliation.
#party affiliation data
# https://news.gallup.com/poll/15370/party-affiliation.aspx
# Following the advice of Jamie Elsey, I will average across data from the past 6 months.
#Republicans Independents Democrats
#2022 Oct 3-20 33 35 29
#2022 Sep 1-16 30 43 24
#2022 Aug 1-23 24 43 30
#2022 Jul 5-26 28 41 29
#2022 Jun 1-20 27 43 27
#2022 May 2-22 29 39 31
republican_share<-mean(c(33,30, 24, 28, 27, 29))
independent_share<-mean(c(35, 43, 43, 41, 43, 39))
democrat_share<-mean(c(29,24, 30, 29, 27, 31))
gallup_party <- tibble(answer = c("Republican", "Independent", "Democrat"),
number = c(republican_share, independent_share, democrat_share)) # note that some respondents did not identify with a party, so we need to divide by those who did.
gallup_party <-
gallup_party %>%
mutate(proportion = number / sum(gallup_party$number))
gallup_party # print
target <- list(
race_wt = wpct(c("White or Caucasian", "Hispanic or Latino", "Other",
"Black or African American", "Asian or Asian American"),
c(0.630, 0.161, 0.0313, 0.120, 0.0573)),
sex_wt = wpct(c('Female', 'Male'),
c(0.513, 0.487)),
# age_wt = wpct(c("18-24","25-34","35-44", "45-54","55-64", "65+"),
# c(0.120, 0.179, 0.164, 0.164, 0.166, 0.207)),
age_co = wpct(c("18-24","25-34","35-44", "45-54","55+"),
c(0.120, 0.179, 0.164, 0.164, 0.373)),
# education_wt = wpct(c('Completed graduate school', 'Graduated from college',
# 'Some college, no degree', 'Graduated from high school',
# 'Less than high school'),
# c(0.112, 0.190, 0.306, 0.275, 0.116)),
education_co = wpct(c('Completed graduate school', 'Graduated from college',
'Some college, no degree', 'Less than college'),
c(0.112, 0.190, 0.306, 0.391)),#combining Graduated from high school and Less than high school
income_wt = wpct(c('Under $20,000',
'Between $20,000 and $49,999',
'Between $50,000 and $79,999',
'Between $80,000 and $99,999',
'Between $100,000 and $150,000',
'Over $150,000'),
c(0.0965,
0.214,
0.203,
0.110,
0.183,
0.194)),
division_wt = wpct(c('East North Central',
'East South Central',
'Middle Atlantic',
'Mountain',
'New England',
'Pacific',
'South Atlantic',
'West North Central',
'West South Central'),
c(0.144,
0.0584,
0.128,
0.0740,
0.0470,
0.163,
0.202,
0.0646,
0.119)),
party_wt = wpct(c("Republican", "Independent", "Democrat"),
c(0.2923077, 0.4170940, 0.2905983)),
#spanking_wt = wpct(c("Strongly disagree",
# "Disagree",
# "Agree",
# "Strongly agree"),
# c(0.170,
# 0.308,
# 0.364,
# 0.158)),
spanking_co = wpct(c("Disagree",
"Agree"),
c(0.478, 0.522)), # Combining "Strongly Disagree" with "Disagree" and "Agree" and "Strongly agree"
#bible_wt = wpct(c("literal", "inspired", "fables"),
# c(0.310, 0.473, 0.217)),
bible_co = wpct(c("believe", "fables"), # combining "literal" and "inspired" into "believe".
c(0.783, 0.217)),
trust_wt = wpct(c("Can't be too careful", "Can trust people"),
c(0.669, 0.331)))
Finally, it is time to create the sampling weights. We capped the
weights at 12 because that was the lowest cap we could use while still
having the algorithm converge without issues. The design effect is
4.91.
aware_wt$id <- 1:nrow(aware_wt)
aware_wt_raking <- anesrake(inputter = target,
data = as.data.frame(aware_wt),
caseid = aware_wt$id,
cap = 12, # Maximum allowed weight per iteration. Trying to find the smallest number we can while achieving convergence
choosemethod = "total", # How are parameters compared for selection?
type = "pctlim", # What selection criterion is used?
pctlim = 0.05, # Threshold for selection, currently at 5% diff between sample and target
nlim = 15,
maxit = 10000,
force1 = TRUE)
## [1] "Raking converged in 57 iterations"
## [1] "Raking converged in 59 iterations"
summary(aware_wt_raking) #design effect of 4.91
## $convergence
## [1] "Complete convergence was achieved after 59 iterations"
##
## $base.weights
## [1] "No Base Weights Were Used"
##
## $raking.variables
## [1] "race_wt" "age_co" "education_co" "income_wt" "division_wt"
## [6] "party_wt" "spanking_co" "bible_co" "trust_wt" "sex_wt"
##
## $weight.summary
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.008433 0.095645 0.306637 1.000000 0.900958 12.000077
##
## $selection.method
## [1] "variable selection conducted using _pctlim_ - discrepancies selected using _total_."
##
## $general.design.effect
## [1] 4.916562
##
## $race_wt
## Target Unweighted N Unweighted % Wtd N
## White or Caucasian 0.63025210 1307 0.68322007 1204.02888
## Hispanic or Latino 0.16106443 185 0.09670674 307.69627
## Other 0.03131253 98 0.05122844 59.81921
## Black or African American 0.12004802 127 0.06638787 229.33883
## Asian or Asian American 0.05732293 196 0.10245687 109.50929
## Total 1.00000000 1913 1.00000000 1910.39249
## Wtd % Change in % Resid. Disc. Orig. Disc.
## White or Caucasian 0.63025210 -0.05296797 -1.110223e-16 -0.05296797
## Hispanic or Latino 0.16106443 0.06435768 2.775558e-17 0.06435768
## Other 0.03131253 -0.01991591 6.938894e-18 -0.01991591
## Black or African American 0.12004802 0.05366015 4.163336e-17 0.05366015
## Asian or Asian American 0.05732293 -0.04513394 6.938894e-18 -0.04513394
## Total 1.00000000 0.23603566 1.942890e-16 0.23603566
##
## $sex_wt
## Target Unweighted N Unweighted % Wtd N Wtd % Change in %
## Female 0.513 948 0.5015873 974.8259 0.513 0.0114127
## Male 0.487 942 0.4984127 925.4195 0.487 -0.0114127
## Total 1.000 1890 1.0000000 1900.2454 1.000 0.0228254
## Resid. Disc. Orig. Disc.
## Female 0 0.0114127
## Male 0 -0.0114127
## Total 0 0.0228254
##
## $age_co
## Target Unweighted N Unweighted % Wtd N Wtd % Change in % Resid. Disc.
## 18-24 0.120 387 0.2021944 229.3318 0.120 -0.08219436 0.000000e+00
## 25-34 0.179 648 0.3385580 342.0867 0.179 -0.15955799 0.000000e+00
## 35-44 0.164 456 0.2382445 313.4202 0.164 -0.07424451 0.000000e+00
## 45-54 0.164 214 0.1118077 313.4202 0.164 0.05219227 2.775558e-17
## 55+ 0.373 209 0.1091954 712.8398 0.373 0.26380460 0.000000e+00
## Total 1.000 1914 1.0000000 1911.0986 1.000 0.63199373 2.775558e-17
## Orig. Disc.
## 18-24 -0.08219436
## 25-34 -0.15955799
## 35-44 -0.07424451
## 45-54 0.05219227
## 55+ 0.26380460
## Total 0.63199373
##
## $education_co
## Target Unweighted N Unweighted % Wtd N
## Completed graduate school 0.1121121 296 0.1740153 193.9322
## Graduated from college 0.1901902 661 0.3885949 328.9921
## Some college, no degree 0.3063063 534 0.3139330 529.8504
## Less than college 0.3913914 210 0.1234568 677.0311
## Total 1.0000000 1701 1.0000000 1729.8059
## Wtd % Change in % Resid. Disc. Orig. Disc.
## Completed graduate school 0.1121121 -0.061903173 0.000000e+00 -0.061903173
## Graduated from college 0.1901902 -0.198404754 -2.775558e-17 -0.198404754
## Some college, no degree 0.3063063 -0.007626674 0.000000e+00 -0.007626674
## Less than college 0.3913914 0.267934601 0.000000e+00 0.267934601
## Total 1.0000000 0.535869203 2.775558e-17 0.535869203
##
## $income_wt
## Target Unweighted N Unweighted % Wtd N
## Under $20,000 0.09645177 206 0.12110523 166.8428
## Between $20,000 and $49,999 0.21389305 414 0.24338624 369.9935
## Between $50,000 and $79,999 0.20289855 435 0.25573192 350.9751
## Between $80,000 and $99,999 0.10994503 212 0.12463257 190.1836
## Between $100,000 and $150,000 0.18290855 273 0.16049383 316.3963
## Over $150,000 0.19390305 161 0.09465021 335.4146
## Total 1.00000000 1701 1.00000000 1729.8059
## Wtd % Change in % Resid. Disc. Orig. Disc.
## Under $20,000 0.09645177 -0.02465346 0.000000e+00 -0.02465346
## Between $20,000 and $49,999 0.21389305 -0.02949319 0.000000e+00 -0.02949319
## Between $50,000 and $79,999 0.20289855 -0.05283337 0.000000e+00 -0.05283337
## Between $80,000 and $99,999 0.10994503 -0.01468754 0.000000e+00 -0.01468754
## Between $100,000 and $150,000 0.18290855 0.02241472 5.551115e-17 0.02241472
## Over $150,000 0.19390305 0.09925284 -2.775558e-17 0.09925284
## Total 1.00000000 0.24333512 8.326673e-17 0.24333512
##
## $division_wt
## Target Unweighted N Unweighted % Wtd N Wtd %
## East North Central 0.1440 281 0.16519694 249.09204 0.1440
## East South Central 0.0584 102 0.05996473 101.02066 0.0584
## Middle Atlantic 0.1280 232 0.13639036 221.41515 0.1280
## Mountain 0.0740 114 0.06701940 128.00563 0.0740
## New England 0.0470 84 0.04938272 81.30088 0.0470
## Pacific 0.1630 271 0.15931805 281.95835 0.1630
## South Atlantic 0.2020 349 0.20517343 349.42078 0.2020
## West North Central 0.0646 90 0.05291005 111.74546 0.0646
## West South Central 0.1190 178 0.10464433 205.84690 0.1190
## Total 1.0000 1701 1.00000000 1729.80585 1.0000
## Change in % Resid. Disc. Orig. Disc.
## East North Central -0.021196943 0.000000e+00 -0.021196943
## East South Central -0.001564727 -1.387779e-17 -0.001564727
## Middle Atlantic -0.008390359 0.000000e+00 -0.008390359
## Mountain 0.006980600 0.000000e+00 0.006980600
## New England -0.002382716 0.000000e+00 -0.002382716
## Pacific 0.003681952 -2.775558e-17 0.003681952
## South Atlantic -0.003173427 0.000000e+00 -0.003173427
## West North Central 0.011689947 0.000000e+00 0.011689947
## West South Central 0.014355673 0.000000e+00 0.014355673
## Total 0.073416343 4.163336e-17 0.073416343
##
## $party_wt
## Target Unweighted N Unweighted % Wtd N Wtd % Change in %
## Republican 0.2923077 263 0.1546149 505.6356 0.2923077 0.13769277
## Independent 0.4170940 558 0.3280423 721.4916 0.4170940 0.08905167
## Democrat 0.2905983 880 0.5173427 502.6786 0.2905983 -0.22674444
## Total 1.0000000 1701 1.0000000 1729.8059 1.0000000 0.45348888
## Resid. Disc. Orig. Disc.
## Republican 5.551115e-17 0.13769277
## Independent -1.110223e-16 0.08905167
## Democrat 0.000000e+00 -0.22674444
## Total 1.665335e-16 0.45348888
##
## $spanking_co
## Target Unweighted N Unweighted % Wtd N Wtd % Change in %
## Disagree 0.478 1251 0.7354497 826.8472 0.478 -0.2574497
## Agree 0.522 450 0.2645503 902.9587 0.522 0.2574497
## Total 1.000 1701 1.0000000 1729.8059 1.000 0.5148995
## Resid. Disc. Orig. Disc.
## Disagree 5.551115e-17 -0.2574497
## Agree 0.000000e+00 0.2574497
## Total 5.551115e-17 0.5148995
##
## $bible_co
## Target Unweighted N Unweighted % Wtd N Wtd % Change in %
## believe 0.783 723 0.4250441 1354.4380 0.783 0.3579559
## fables 0.217 978 0.5749559 375.3679 0.217 -0.3579559
## Total 1.000 1701 1.0000000 1729.8059 1.000 0.7159118
## Resid. Disc. Orig. Disc.
## believe 1.110223e-16 0.3579559
## fables 0.000000e+00 -0.3579559
## Total 1.110223e-16 0.7159118
##
## $trust_wt
## Target Unweighted N Unweighted % Wtd N Wtd %
## Can't be too careful 0.669 1065 0.6261023 1157.2401 0.669
## Can trust people 0.331 636 0.3738977 572.5657 0.331
## Total 1.000 1701 1.0000000 1729.8059 1.000
## Change in % Resid. Disc. Orig. Disc.
## Can't be too careful 0.04289771 1.110223e-16 0.04289771
## Can trust people -0.04289771 0.000000e+00 -0.04289771
## Total 0.08579541 1.110223e-16 0.08579541
#attach weights to dataset
aware_wt$weight <- aware_wt_raking$weightvec
aware_wt<- dplyr::select(aware_wt, -c("Location Latitude", "Location Longitude", "prolific_id","IP Address")) # drop personally identifiable information
fwrite(aware_wt, "rodenticide_awareness_12_08_2022.csv") # save dataset with weights
Benchmarking
When there are discrepancies between weighted and unweighted
estimates, how much more should we trust the weighted estimates? On the
face of it, the weighted analyses should be much more trustworthy, as we
know that distributions of the demographic variables that we weighted on
match the distributions of United States adults. On the other hand,
there may be other variables we did not weight on that better explain
why our unweighted sample would return different estimates than a random
sample. Furthermore, the raking procedure we used to create the weights
does not account for any potential interactions among the weighting
variables.
One imperfect way of testing how much weighting helped us achieve a
representative sample is to benchmark a sample estimate against another,
arguably more trustworthy estimate. We asked respondents whether they
approved of Joe Biden’s performance as President, and compared our
unweighted and weighted estimates to FiveThirtyEight’s estimate. There
is some uncertainty about how best to do this, given that we asked about
approval during the re-survey, which was run during a different time
than the original survey. In the absence of some obviously better
solution, we average the approval rate among adults from data collected
between September 22 and November 10, the time period encapsulating both
the original survey and the re-survey.
This is an imperfect test: FiveThirtyEight’s estimate may itself be
biased, and the biases that affect estimation of presidential job
approval may differ from the biases that affect estimation of
rodenticide attitudes. Nevertheless, benchmarking against presidential
job approval does provide one external indicator of how our weighted
sample likely differs in its attitudes from the U.S. as a whole.
The outcome of this exercise is mixed. The weighted analyses bring
sample’s disapproval rating of Biden from 17 percentage points below
FiveThirtyEight’s estimate to less than two percentage points above it.
The weighted analyses slightly reduce the estimates of “Don’t know”
below FiveThirtyEight’s estimate, but the difference between the
weighted and unweighted estimates are minor. Unfortunately, weighting
more than doubles the absolute discrepancy between the sample and
FiveThirtyEight for the approval estimate, overcorrecting for the
sample’s enthusiasm for Biden’s performance relative to the country as a
whole.
#create biden approval/disapproval/don't know variable
aware_wt$biden[aware_wt$pres_approve_nonbin == "Somewhat approve"] <- "Approve"
## Warning: Unknown or uninitialised column: `biden`.
aware_wt$biden[aware_wt$pres_approve_nonbin == "Strongly approve"] <- "Approve"
aware_wt$biden[aware_wt$pres_approve_nonbin == "Somewhat disapprove"] <- "Disapprove"
aware_wt$biden[aware_wt$pres_approve_nonbin == "Strongly disapprove"] <- "Disapprove"
aware_wt$biden[aware_wt$pres_approve_nonbin == "Don't know / No opinion"] <- "DK"
#sampling design
sample_design = svydesign(ids=~1,#no clustering
weights=~weight,
data=aware_wt)
fivethirtyeight<- fread("approval_topline.csv ")
fivethirtyeight<-subset(fivethirtyeight, subgroup == "Adults")
fivethirtyeight$modeldate<-as.Date(fivethirtyeight$modeldate, "%m/%d/%Y")
fivethirtyeight <- fivethirtyeight %>%
filter(modeldate >= as.Date('2022-09-22') & modeldate <= as.Date('2022-11-10'))
approve<-mean(fivethirtyeight$approve_estimate)/100
disapprove<-mean(fivethirtyeight$disapprove_estimate)/100
no_opinion<-1-approve-disapprove
president_nr <- matrix(c(approve,disapprove,no_opinion), ncol = 3)
president_nrb<-rbind(president_nr,table(aware_wt$biden)/length(aware_wt$biden), svytable(~biden, sample_design)/length(aware_wt$biden))
president_nrb<- rbind(president_nrb, president_nrb[2, ] - president_nrb[1, ])
president_nrb<- rbind(president_nrb, president_nrb[3, ] - president_nrb[1, ])
row.names(president_nrb) <- c("FiveThirtyEight", "Unweighted", "Weighted","Unweighted Discrepancy" , "Weighted Discrepancy")
president_nrb #point estimates from unweighted, weighted, and FiveThirtyEight Estimates
## Approve Disapprove DK
## FiveThirtyEight 0.40545360 0.52899121 0.065555184
## Unweighted 0.45506198 0.35537190 0.068181818
## Weighted 0.28794080 0.54700186 0.058552096
## Unweighted Discrepancy 0.04960838 -0.17361931 0.002626634
## Weighted Discrepancy -0.11751280 0.01801065 -0.007003088
rm(fivethirtyeight)
So, it is not clear that our weighted analyses are ultimately less
biased than our unweighted analyses. The main difference is that the
weighted analyses markedly upweight the responses of those who do not
approve of Biden. Insofar we as suspect that opposition to rodenticide
use is more common among the political left (which would be consistent
with other areas of animal welfare; e.g., see McKendree et al.,
2014), we can at least be confident that our weighted estimates are
not overestimating support for anti-rodenticide legislation.
Now let’s upload the manual coding and attach it to the weighted
dataset. Hannah McKay conducted the evaluations. Annabel Rayner flagged
certain evaluations that she thought should be coded differently, which
Hannah and I resolved through discussion. From this point on we use the
de-identified version so that readers can reproduce the results; that
is, we deleted Prolific IDs, IP addresses, and lat/long coordinates.
heardof<- fread("final_awareness_study_coding.csv")
heardof<-dplyr::select(heardof, c("Response ID", "Primary exposure for children","Primary and/or secondary exposure to Pets", "Secondary exposure in wildlife predators","Inhumane to rodents", "Cause resistance or neophobia","Environmental pollution/Public Health","Other Methods Suffice","Die in walls/hard to reach places", "Other"))
aware_full<-left_join(aware_wt ,heardof, by = "Response ID")
rm(heardof)
####create demographic variables to look at subgroups
#create binary have/don't have children in home
aware_full$children<-as.numeric(aware_full$`How many children (i.e., people less than 18 years old) live in your household? - Number of children`)
aware_full$children<-ifelse(aware_full$children >0 , 1, 0)
#create binary have/don't have animals
aware_full$animals_1<-as.numeric(aware_full$`Please indicate the number of each animal you
currently have in your household. - Birds`)
aware_full$animals_2<-as.numeric(aware_full$`Please indicate the number of each animal you
currently have in your household. - Cats`)
aware_full$animals_3<-as.numeric(aware_full$`Please indicate the number of each animal you
currently have in your household. - Dogs`)
aware_full$animals_4<-as.numeric(aware_full$`Please indicate the number of each animal you
currently have in your household. - Other`)
aware_full$animals<-rowSums(cbind(aware_full$animals_1,aware_full$animals_1,aware_full$animals_1,aware_full$animals_4), na.rm = TRUE)
aware_full$animals<-ifelse(aware_full$animals >0 , 1, 0)
#create binary variable for use of pest control
aware_full$pestcontrol<- ifelse(aware_full$`In the past 10 years, have you (or your property manager) ever hired a pest manager to remove rats or mice from your home or business?` == "Yes"|aware_full$`In the past 10 years, have you ever taken any action on your own to remove rats or mice from your home or business?` == "Yes", 1, 0)
###change column names of reasons against rodenticide use from the actual wording to something short
names(aware_full)[names(aware_full) == 'Now we ask you to report reasons for opposing rodenticide use. You will be able to report up to five reasons for opposing rodenticide use, but it is entirely OK if you have heard of fewer or no reasons for opposing rodenticide. If you have heard of more than five reasons for opposing rodenticide, just report the first five that you recall.
Start by reporting one reason you can recall against rodenticide use using the text box below. After that, we will ask you if you have any additional reasons against rodenticide use to report, and if not we will move on to the next part of the study. Remember that you should only report reasons you were aware of BEFORE the study started. If you have not heard of any reasons against rodenticide use, just write "N/A" in the text box.'] <- "firstreasonagainst"
names(aware_full)[names(aware_full) == 'Use the text box below to report a second reason you can recall against rodenticide use. After that, we will ask you if you have any additional reasons against rodenticide use to report, and if not we will move on to the next part of the study. Remember that you should only report reasons you were aware of BEFORE the study started. If you have not heard of any reasons against rodenticide use (i.e., you navigated to this page by mistake), just write "N/A" in the text box.'] <- "secondreasonagainst"
names(aware_full)[names(aware_full) == 'Use the text box below to report a third reason you can recall against rodenticide use. After that, we will ask you if you have any additional reasons against rodenticide use to report, and if not we will move on to the next part of the study. Remember that you should only report reasons you were aware of BEFORE the study started. If you have not heard of any reasons against rodenticide use (i.e., you navigated to this page by mistake), just write "N/A" in the text box.'] <- "thirdreasonagainst"
names(aware_full)[names(aware_full) == 'Use the text box below to report a fourth reason you can recall against rodenticide use. After that, we will ask you if you have any additional reasons against rodenticide use to report, and if not we will move on to the next part of the study. Remember that you should only report reasons you were aware of BEFORE the study started. If you have not heard of any reasons against rodenticide use (i.e., you navigated to this page by mistake), just write "N/A" in the text box.'] <- "fourthreasonagainst"
names(aware_full)[names(aware_full) == 'Use the text box below to report a fifth reason you can recall against rodenticide use. After that, we will move to the next part of the study. (If you have more than one reason left to report, just report whichever reason you thought of first.) Remember that you should only report reasons you were aware of BEFORE the study started. If you have not heard of any reasons against rodenticide use (i.e., you navigated to this page by mistake), just write "N/A" in the text box.'] <- "fifthreasonagainst"
names(aware_full)[names(aware_full) == 'In the past 10 years, have you (or your property manager) ever hired a pest manager to remove rats or mice from your home or business?'] <- "pro_pestmanagement"
names(aware_full)[names(aware_full) == 'In the past 10 years, have you ever taken any action on your own to remove rats or mice from your home or business?'] <- "diy_pestmanagement"
#sampling design
sample_design = svydesign(ids=~1,#no clustering
weights=~weight,
data=aware_full)
##about 20% of the weighted sample has had professional pest management for rodent problems in the past 10 years
##about 56% of the weighted sample has done DIY pest pest management for rodents in the past 10 years.
prop.table(svytable(~ pro_pestmanagement + diy_pestmanagement, sample_design))
## diy_pestmanagement
## pro_pestmanagement No Yes
## No 0.35732842 0.42446073
## Yes 0.06904471 0.14916614
Results
Many respondents gave responses that were not specific enough for us
to confidently determine whether or not they had heard of a particular
argument before. Due to the nature of the study, there was not an
opportunity for clarification. So we coded “Y” for knowledge of an
argument using a strict criterion (that they clearly articulated a
particular argument that we coded for), “M” for a looser criterion (that
they may have articulated a particular argument we coded for, but may
have also just been gesturing towards a similar, general consideration),
and “N” for a clear lack of knowledge. The benefit of the stricter
criterion is that we avoid the possibility of granting knowledge when
people are not actually aware of the specific argument we are interested
in. The benefit of the looser criterion is that we do not penalize
respondents merely for being less articulate or insufficiently
incentivized to provide a clearer response.
We feel that even our strict criterion is pretty loose, and so we
suspect that our “loose” estimates are upper-bound estimates of the true
prevalence of knowledge of a given anti-rodenticide argument. To get a
feel for what sorts of arguments were coded as “Y” or “M”, we list up to
20 examples of each for each argument below. Note that respondents were
provided opportunities to provide up to 5 reasons against rodenticide
that had heard of, one at a time. Hence, there are five columns with
open-ended responses, and respondents varied in how many columns they
used. This is not only because different respondents had heard of
different numbers of anti-rodenticide arguments, but also because
respondents often provided more than one argument in each text box.
Thus, we display all five columns. In the vast majority of cases it
should be clear which argument we coded as “M” or “Y” for a particular
respondent.
Primary Exposure Risk to Children
####Display examples
aware_children<- dplyr::select(aware_full, c("Primary exposure for children", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_children[aware_children$`Primary exposure for children` == "Y",],20)
##Examples of loose coding
head(aware_children[aware_children$`Primary exposure for children` == "M",],20)
About 15% of respondents said that rodenticides pose a risk to
children because they could eat the rodenticide. Beyond widening the
confidence intervals, weighting the data had no qualitative effect on
the estimates, and loose vs. strict coding also has minimal effect.
##Primary exposure for children
children_strict_weighted<-svyciprop(~I(`Primary exposure for children` == "Y"), sample_design)
children_strict_weighted<-cbind(children_strict_weighted[1], confint(children_strict_weighted)[1],confint(children_strict_weighted)[2])
children_loose_weighted<-svyciprop(~I(`Primary exposure for children` == "Y"|`Primary exposure for children` == "M"), sample_design)
children_loose_weighted<-cbind(children_loose_weighted[1], confint(children_loose_weighted)[1],confint(children_loose_weighted)[2])
# [1] = M, [2] = N, [3] = Y
children_strict_unweighted<-prop.test(table(aware_full$`Primary exposure for children`)[3], table(aware_full$`Primary exposure for children`)[1]+ table(aware_full$`Primary exposure for children`)[2]+table(aware_full$`Primary exposure for children`)[3])
children_strict_unweighted<-c(children_strict_unweighted$estimate, children_strict_unweighted$conf.int) #mean, LCL, UCL
children_loose_unweighted<-prop.test(table(aware_full$`Primary exposure for children`)[1]+table(aware_full$`Primary exposure for children`)[3], table(aware_full$`Primary exposure for children`)[1]+ table(aware_full$`Primary exposure for children`)[2]+table(aware_full$`Primary exposure for children`)[3])
children_loose_unweighted<-c(children_loose_unweighted$estimate, children_loose_unweighted$conf.int) #mean, LCL, UCL
prop_children_aware<-rbind(children_strict_weighted, children_strict_unweighted, children_loose_weighted, children_loose_unweighted)
colnames(prop_children_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_children_aware)<- c("Strict, Weighted", "Strict, Unweighted", "Loose, Weighted", "Loose, Unweighted")
round((prop_children_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 14.9 11.9 18.6
## Strict, Unweighted 14.6 13.0 16.2
## Loose, Weighted 15.9 12.7 19.7
## Loose, Unweighted 14.7 13.2 16.4
Respondents with at least one child in the household were
significantly more likely to have heard about the primary exposure risk
of rodenticide to children under the loose criterion, but this pattern
was (non-significantly) reversed for the strict criterion. It makes
sense to target parents with rodenticide efforts, as they presumably
have a stronger incentive to care about the risk to children of primary
exposure, and they are by and large not already receiving this
information.
childtable<-svychisq(~`Primary exposure for children`+children, sample_design)
prop.table(childtable$observed, 2) #the proportion of respondents with knowledge of primary risk exposure to children, broken down by whether respondents have at least one child in the household.
## children
## Primary exposure for children 0 1
## M 0.00000000 0.02516221
## N 0.84902659 0.82739382
## Y 0.15097341 0.14744397
childtable$stdres # standardized residuals greater than ~2 indicate a statistically significant difference
## children
## Primary exposure for children 0 1
## M -5.5660915 5.5660915
## N 1.2567537 -1.2567537
## Y 0.2101627 -0.2101627
Primary and/or Secondary Exposure Risk to Pets
####Display examples
aware_pets<- dplyr::select(aware_full, c("Primary and/or secondary exposure to Pets", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_pets[aware_pets$`Primary and/or secondary exposure to Pets` == "Y",],20)
##Examples of loose coding
head(aware_pets[aware_pets$`Primary and/or secondary exposure to Pets` == "M",],20)
There is relatively high awareness that rodenticides pose either a
primary or secondary exposure threat to pets. This result may be in part
to collapsing awareness of primary exposure risk and awareness of
secondary exposure risk together. Alternatively, perhaps veterinarians
are routinely telling their clients to be on the outlook for
rodenticide. We can test this hypothesis by breaking down the results by
whether respondents have a pet.
pets_strict_weighted<-svyciprop(~I(`Primary and/or secondary exposure to Pets`
== "Y"), sample_design)
pets_strict_weighted<-cbind(pets_strict_weighted[1], confint(pets_strict_weighted)[1],confint(pets_strict_weighted)[2])
pets_loose_weighted<-svyciprop(~I(`Primary and/or secondary exposure to Pets`
== "Y"|`Primary and/or secondary exposure to Pets` == "M"),
sample_design)
pets_loose_weighted<-cbind(pets_loose_weighted[1], confint(pets_loose_weighted)[1],confint(pets_loose_weighted)[2])
pets_strict_unweighted<-prop.test(table(aware_full$`Primary and/or secondary exposure to Pets`)[3], table(aware_full$`Primary and/or secondary exposure to Pets`)[1]+
table(aware_full$`Primary and/or secondary exposure to Pets`)[2]+table(aware_full$`Primary and/or secondary exposure to Pets`)[3])
pets_strict_unweighted<-c(pets_strict_unweighted$estimate, pets_strict_unweighted$conf.int)
#mean, LCL, UCL
pets_loose_unweighted<-prop.test(table(aware_full$`Primary and/or secondary exposure to Pets`)[1]+table(aware_full$`Primary and/or secondary exposure to Pets`)[3],
table(aware_full$`Primary and/or secondary exposure to Pets`)[1]+ table(aware_full$`Primary and/or secondary exposure to Pets`)[2]+table(aware_full$`Primary and/or secondary exposure to Pets`)[3])
pets_loose_unweighted<-c(pets_loose_unweighted$estimate,
pets_loose_unweighted$conf.int) #mean, LCL, UCL
prop_pets_aware<-rbind(pets_strict_weighted, pets_strict_unweighted,
pets_loose_weighted, pets_loose_unweighted)
colnames(prop_pets_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_pets_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_pets_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 24.8 20.8 29.2
## Strict, Unweighted 24.6 22.7 26.6
## Loose, Weighted 25.0 21.1 29.4
## Loose, Unweighted 24.8 22.9 26.8
There is statistically significant evidence that pet owners are more
likely to have heard about the risks rodenticide pose to pets under the
loose criterion, but not the strict criterion.
pettable<-svychisq(~`Primary and/or secondary exposure to Pets`+animals, sample_design)
prop.table(pettable$observed, 2) #the proportion of respondents with knowledge of risk of rodenticide exposure to pets, broken down by whether respondents have at least one pet.
## animals
## Primary and/or secondary exposure to Pets 0 1
## M 0.0002447765 0.0128403489
## N 0.7528091681 0.7351541873
## Y 0.2469460553 0.2520054638
pettable$stdres # standardized residuals greater than ~2 indicate a statistically significant difference
## animals
## Primary and/or secondary exposure to Pets 0 1
## M -4.2616096 4.2616096
## N 0.6800653 -0.6800653
## Y -0.1955257 0.1955257
Secondary Exposure Risk to Wildlife
####Display examples
aware_wild<- dplyr::select(aware_full, c("Secondary exposure in wildlife predators", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_wild[aware_wild$`Secondary exposure in wildlife predators` == "Y",],20)
##Examples of loose coding
head(aware_wild[aware_wild$`Secondary exposure in wildlife predators` == "M",],20)
About 10% of respondents have heard of secondary exposure risks of
rodenticide to wildlife. This is higher than we expected, given our
assumption that threats to those who are not near and dear are not top
of mind for most people. On the other hand, the threats rodenticide pose
to wildlife are front and center to actual campaigns to reduce
rodenticide use, such as those run by groups like Raptors are the
Solution and Poison Free Malibu. Thus, it is noteworthy that awareness
of risks to wildlife is much lower than that of risk to pets, and may
also be lower than awareness of risks to children. This could be an
indication that threats to wildlife are of little interest to most
people and so are difficult to recall.
wild_strict_weighted<-svyciprop(~I(`Secondary exposure in wildlife predators`
== "Y"), sample_design)
wild_strict_weighted<-cbind(wild_strict_weighted[1], confint(wild_strict_weighted)[1],confint(wild_strict_weighted)[2])
wild_loose_weighted<-svyciprop(~I(`Secondary exposure in wildlife predators`
== "Y"|`Secondary exposure in wildlife predators` == "M"),
sample_design)
wild_loose_weighted<-cbind(wild_loose_weighted[1], confint(wild_loose_weighted)[1],confint(wild_loose_weighted)[2])
wild_strict_unweighted<-prop.test(table(aware_full$`Secondary exposure in wildlife predators`)[3], table(aware_full$`Secondary exposure in wildlife predators`)[1]+
table(aware_full$`Secondary exposure in wildlife predators`)[2]+table(aware_full$`Secondary exposure in wildlife predators`)[3])
wild_strict_unweighted<-c(wild_strict_unweighted$estimate, wild_strict_unweighted$conf.int)
#mean, LCL, UCL
wild_loose_unweighted<-prop.test(table(aware_full$`Secondary exposure in wildlife predators`)[1]+table(aware_full$`Secondary exposure in wildlife predators`)[3],
table(aware_full$`Secondary exposure in wildlife predators`)[1]+ table(aware_full$`Secondary exposure in wildlife predators`)[2]+table(aware_full$`Secondary exposure in wildlife predators`)[3])
wild_loose_unweighted<-c(wild_loose_unweighted$estimate,
wild_loose_unweighted$conf.int) #mean, LCL, UCL
prop_wild_aware<-rbind(wild_strict_weighted, wild_strict_unweighted,
wild_loose_weighted, wild_loose_unweighted)
colnames(prop_wild_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_wild_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_wild_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 10.1 7.4 13.6
## Strict, Unweighted 9.3 8.1 10.7
## Loose, Weighted 11.4 8.6 15.0
## Loose, Unweighted 11.2 9.9 12.7
####Welfare Effects on Rodents
####Display examples
aware_rats<- dplyr::select(aware_full, c("Inhumane to rodents", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_rats[aware_rats$`Inhumane to rodents` == "Y",],20)
##Examples of loose coding
head(aware_rats[aware_rats$`Inhumane to rodents` == "M",],20)
For the first time so far, both weighting and the strictness of the
criteria have a substantial impact on our estimates. The percentage of
respondents who have heard that rodenticides are inhumane to rodents is
somewhere between 16 and 28 percent, with the weighted and loose
estimates at the higher end. Unlike the other arguments we were
interested in, in this case we place more faith in the loose criteria.
If this assumption is correct, then awareness of the harm to rodents is
higher than even awareness of harm to pets. It is perhaps unsurprising
that a higher percentage of respondents would be aware that poison could
be harmful to the species that they are meant to target. Indeed, the
fact that only about a fourth of respondents were aware of it is the
more surprising finding, given that it is easy to infer that being
poisoned would be painful.
rats_strict_weighted<-svyciprop(~I(`Inhumane to rodents`
== "Y"), sample_design)
rats_strict_weighted<-cbind(rats_strict_weighted[1], confint(rats_strict_weighted)[1],confint(rats_strict_weighted)[2])
rats_loose_weighted<-svyciprop(~I(`Inhumane to rodents`
== "Y"|`Inhumane to rodents` == "M"),
sample_design)
rats_loose_weighted<-cbind(rats_loose_weighted[1], confint(rats_loose_weighted)[1],confint(rats_loose_weighted)[2])
rats_strict_unweighted<-prop.test(table(aware_full$`Inhumane to rodents`)[3], table(aware_full$`Inhumane to rodents`)[1]+
table(aware_full$`Inhumane to rodents`)[2]+table(aware_full$`Inhumane to rodents`)[3])
rats_strict_unweighted<-c(rats_strict_unweighted$estimate, rats_strict_unweighted$conf.int)
#mean, LCL, UCL
rats_loose_unweighted<-prop.test(table(aware_full$`Inhumane to rodents`)[1]+table(aware_full$`Inhumane to rodents`)[3],
table(aware_full$`Inhumane to rodents`)[1]+ table(aware_full$`Inhumane to rodents`)[2]+table(aware_full$`Inhumane to rodents`)[3])
rats_loose_unweighted<-c(rats_loose_unweighted$estimate,
rats_loose_unweighted$conf.int) #mean, LCL, UCL
prop_rats_aware<-rbind(rats_strict_weighted, rats_strict_unweighted,
rats_loose_weighted, rats_loose_unweighted)
colnames(prop_rats_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_rats_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_rats_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 15.8 12.7 19.4
## Strict, Unweighted 20.0 18.3 21.9
## Loose, Weighted 21.7 18.2 25.7
## Loose, Unweighted 28.3 26.3 30.3
In theory, people who have had to confront rodents in their home or
business would be more aware of arguments that rodenticides are inhumane
to rodents, because it is relevant to the choice of rodent control
method. We find that this is true under the strict criteria, though the
opposite is true for arguments coded under the loose criteria.
rattable<-svychisq(~`Inhumane to rodents`+pestcontrol, sample_design)
prop.table(rattable$observed, 2) #the proportion of respondents with knowledge of primary risk exposure to children, broken down by whether respondents have managed rodent problems in the past decade.
## pestcontrol
## Inhumane to rodents 0 1
## M 0.08385491 0.04597557
## N 0.78872917 0.77961003
## Y 0.12741592 0.17441440
rattable$stdres # standardized residuals greater than ~2 indicate a statistically significant difference
## pestcontrol
## Inhumane to rodents 0 1
## M 3.3760441 -3.3760441
## N 0.4663683 -0.4663683
## Y -2.7195968 2.7195968
Risk of Facilitating Resistance or Neophobia
Although it was not of central interest, we coded for knowledge of
the risk of rodents developing resistance to and/or neophobia towards
rodenticide because it is a common argument against overuse of any
particular type of rodenticide. For example, the Rodenticide Resistance Action Commitee is
an industry-friendly group that is trying to prevent overuse of
rodenticide.
####Display examples
aware_resist<- dplyr::select(aware_full, c("Cause resistance or neophobia", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_resist[aware_resist$`Cause resistance or neophobia` == "Y",],20)
##There weren't any examples that met the loose but not the strict criteria
head(aware_resist[aware_resist$`Cause resistance or neophobia` == "M",],20)
Although a concerns about rodenticide resistance is common in the
pest management industry and is occasionally invoked by anti-rodenticide
activists as a reason why rodenticide is not a sustainable means of
managing rodent populations, awareness of the issue among the public is
below 1%. This result could mean that increasing awareness of
rodenticide resistance is low-hanging fruit. On the other hand, it is
not yet clear whether concerns about resistance would be a strong reason
for any one individual to not use rodenticides, given that rodenticide
use, like antibiotic use, is a collective action problem. Moreover, the
solution to increasing concern about resistance might be just greater
diversity in what types of rodenticides are used, which would not reduce
the suffering of rodents by much.
resist_strict_weighted<-svyciprop(~I(`Cause resistance or neophobia` == "Y"), sample_design)
resist_strict_weighted<-cbind(resist_strict_weighted[1], confint(resist_strict_weighted)[1],confint(resist_strict_weighted)[2])
resist_loose_weighted<-svyciprop(~I(`Cause resistance or neophobia`== "Y"|`Cause resistance or neophobia` == "M"),
sample_design)
resist_loose_weighted<-cbind(resist_loose_weighted[1], confint(resist_loose_weighted)[1],confint(resist_loose_weighted)[2])
##there were no M's here so the positioning change where 1 refers to N and 2 refers to Y
resist_strict_unweighted<-prop.test(table(aware_full$`Cause resistance or neophobia`)[2], table(aware_full$`Cause resistance or neophobia`)[1]+ table(aware_full$`Cause resistance or neophobia`)[2])
resist_strict_unweighted<-c(resist_strict_unweighted$estimate, resist_strict_unweighted$conf.int)
#mean, LCL, UCL
resist_loose_unweighted<-prop.test(table(aware_full$`Cause resistance or neophobia`)[2],
table(aware_full$`Cause resistance or neophobia`)[1]+ table(aware_full$`Cause resistance or neophobia`)[2])
resist_loose_unweighted<-c(resist_loose_unweighted$estimate,
resist_loose_unweighted$conf.int) #mean, LCL, UCL
prop_resist_aware<-rbind(resist_strict_weighted, resist_strict_unweighted,
resist_loose_weighted, resist_loose_unweighted)
colnames(prop_resist_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_resist_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_resist_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 0.5 0.2 1.0
## Strict, Unweighted 0.9 0.5 1.4
## Loose, Weighted 0.5 0.2 1.0
## Loose, Unweighted 0.9 0.5 1.4
Risk of Pollution or to Public Health
The risk that rodenticides pose to the environment and public health
via pollution was not a type of knowledge we planned to code for.
Although there is a small scientific literature on topics such as
rodenticide seeping into water sources where it could affect aquatic
animals, to our knowledge here is not much discussion among pest
managers, scientists, or anti-rodenticide activists about pollution.
Many examples of respondents reporting these arguments seem like generic
arguments that one might make about any poison. Thus, we suspect that
most arguments we coded as part of this category are ones that
respondents either thought of on their own or speculated about with
peers. Note that primary exposure risks to children and secondary
exposure risks to nonhuman animals did not count as arguments about
pollution or public health for present purposes; instead, the
environmental pollution/public health category captures concerns about
adult public health or “the environment” (it was often unclear whether
the ultimate concern about the environment related to humans, wildlife,
the habitats themselves, or some combination).
####Display examples
aware_pollute<- dplyr::select(aware_full, c("Environmental pollution/Public Health", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_pollute[aware_pollute$`Environmental pollution/Public Health` == "Y",],20)
##There weren't any examples that met the loose but not the strict criteria
head(aware_pollute[aware_pollute$`Environmental pollution/Public Health` == "M",],20)
Somewhere between 17% and 28% of respondents report awareness that
rodenticides could be an environmental pollutant or threat to public
health, with loose criteria and unweighted data returning estimates at
the upper end. The high awareness for an issue that is largely
tangential to the concerns of anti-rodenticide advocates stands in
contrast with the much lower awareness of secondary exposure risk to
wildlife. Advocates might enjoy a larger following if they either
message about the pollution risks of rodenticide, or target individuals
that are particularly concerned about non-natural ingredients.
environment_strict_weighted<-svyciprop(~I(`Environmental pollution/Public Health`
== "Y"), sample_design)
environment_strict_weighted<-cbind(environment_strict_weighted[1], confint(environment_strict_weighted)[1],confint(environment_strict_weighted)[2])
environment_loose_weighted<-svyciprop(~I(`Environmental pollution/Public Health`
== "Y"|`Environmental pollution/Public Health` == "M"),
sample_design)
environment_loose_weighted<-cbind(environment_loose_weighted[1], confint(environment_loose_weighted)[1],confint(environment_loose_weighted)[2])
environment_strict_unweighted<-prop.test(table(aware_full$`Environmental pollution/Public Health`)[3], table(aware_full$`Environmental pollution/Public Health`)[1]+
table(aware_full$`Environmental pollution/Public Health`)[2]+table(aware_full$`Environmental pollution/Public Health`)[3])
environment_strict_unweighted<-c(environment_strict_unweighted$estimate, environment_strict_unweighted$conf.int)
#mean, LCL, UCL
environment_loose_unweighted<-prop.test(table(aware_full$`Environmental pollution/Public Health`)[1]+table(aware_full$`Environmental pollution/Public Health`)[3],
table(aware_full$`Environmental pollution/Public Health`)[1]+ table(aware_full$`Environmental pollution/Public Health`)[2]+table(aware_full$`Environmental pollution/Public Health`)[3])
environment_loose_unweighted<-c(environment_loose_unweighted$estimate,
environment_loose_unweighted$conf.int) #mean, LCL, UCL
prop_environment_aware<-rbind(environment_strict_weighted, environment_strict_unweighted,
environment_loose_weighted, environment_loose_unweighted)
colnames(prop_environment_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_environment_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_environment_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 17.3 13.8 21.4
## Strict, Unweighted 17.6 15.9 19.3
## Loose, Weighted 22.9 19.1 27.1
## Loose, Unweighted 27.6 25.7 29.7
Other Effective Rodent Control Methods Exist
Knowledge of alternatives to rodenticide was another category that we
did not originally intend to categorize. However, it is relevant because
beliefs about whether adequate alternatives to rodenticide exist are a
common reason for support or opposing anti-rodenticide interventions
according to our
open-ended poll.
####Display examples
aware_methods<- dplyr::select(aware_full, c("Other Methods Suffice", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_methods[aware_methods$`Other Methods Suffice` == "Y",],20)
##There weren't any examples that met the loose but not the strict criteria
head(aware_methods[aware_methods$`Other Methods Suffice` == "M",],20)
Even under generous assumptions, awareness of alternatives to
rodenticides are well below 5%. This could be because respondents view
alternatives that they are almost certainly aware of (e.g., snap traps)
as a complement to rodenticides rather than a substitute, or because
they have not heard of alternatives that they would consider a plausible
substitute for rodenticide. Either way, these results suggest that
increasing the profile of non-poisonous alternatives is a priority.
Indeed, the low awareness of rodenticide alternatives is probably the
single most actionable result from this report.
methods_strict_weighted<-svyciprop(~I(`Other Methods Suffice`
== "Y"), sample_design)
methods_strict_weighted<-cbind(methods_strict_weighted[1], confint(methods_strict_weighted)[1],confint(methods_strict_weighted)[2])
methods_loose_weighted<-svyciprop(~I(`Other Methods Suffice`
== "Y"|`Other Methods Suffice` == "M"),
sample_design)
methods_loose_weighted<-cbind(methods_loose_weighted[1], confint(methods_loose_weighted)[1],confint(methods_loose_weighted)[2])
methods_strict_unweighted<-prop.test(table(aware_full$`Other Methods Suffice`)[3], table(aware_full$`Other Methods Suffice`)[1]+
table(aware_full$`Other Methods Suffice`)[2]+table(aware_full$`Other Methods Suffice`)[3])
methods_strict_unweighted<-c(methods_strict_unweighted$estimate, methods_strict_unweighted$conf.int)
#mean, LCL, UCL
methods_loose_unweighted<-prop.test(table(aware_full$`Other Methods Suffice`)[1]+table(aware_full$`Other Methods Suffice`)[3],
table(aware_full$`Other Methods Suffice`)[1]+ table(aware_full$`Other Methods Suffice`)[2]+table(aware_full$`Other Methods Suffice`)[3])
methods_loose_unweighted<-c(methods_loose_unweighted$estimate,
methods_loose_unweighted$conf.int) #mean, LCL, UCL
prop_methods_aware<-rbind(methods_strict_weighted, methods_strict_unweighted,
methods_loose_weighted, methods_loose_unweighted)
colnames(prop_methods_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_methods_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_methods_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 2.1 1.0 4.3
## Strict, Unweighted 2.4 1.8 3.2
## Loose, Weighted 3.2 1.8 5.4
## Loose, Unweighted 3.2 2.5 4.1
If pest managers tell their customers about alternatives to
rodenticide or customers are motivated to look for alternatives
themselves, then people who have had rodent problems should be more
aware of rodenticide alternatives. But we find the opposite– those who
have neither hired professional pest control for rodents nor conducted
rodent control on their rodent control demonstrated greater awareness of
alternatives. Perhaps the process of managing rodents convinces some
people that rodenticide cannot be adequately replaced, though this would
not explain why they have not at least heard of the argument that
adequate alternatives exist at higher rates.
subtable<-svychisq(~`Other Methods Suffice`+pestcontrol, sample_design)
prop.table(subtable$observed, 2) #the proportion of respondents with knowledge that there are alternatives to rodenticides, broken down by whether respondents have managed rodent problems in the past 10 years.
## pestcontrol
## Other Methods Suffice 0 1
## M 0.023554766 0.002838029
## N 0.949134271 0.979181073
## Y 0.027310963 0.017980898
subtable$stdres # standardized residuals greater than ~2 indicate a statistically significant difference
## pestcontrol
## Other Methods Suffice 0 1
## M 4.338829 -4.338829
## N -3.624135 3.624135
## Y 1.362083 -1.362083
####Risk that Rodents Die in a Hard-to-Reach Place
We had not planned to measure awareness of the fact that rodents who
die due to actions with delayed methods such as rodenticide may die in a
hard-to-reach place because this is not relevant to the humaneness of
rodenticides. However, we decided to code for it because the argument
came up in responses several times and appealing to this inconvenience
might persuade some people to not use rodenticides.
####Display examples
aware_walls<- dplyr::select(aware_full, c("Die in walls/hard to reach places", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_walls[aware_walls$`Die in walls/hard to reach places` == "Y",],20)
##There weren't any examples that met the loose but not the strict criteria
head(aware_walls[aware_walls$`Die in walls/hard to reach places` == "M",],20)
Awareness of rodents dying in hard-to-reach places due to rodenticide
poisoning was around 4.5-5.5%. Increasing awareness of rodents rotting
in walls or other nooks might deter many residential customers, and so
should probably be emphasized by anti-rodenticide advocates and
companies that make or apply non-chemical rodent control products
only.
walls_strict_weighted<-svyciprop(~I(`Die in walls/hard to reach places`
== "Y"), sample_design)
walls_strict_weighted<-cbind(walls_strict_weighted[1], confint(walls_strict_weighted)[1],confint(walls_strict_weighted)[2])
walls_loose_weighted<-svyciprop(~I(`Die in walls/hard to reach places`
== "Y"|`Die in walls/hard to reach places` == "M"),
sample_design)
walls_loose_weighted<-cbind(walls_loose_weighted[1], confint(walls_loose_weighted)[1],confint(walls_loose_weighted)[2])
walls_strict_unweighted<-prop.test(table(aware_full$`Die in walls/hard to reach places`)[3], table(aware_full$`Die in walls/hard to reach places`)[1]+
table(aware_full$`Die in walls/hard to reach places`)[2]+table(aware_full$`Die in walls/hard to reach places`)[3])
walls_strict_unweighted<-c(walls_strict_unweighted$estimate, walls_strict_unweighted$conf.int)
#mean, LCL, UCL
walls_loose_unweighted<-prop.test(table(aware_full$`Die in walls/hard to reach places`)[1]+table(aware_full$`Die in walls/hard to reach places`)[3],
table(aware_full$`Die in walls/hard to reach places`)[1]+ table(aware_full$`Die in walls/hard to reach places`)[2]+table(aware_full$`Die in walls/hard to reach places`)[3])
walls_loose_unweighted<-c(walls_loose_unweighted$estimate,
walls_loose_unweighted$conf.int) #mean, LCL, UCL
prop_walls_aware<-rbind(walls_strict_weighted, walls_strict_unweighted,
walls_loose_weighted, walls_loose_unweighted)
colnames(prop_walls_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_walls_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_walls_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 5.3 3.6 7.8
## Strict, Unweighted 4.5 3.7 5.6
## Loose, Weighted 5.7 3.9 8.3
## Loose, Unweighted 4.8 3.9 5.8
Other arguments
Intelligible arguments that fit none of the above categories were
coded as “other.” Many of them arguably could have fit into other
categories, but were not specific enough given our coding criteria. For
example, when respondents mentioned that “other animals” could get
poisoned but did not specify which animals or how, we coded this as
Other. The alternative would have been to code these cases as “M” for
secondary poisoning of wildlife or primary/secondary poisoning of pets,
but it is not obvious which category was more plausible (or whether
respondents had yet something else in mind, like primary exposure to
wildlife). Similarly, we were unsure whether “Potential contamination of
foods” referred to the human food supply or food for wildlife. The use
of the “Other” category is in the main way in which we might have
underestimated prevalence of awareness of the other arguments, although
these potential errors would have affected only the loose estimates, not
the strict ones.
####Display examples
aware_other<- dplyr::select(aware_full, c("Other", "firstreasonagainst","secondreasonagainst","thirdreasonagainst","fourthreasonagainst","fifthreasonagainst"))
##Examples of strict coding
head(aware_other[aware_other$Other == "Y",],20)
##There weren't any examples that met the loose but not the strict criteria
head(aware_other[aware_other$Other == "M",],20)
Between 19% and 24% of respondents report having heard of some other
argument against rodenticide.
other_strict_weighted<-svyciprop(~I(Other
== "Y"), sample_design)
other_strict_weighted<-cbind(other_strict_weighted[1], confint(other_strict_weighted)[1],confint(other_strict_weighted)[2])
other_loose_weighted<-svyciprop(~I(Other
== "Y"|Other == "M"),
sample_design)
other_loose_weighted<-cbind(other_loose_weighted[1], confint(other_loose_weighted)[1],confint(other_loose_weighted)[2])
other_strict_unweighted<-prop.test(table(aware_full$Other)[3], table(aware_full$Other)[1]+
table(aware_full$Other)[2]+table(aware_full$Other)[3])
other_strict_unweighted<-c(other_strict_unweighted$estimate, other_strict_unweighted$conf.int)
#mean, LCL, UCL
other_loose_unweighted<-prop.test(table(aware_full$Other)[1]+table(aware_full$Other)[3],
table(aware_full$Other)[1]+ table(aware_full$Other)[2]+table(aware_full$Other)[3])
other_loose_unweighted<-c(other_loose_unweighted$estimate,
other_loose_unweighted$conf.int) #mean, LCL, UCL
prop_other_aware<-rbind(other_strict_weighted, other_strict_unweighted,
other_loose_weighted, other_loose_unweighted)
colnames(prop_other_aware)<-c("Est.", "LCL", "UCL")
rownames(prop_other_aware)<- c("Strict, Weighted", "Strict, Unweighted",
"Loose, Weighted", "Loose, Unweighted")
round((prop_other_aware*100),1)
## Est. LCL UCL
## Strict, Weighted 19.4 16.0 23.3
## Strict, Unweighted 23.5 21.6 25.5
## Loose, Weighted 19.5 16.1 23.5
## Loose, Unweighted 23.8 21.9 25.7
Summary Image
##collect all weighted estimates. might need to limit this to just the a priori knowledge categories, see what the figure looks like with all categories included.
weighted_estimates<-rbind(round((prop_children_aware*100),1), round((prop_pets_aware*100),1),round((prop_wild_aware*100),1), round((prop_rats_aware*100),1), round((prop_resist_aware*100),1),round((prop_environment_aware*100),1), round((prop_methods_aware*100),1),round((prop_walls_aware*100),1), round((prop_other_aware*100),1))
#make row names a column
weighted_estimates<-rownames_to_column(as.data.frame(weighted_estimates), var = "criteria")
#delete unweighted estimates
weighted_estimates<-weighted_estimates[!grepl("Unweighted",weighted_estimates$criteria),]
#rename columns to just say strict or loose
weighted_estimates$criteria<-ifelse(grepl("Loose", weighted_estimates$criteria),"Loose", weighted_estimates$criteria)
weighted_estimates$criteria<-ifelse(grepl("Strict", weighted_estimates$criteria),"Strict", weighted_estimates$criteria)
#create column for which argument
weighted_estimates <- weighted_estimates %>% add_column(argument = c("Children", "Children", "Pets", "Pets", "Wildlife", "Wildlife", "Inhumane", "Inhumane", "Resistance", "Resistance", "Pollution", "Pollution", "Alternatives", "Alternatives", "Hard-to-Reach", "Hard-to-Reach", "Other", "Other"), .after = "criteria")
# Default bar plot
p<- ggplot(weighted_estimates, aes(x= as.factor(argument), y= Est., fill= criteria)) +
geom_bar(stat="identity", color="black",
position=position_dodge()) +
geom_errorbar(aes(ymin= LCL, ymax= UCL), width=.2,
position=position_dodge(.9))
# Finished bar plot
pp<-p+labs(title="Knowledge of Anti-Rodenticide Arguments Among U.S. Adults", x="Argument", y = "Percent Knowledgable")+
theme_classic() +
scale_fill_manual(values=c('#999999','#E69F00'))+
theme(plot.title = element_text(hjust = 0.5))+
labs(caption = "N = 1,936, weighted on sociodemographics to be representative of U.S. adults. Error bars are 95% confidence intervals.") +
theme(plot.caption.position = "plot",
plot.caption = element_text(hjust = 0))
pp
