# Load the survey data
data(involvement_survey_srs, package = "nrba")
# Calculate population benchmarks
population_benchmarks <- list(
"PARENT_HAS_EMAIL" = data.frame(
PARENT_HAS_EMAIL = c("Has Email", "No Email"),
PARENT_HAS_EMAIL_POP_BENCHMARK = c(17036, 2964)
),
"STUDENT_RACE" = data.frame(
STUDENT_RACE = c(
"AM7 (American Indian or Alaska Native)", "AS7 (Asian)",
"BL7 (Black or African American)",
"HI7 (Hispanic or Latino Ethnicity)", "MU7 (Two or More Races)",
"PI7 (Native Hawaiian or Other Pacific Islander)",
"WH7 (White)"
),
STUDENT_RACE_POP_BENCHMARK = c(206, 258, 3227, 1097, 595, 153, 14464)
)
)
# Add the population benchmarks as variables in the data
involvement_survey_srs <- merge(
x = involvement_survey_srs,
y = population_benchmarks$PARENT_HAS_EMAIL,
by = "PARENT_HAS_EMAIL"
)
involvement_survey_srs <- merge(
x = involvement_survey_srs,
y = population_benchmarks$STUDENT_RACE,
by = "STUDENT_RACE"
)
# Create a survey design object
library(survey)
survey_design <- svydesign(
weights = ~BASE_WEIGHT,
id = ~UNIQUE_ID,
fpc = ~N_STUDENTS,
data = involvement_survey_srs
)
# Subset data to only include respondents
survey_respondents <- subset(
survey_design,
RESPONSE_STATUS == "Respondent"
)
# Rake to the benchmarks
raked_survey_design <- rake_to_benchmarks(
survey_design = survey_respondents,
group_vars = c("PARENT_HAS_EMAIL", "STUDENT_RACE"),
group_benchmark_vars = c(
"PARENT_HAS_EMAIL_POP_BENCHMARK",
"STUDENT_RACE_POP_BENCHMARK"
),
)
# Inspect estimates from respondents, before and after raking
svymean(
x = ~PARENT_HAS_EMAIL,
design = survey_respondents
)
svymean(
x = ~PARENT_HAS_EMAIL,
design = raked_survey_design
)
svymean(
x = ~WHETHER_PARENT_AGREES,
design = survey_respondents
)
svymean(
x = ~WHETHER_PARENT_AGREES,
design = raked_survey_design
)
Run the code above in your browser using DataLab