In shanejorr/schoolreportr: What the Package Does (One Line, Title Case)

knitr::opts_chunk$set(
  echo = FALSE,
  message = FALSE,
  warning = FALSE
)

library(glue)
library(dplyr)

years <- 2017:2020
org_level <- 'schools'
nces_num <- "050306000073"
state_abb <- 'AR'
grades <- 10:12

devtools::load_all()

# This block pulls the academic data and shape files we need to create the panes
# with academic data

# set parameters and get data -------------------------

## get initial information so that we can pull the data -----------------

# years data is available
# this will be used when we pull the data
saipe_years <- sr_years_data_available('saipe')
ccd_years <- sr_years_data_available('ccd')

# the fips code for the state that the school or district is located in
state_fips <- sr_state_fips_code(state_abb)

# the school directory contains all the information on the school and pieces
# will be used throughout the report
school_directory <- sr_ccd_directory(org_level, nces_num, max(ccd_years))

district_leaid_number <- unique(school_directory$leaid)

# you should only have one district. Produce error if there are more than one.
if (length(district_leaid_number) > 1) stop("All schools must be in the same school district", call. = FALSEs)

# for school name, use the school if there is only one, otherwise use the district
if (length(nces_num) == 1) {
  school_names <- stringr::str_to_title(school_directory$school_name)
} else {
  distric_name <- unique(school_directory$lea_name) |> stringr::str_to_title()
  school_names <- stringr::str_to_title(paste0(distric_name," Schools"))
}

## get data ------------------------

# get the school enrollment data
school_enrollment <- sr_ccd_enrollment(org_level, nces_num, years, grades)

# the number of 5-17 year olds in the district in poverty
district_poverty <- sr_district_in_poverty(district_leaid_number, max(saipe_years))

# get state assessment data

# grades 9-12 are lumped together as grade 9 for EdFacts state assessment data
# therefore, convert any grade greater than 9 to 9
assessment_grades <- unique(ifelse(grades > 9, 9, grades))
# years
state_assessment <- sr_state_assessments(org_level, state_fips, years, assessment_grades) |>
  sr_assessment_scores_by_race(org_level, nces_num) |>
  mutate(geography = recode(geography, 
                           'state total' = glue("{state_abb} Total"),
                            'schools / districts' = school_names))

# get district shapefile to map district boundaries
district_shapefile <- tigris::school_districts(state = state_abb, cb = FALSE) |>
  # filter for district
  filter(GEOID == district_leaid_number)

dashboard_title <- stringr::str_c(school_names, " Landscape Analysis")

# value boxes ------------------

# the information in this block is used to create the value boxes at the top of the first page
max_edfacts_year <- max(state_assessment$year)
edfacts_year <- glue("{max_edfacts_year}-{max_edfacts_year}")

max_ccd_year <- max(school_directory$year)
ccd_year <- glue("{max_ccd_year}-{max_ccd_year}")

lowest_grade <- min(grades)
highest_grade <- max(grades)

prettify_grade <- function(grade) {

  grade <- as.character(grade)

  case_when(
    grade == '-1' ~ 'Pre-K',
    grade == '0' ~ 'K',
    .default = grade
  )

}

grade_span <- glue("{prettify_grade(lowest_grade)}-{prettify_grade(highest_grade)}")

School/s Overview {data-orientation=rows}

Row

Enrollment at r school_names
r glue("{ccd_year}<br>Grades {grade_span}")

# value box for school enrollment

latest_year_enrollment <- school_enrollment |>
  filter(race == 'Total', year == max(years)) |>
  pull(enrollment) |>
  as.numeric() |>
  scales::comma()

flexdashboard::valueBox(latest_year_enrollment, icon = "fa-child")

FTE Teachers at r school_names
r glue("{ccd_year}<br>Grades {grade_span}")

# value box for number of FTE teachers

teachers_elementary <- sum(school_directory$teachers_fte) |>
  as.numeric() |>
  scales::comma()

flexdashboard::valueBox(teachers_elementary, icon = "fa-chalkboard-teacher")

Percent of 5-17 year olds in poverty within district
r max(saipe_years)

# value box for percentage of students in poverty

percent_students_poverty <-  district_poverty$est_population_5_17_pct[1] |>
  scales::percent()

flexdashboard::valueBox(percent_students_poverty, icon = "fa-bed")

Percent passing math state assessments
r glue("{edfacts_year}<br>Grades {grade_span}")

# value box for math state assessments

# get most recent year for the district of state assessments
school_assessment_recent_year <-  state_assessment |>
  filter(year == !!max_edfacts_year, !stringr::str_detect(geography, 'Total'), race == 'Total')

math_assess <- school_assessment_recent_year |>
  pull(math_pct_pass)

math_assess <- scales::percent(math_assess / 100, accuracy = 1)

flexdashboard::valueBox(math_assess, icon = "fa-calculator")

Percent passing reading state assessments
r glue("{edfacts_year}<br>Grades {grade_span}")

# value box for reading state assessments

read_assess <- school_assessment_recent_year |>
  pull(read_pct_pass)

read_assess <- scales::percent(read_assess / 100, accuracy = 1)

flexdashboard::valueBox(read_assess, icon = "fa-book")

Row

District Map {data-width=700}

# district map and table of cities --------------------

# must create the map in a different code chunk than the chunk it is printed in
# this is because sf prints a statement in one of the commands and the only
# way to suppress the statement is the include the header include = FALSE
# but, this header prevents the map from showing as well
district_map <- sr_viz_district_boundary(district_shapefile, school_directory)

district_map

Cities in District {data-width=200}

pop_colname <- glue("**City Pop.<br>{max(years)-1}**")

cities_table <- sr_cities_in_district(district_shapefile, state = state_abb) |> 
  # convert the data frame to a gt table and make nicer
  mutate(population = scales::comma(population)) |>
  gt::gt() |>
  gt::cols_label(
    city = gt::md("**City Name**"),
    population = gt::md("**Population**")
  )

cities_table

School Demographics {data-orientation=rows}

Row {data-height=400}

Total Enrollment by Year

# plot enrollment -------------------

total_enrollment <- school_enrollment |>
  filter(race == 'Total')

sr_plot_total_enrollment_by_year(total_enrollment, school_names, grade_span)

Row {data-height=400}

Enrollment by Race and Year

race_y_var_title <- glue("Percentage Enrollment by Race (grades {grade_span})")

school_enrollment |>
  sr_clean_enrollment_by_race() |>
  sr_plot_grouped_line(
    x_col = 'school_year_both', y_col = 'percent_race', group_col = 'race', 
    plt_title = NULL, 
    x_var_title = NULL, y_var_title = race_y_var_title,
    y_percentage = TRUE
  ) |>
  sr_plot_create_tooltip('race', 'percent_race_clean', 'enrollment')

State Assessments {data-orientation=rows}

Row {data-height=400}

# state assessments ----------------

state_assessment <- state_assessment |>
  # make sure the different district names are all the same
  mutate(
    # percentages for plotting
    read_pct_pass_clean = scales::percent(read_pct_pass / 100, accuracy = 1),
    math_pct_pass_clean = scales::percent(math_pct_pass / 100, accuracy = 1)
  )

all_years_total <- state_assessment |>
  filter(race == 'Total')

# create plots for math and reading
subjects <- c('math', 'read')
plt_titles <- c('Percent passing math state assessments', 'Percent passing reading state assessments')

all_year_plts <- purrr::map2(subjects, plt_titles, function(.x, plt_title) {

  all_years_total |>
    sr_plot_grouped_line(
      'school_year_both', glue('{.x}_pct_pass'), 'geography', glue("{plt_title} in grades {grade_span}"),
      NULL, 'Percent passing state assessment', y_percentage = TRUE
    ) |>
    sr_plot_create_tooltip('geography', glue('{.x}_pct_pass_clean'), glue('{.x}_test_num_valid'))

})

Reading State Assessments - Percent Passing

all_year_plts[[2]]

Math State Assessments - Percent Passing

all_year_plts[[1]]

Row {data-height=400}

Reading State Assessments

---

# get school assessment by race data
assessment_race <- state_assessment |>
  filter(!stringr::str_detect(geography, 'Total'),
         race != 'Total')

# line plots of district assessments by race and year
all_years_race_district <- purrr::map2(subjects, plt_titles, function(.x, plt_title) {

  assessment_race |>
    sr_plot_grouped_line(
      'school_year_both', glue('{.x}_pct_pass'), 'race', NULL,
      NULL, glue("{plt_title} in grades {grade_span}"), y_percentage = TRUE
    ) |>
    sr_plot_create_tooltip('race', glue('{.x}_pct_pass_clean'), glue('{.x}_test_num_valid'))

})

# bar  chart comparing most recent year with state averages
all_years_race <- state_assessment |>
  filter(race != 'Total') |>
  arrange(race)

all_years_race_total <- purrr::map2(subjects, plt_titles, function(.x, plt_title) {

  sr_plot_grouped_bar(all_years_race, 'race', glue('{.x}_pct_pass'), 'geography', glue("{plt_title} in grades {grade_span}"))

})

School Reading State Assessments by Race - Percent Passing

all_years_race_district[[2]]

School and State Reading Assessments by Race - Percent Passing

all_years_race_total[[2]]

Row {data-height=400}

Math State Assessments

---

School Math State Assessments by Race - Percent Passing

all_years_race_district[[1]]

School and State Math State Assessments by Race - Percent Passing

all_years_race_total[[1]]

Community Demographics {data-orientation=rows}

# get most recent year of census data
census_most_recent <- max(sr_years_data_available('census'))

Note:

Community data is from the US Census's American Community Survey. The data is from the most recent year available, which is r census_most_recent. The data is an aggregate of all census tracts where any portion of the tract is located within the school district.

Row {data-height=350}

# Community demographics ------------------

# find the census tracts in the school district
tracts_in_district <- sr_census_tracts_in_district(district_shapefile, state_abb)

geoid_tracts_in_district <- tracts_in_district$GEOID

Racial Composition

race_population_variables <- c(
  'B03002_001','B03002_004', 'B03002_012','B03002_003','B03002_005','B03002_006','B03002_007','B03002_010','B03002_011'
  )

census_demographics <- sr_demographic_data(race_population_variables, state_abb, geoid_tracts_in_district)   |>
    dplyr::mutate(variable = case_match(
      variable,
      'B03002_001' ~ 'Total',
      'B03002_004' ~ 'Black / African-American', 
      'B03002_012' ~ 'Hispanic / Latinx',
      'B03002_003' ~ 'White', 
      'B03002_005' ~ 'American Indian or Alaska Native', 
      'B03002_006' ~ 'Asian',
      'B03002_007' ~ 'Native Hawaiian or other Pacific Islander',
      'B03002_010' ~ 'Some Other', 
      'B03002_011' ~ 'Two or more races'
    ))

# everything should have matched
if (any(is.na(census_demographics$variable))) stop("Failed to properly match racial categories to census pop data", call. = FALSE)

census_demographics_total <- census_demographics|>
  sr_calculate_percentages() |>
  filter(.data$variable != 'Total') |> 
  mutate(variable = sr_rename_reorder_race_education(variable)) |>
  arrange(variable)

# overall racial composition
sr_plot_grouped_bar(
  census_demographics_total, 'variable', 'perc_demo', 'geography', 
  x_var_title = NULL, y_var_title = 'Percentage breakdown by race', y_percentage = TRUE
)

# create choropleth maps by census tract showing population and percentage 
# population by race for each census tract
# create different map for each racial group

# calculate percentage pop in each race
races_to_use <- c('Black / African-American', 'Hispanic / Latinx', 'White')

# make sure total population value is present, because future operations rely on it
if (!"Total" %in% census_demographics$variable) stop("Population census tract data does not contain total populations.", call. = FALSE)

# clean up data so we can easily plot it in a choropleth map in highcharts
all_race_population <- sr_rmd_census_tracts_race(census_demographics, races_to_use)

# create choropleth maps by census tract for each race
choropleths_tracts_by_race <- purrr::map(races_to_use, function(race) {
  sr_rmd_plot_choropleth_tracts_race(
    .data = all_race_population, race = race, 
    tract_shapefile = tracts_in_district, school_location = school_directory
  )  
}) |> 
  purrr::set_names(races_to_use)

Percentage Black by Census Tract

choropleths_tracts_by_race[[1]]

Row {data-height=350}

Percentage Hispanic / Latinx by Census Tract

choropleths_tracts_by_race[[2]]

Percentage White by Census Tract

choropleths_tracts_by_race[[3]]

Row {data-height=350}

Median Income

# need lsit of census variables for median income and education; pull it out so
# it can be used in both
#var_year <- max(sr_years_data_available('census'))
#acs_vars <- tidycensus::load_variables(var_year, "acs5", cache = TRUE)

census_education <- sr_rmd_get_educational_attainment(state_abb, geoid_tracts_in_district)

ed_order <- unique(census_education$variable)

census_education <- census_education |>
  mutate(variable = factor(variable, levels = ed_order)) |>
  arrange(variable)

sr_plot_grouped_bar(
  census_education, 'variable', 'perc_demo', 'geography', 
  x_var_title = NULL, y_var_title = 'Educational attainment of community', y_percentage = TRUE
)

Row {data-height=350}

Educational Attainment of Population 25 and Over

census_education <- sr_rmd_get_educational_attainment(state_abb, geoid_tracts_in_district, acs_vars)

ed_order <- unique(census_education$variable)

census_education <- census_education |>
  mutate(variable = factor(variable, levels = ed_order)) |>
  arrange(variable)

sr_plot_grouped_bar(
  census_education, 'variable', 'perc_demo', 'geography', 
  x_var_title = NULL, y_var_title = 'Educational attainment of community', y_percentage = TRUE
)

shanejorr/schoolreportr documentation built on Aug. 7, 2023, 12:25 p.m.