Home Valuation by Geography

According to research by Dr. Andre Perry at the Brookings Institute, owner-occupied homes in Black neighborhoods are, on average, undervalued by $48,000 per house in the U.S. In the Louisville Metro Area, the median home value in majority Black neighborhoods is $89,681, but would be $117,593 if houses were not devalued, according to the same research. This difference constitutes a 27% undervaluation from what home values in Black neighborhoods would be if based on structural characteristics (e.g. sq. ft, year built) and neighborhood amenities (e.g. walkability, school districts, commute time) alone.

devaluation <- read_csv("devaluation.csv")

ranking_switch <- function(df, var, plot_title = "",
                    year = NULL, sex = "total", race = "total",
                    order = "Descending",
                    y_title = "Percent",
                    caption_text = "", subtitle_text = "",
                    bar_label = TRUE, sigfig = 3, accuracy = 0.1,
                    label_function, alternate_text = NULL,
                    ranking_colors = TRUE, text_size, FIPS_df){

  # Copy variable var to a new column for use with the '$' operator
  var <- dplyr:::tbl_at_vars(df, vars(!!enquo(var)))
  df$var <- df[[var]]
  # Filter to sex, race, and year
  if ("sex" %in% names(df)) df <- df[df$sex == sex,]
  if ("race" %in% names(df)) df <- df[df$race == race,]
  if("year" %in% names(df)) {
    df <- df[df$year %in% year,]
    if (length(year) > 1) {
      df %<>%
        group_by_at(df %cols_in% c("MSA", "FIPS")) %>%
        summarise(var = mean(var, na.rm = TRUE)) %>%
        ungroup()
    }
  }
  # Add peer data if not already present
   if ("city" %not_in% names(df)) {
     df %<>%
       pull_peers(add_info = T, FIPS_df = FIPS_df) %>%
       filter(current == 1)
   }

  # Sort according to order parameter
  if (order %in% c("descending", "Descending")) df %<>% arrange(desc(var))
  if (order %in% c("ascending", "Ascending"))   df %<>% arrange(var)
  df %<>% filter(!is.na(var))
  # Create numbered city labels for left side of graph
  df %<>%
    mutate(
      rank = row_number(),
      names = paste0(rank, ". ", city))
  # Set bar colors
  if (ranking_colors) {
    # color_values <- c("#96ca4f", "#ffd600", "#db2834")
    # color_names <- c("green", "yellow", "red")
    # if (order %in% c("descending", "Descending")) {color_names  = rev(color_names)}
    #
    # breaks <- classInt::classIntervals(na.omit(df$var), 3, style = "jenks")
    # df$color <- NA
    # df$color[df$var <= breaks$brks[2]] <- color_names[1]
    # df$color[df$var > breaks$brks[2] & df$var <= breaks$brks[3]] <- color_names[2]
    # df$color[df$var > breaks$brks[3]] <- color_names[3]

    color_values <- c("#323844", "#d63631")
    color_names <- c("gray", "red")

    df$color <- "red"
    df$color[df$city == "Louisville"] <- "gray"
  } else {
    df$color <- "blue"
    color_values <- "#f58021"
    color_names <- "blue"
  }
  #if (order %in% c("descending", "Descending")) color_values = rev(color_values)
  color_values = rev(color_values)
  # Create numeric labels
  # Create numeric labels
  if (!missing(label_function)) {
    label_text <- df$var %>% signif(sigfig) %>% label_function()
  } else if (y_title %in% c("Dollars", "Hourly Wage")) {
    if(mean(df$var, na.rm = TRUE) > 10000) {
      label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = accuracy, scale = .001, suffix = "k")
    } else {
      label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = .01)
    }
  } else if (stringr::str_detect(y_title, "Percent")) {
    label_text <- df$var %>% signif(sigfig) %>% scales::percent(accuracy = accuracy, scale = 1, suffix = "%")
  } else {
    label_text <- df$var %>% signif(sigfig) %>% scales::comma(accuracy = accuracy)
  }

  # Set text format, highlight and italicise Louisville text, highlight Louisville bar
  df$textcolor <- "#000000"
  df$textcolor[df$city %in% c("Nashville", "Greenville", "Oklahoma City", "Louisville")] <- "#000000"

  df$textfont <- "Montserrat"
  df$textfont[df$city == "Louisville"] <- "Montserrat Bold"

  label_color_names <- c("white", "black")
  label_color_values <- c("#000000", "#ffffff")

  df$label_color <- "white"
  df$label_color[df$city %in% c("Nashville", "Greenville", "Oklahoma City", "Louisville")] <- "black"
  #df$linecolor <- "#ffffff"
  #df$linecolor[df$city == "Louisville"] <- "#00a9b7"
  df$lou <- if_else(df$city == "Louisville", 1, 0)
  df$text_alignment <- 1.1
  if (!is.null(alternate_text)) df$text_alignment[df$rank %in% alternate_text] <- -0.1
  ### PLOT GRAPH

  # Initial plot
  p <- ggplot(data = df,
              aes(x = factor(names, levels = rev(names)),
                  y = var,
                  fill  = factor(color, levels = color_names, ordered = TRUE)))
  p <- p + guides(fill = FALSE, color = FALSE)
  # Add bars
  p <- p +
    geom_bar(stat = "identity",
             size = text_size) +
    coord_flip() +
    ggthemes::theme_tufte()
  p <- p + scale_fill_manual(values = color_values)
  #p <- p + scale_color_manual(values = c("#ffffff", "#00a9b7"))
  # Add features
  title_scale <- min(1, 48 / nchar(plot_title))
  p <- p + theme(text = element_text(family = "Montserrat"),
                 plot.title = element_text(size = 14 * title_scale * text_size, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
                 axis.text.y = element_text(hjust = 0,
                                            size = 10 * text_size,
                                            color = rev(df$textcolor),
                                            family = rev(df$textfont)),
                 axis.title.x = element_text(size = 10 * text_size),
                 axis.ticks = element_blank(),
                 axis.text.x = element_blank(),
                 plot.caption = element_text(size = 10 * text_size, lineheight = 0.5))
  if(subtitle_text != ""){
    p <- p +
      labs(subtitle = subtitle_text) +
      theme(plot.subtitle = element_text(hjust = 0.5, size = 10 * text_size))

  }
  # Add numeric labels to bars based on bar_label parameter
  if (y_title != "" & bar_label) {
    p <- p + geom_text(aes(label = label_text,
                           hjust = text_alignment,
                           color = factor(label_color),
                           family = textfont),
                       size = 4.5 * text_size) +
      scale_colour_manual(values=c("#000000", "#ffffff"))
  }
  # Add vertical line to the left side of the bars based on the h_line parameter
  if (min(df$var, na.rm = TRUE) < 0) p <- p + geom_hline(yintercept = 0, linetype = "longdash", size = 2)
  # Add remaining text
  p <- p + labs(title = plot_title,
                y = y_title,
                x = "",
                caption = caption_text)

  p <- p +
    theme(
      panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
      plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
      legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
      legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
      legend.key = element_rect(fill = "transparent", colour = NA))
  
  p <- p + expand_limits(y = 15)

  p
}

ranking_switch(devaluation,
        devaluation,
        plot_title = "Devaluation of Homes in Black Neighborhoods",
        text_size = 2, 
        alternate_text=1:17,
        FIPS_df = FIPS_df,
        caption = "Source: Greater Louisville Project
                   Data from Dr. Andre Perry, Brookings Institute")

Property Taxes

While facing lower home values on the market, homes in majority-Black neighborhoods are valued relatively-higher than homes in majority-white by the property tax administration, and thus face higher taxation relative to the market value of their homes.

The Jefferson County Property Value Administration (PVA) assesses homes every three years to determine their value, and that value is used to determine the amount of property taxes the owner owes. The PVA compares homes to similar nearby properties to determine an appropriate valuation. Based on a comparison of property tax assessments to actual sale prices, data shows that property valuations tend to overvalue homes in some neighborhoods and undervalue them in others, resulting in different property tax rates for owners. There are numerous

# Load Property tax analysis webpage
page <- read_html("An Evaluation of Property Tax Regressivity in Jefferson County, Kentucky.html") 

# Extract sales ratio and property tax rate data-for elements
sales_ratio_html = page %>% html_elements('script[data-for="htmlwidget-0527b478a846743b2dd4"]')
property_tax_html = page %>% html_elements('script[data-for="htmlwidget-a1602585f74d11977716"]')

sales_ratio_html %<>% html_text()
property_tax_html %<>% html_text()

# Extract relevant component and split long text strings on commas (by census tract)
sales_ratio_text <- sales_ratio_html %>%
  str_extract('<strong>Census Tract 2, .*300,200(?="])') %>%
  str_split('","')

property_tax_text <- property_tax_html %>%
  str_extract('<strong>Census Tract 2, .*300,200(?="])') %>%
  str_split('","')

# Convert to data frame and extract components using regex
tax_data <- data.frame(
  sales_ratio_raw = sales_ratio_text[[1]],
  property_tax_raw = property_tax_text[[1]])

tax_data %<>%
  mutate(
    # 'Census Tract ' followed by 1-6 characters before a comma
    sr_tract = str_extract(sales_ratio_raw, "(?<=Census Tract ).{1,6}(?=,)"),
    
    # 'Sales in Sample): ' followed by 3-5 characters before %
    sr_ratio = str_extract(sales_ratio_raw, "(?<=Sales in Sample\\)\\: ).{3,5}(?=\\%)"),
    
    # '( ' followed by any number of digits before ')'
    sr_sample = str_extract(sales_ratio_raw, "(?<=\\()\\d*(?=\\))"),
    
    # 'Median Home Value: $' followed by the rest of the string
    home_value = str_extract(sales_ratio_raw, "(?<=Median Home Value\\: \\$).*"),
    
    # 'Percent White Population: ' followed by 3-5 characters before %
    white = str_extract(sales_ratio_raw, "(?<=Percent White Population\\: ).{3,5}(?=\\%)"),
    
    # 'Census Tract ' followed by 1-6 characters before a comma
    pt_tract = str_extract(property_tax_raw, "(?<=Census Tract ).{1,6}(?=,)"),
    
    # 'Sales in Sample): ' followed by 3-5 characters before %
    pt_rate = str_extract(property_tax_raw, "(?<=Sales in Sample\\)\\: ).{3,5}(?=\\%)"),
    
    # '( ' followed by any number of digits before ')'
    pt_sample = str_extract(property_tax_raw, "(?<=\\()\\d*(?=\\))"))

# Check: tract and sample size match across all tracts. TRUE
# all(tax_data$sr_tract == tax_data$pt_tract)
# all(tax_data$sr_sample == tax_data$pt_sample)

# Create tract IDs and clean data frame
tax_data %<>%
  mutate(
    tract_start = 
      str_extract(sr_tract, "\\d{1,3}") %>% 
      str_pad(4, "left", "0"),
    tract_end = 
      str_extract(sr_tract, "(?<=\\.)\\d{1,2}") %>% 
      replace_na("00") %>%
      str_pad(2, "left", "0"),
    tract = paste0("21111", tract_start, tract_end)) %>%
  transmute(
    tract,
    sales_ratio = as.numeric(sr_ratio),
    property_tax = as.numeric(pt_rate),
    sample_size = as.numeric(sr_sample),
    pct_white = as.numeric(white),
    median_value = as.numeric(str_remove(home_value, ",")))

tax_data %<>%
  mutate(
    dif = sales_ratio - 100,
    dif_bins = 
      case_when(dif < -10 ~ "10 to 15% lower",
                dif < -5 ~ "5 to 10% lower",
                dif < 0 ~ "0 to 5% lower",
                dif < 5 ~ "0 to 5% higher",
                dif < 10 ~ "5 to 10% higher") %>%
      factor(levels = c("10 to 15% lower", "5 to 10% lower", "0 to 5% lower", "0 to 5% higher", "5 to 10% higher"), ordered = T),
    sales_ratio_bins = 
      case_when(sales_ratio < 90 ~ "85-90",
                sales_ratio < 95 ~ "90-95",
                sales_ratio < 100 ~ "95-100",
                sales_ratio < 105 ~ "100-105",
                sales_ratio < 110 ~ "105-110") %>%
      factor(levels = c("85-90", "90-95", "95-100", "100-105", "105-110"), ordered = T),
    property_tax_bins = 
      case_when(property_tax == 0.8 ~ "0.8%",
                property_tax == 0.9 ~ "0.9%",
                property_tax == 1.0 ~ "1.0%",
                property_tax == 1.1 ~ "1.1%",
                property_tax == 1.2 ~ "1.2%",
                property_tax == 1.3 ~ "1.3%",
                property_tax == 1.4 ~ "1.4%",
                property_tax == 1.5 ~ "1.5%",) %>%
      factor(levels = c("0.8%", "0.9%", "1.0%", "1.1%", "1.2%", "1.3%", "1.4%", "1.5%"), ordered = T))

pop_data <- glpdata::population_tract %>%
  filter(year ==  2016,
         race %in% c("total", "black"),
         sex == "total") %>%
  select(tract, race, population) %>%
  pivot_wider(names_from = race, values_from = population) %>%
  mutate(percent_black = black / total * 100)

tax_data %<>%
  left_join(pop_data, by = "tract")

jfco_sf %<>%
  left_join(tax_data, by = c("GEOID" = "tract"))

make_map_bins <- function(indicator, 
                     title = "", legend = "", caption = "", 
                     no_legend = FALSE, vir_dir = 1, bins, shapefile){
  plt <- ggplot(shapefile) +
    geom_sf(aes(fill={{ indicator }} )) +
    # scale_fill_gradient(low = "#323844", high = "#d63631", name = "Percent") +
    scale_fill_viridis(na.value = "grey", name = legend, direction = vir_dir,
                       discrete = T) +
    theme_bw(base_size = 22) +
    theme(plot.caption = element_text(lineheight = .5)) +
    theme(text = element_text(family = "Montserrat"),
          panel.grid = element_blank(),
          axis.text = element_blank(),
          axis.ticks = element_blank(),
          axis.title = element_blank(),
          panel.border = element_blank()) +
    labs(title = title,
         caption = caption)

  if (no_legend == TRUE){
    plt <- plt + theme(legend.position = "none")
  }

  plt <- plt +
    theme(
      panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
      plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
      legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
      legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
      legend.key = element_rect(fill = "transparent",colour = NA))

  return(plt)
}

make_map_bins(dif_bins, 
              title = "Assessed Value compared to Market Value",
              bins = c(-15, -10, -5, 0, 5, 10),
              caption = "Source: Greater Louisville Project
                         GLP analysis of data from University of Chicago Harris Public Policy",
              shapefile = jfco_sf)

make_map_bins(property_tax_bins,
         title = "Effective Property Tax Rate",
         legend = "Percent of Home Value",
         caption = "Source: Greater Louisville Project
                    GLP analysis of data from University of Chicago Harris Public Policy",
         shapefile = jfco_sf)

Undervaluation and Overtaxation

This image summarizes the previous two sections (home valuation and property assessments). If homes in Black neighborhoods were valued by the market and taxed by the city like homes in other neighborhoods, homeowners in those neighborhoods would have higher-priced homes taxed at a lower rate.

*This follows Dr. Andre Perry’s (Brookings Institute) methodology in defining a majority Black neighborhood as one with ≥ 50% Black residents.

**The data on the right reflects a home price without devaluation and the average effective property tax rate of white neighborhoods in Louisville. These differences are likely not a completely just or equitable reality, but one that moves us closer to that.

# average property tax vs average property tax in a Black neighborhood
tax_data_bn <- tax_data %>%
  filter(percent_black >=50) %>%
  #summarize(prop_tax = mean(property_tax, na.rm=T))
  summarize(prop_tax = weighted.mean(property_tax, sample_size, na.rm=T)) %>% 
  pull(prop_tax)

t=tax_data %>%
  left_join(glptools::nh_tract) %>%
  group_by(pct_white<50) %>%
  summarize(
    sales_ratio = weighted.mean(sales_ratio, sample_size, na.rm=T),
    
    pct_white = mean(pct_white, na.rm=T))

ggplot(tax_data, aes(x=percent_black, y=sales_ratio)) +
  geom_point() +
  geom_smooth() +
  theme_bw(base_size = 22, base_family = "Montserrat") +
  theme(panel.grid = element_blank(),
        panel.border = element_blank(),
        legend.title = element_blank()) +
  labs(title = "Neighborhoods by Assessment Ratio and Race") +
  theme(
    panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
    plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
    legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
    legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
    legend.key = element_rect(fill = "transparent",colour = NA)) +
  labs(x = "Percent of Residents who are Black",
       y = "Assessment Ratio")

# Method 1: Summarize daata for each group based on Dr. Perry's definitions
nb_sales_ratio <- tax_data %>% 
  filter(percent_black <= 1) %>%
  summarize(output = weighted.mean(sales_ratio, sample_size)) %>%
  pull(output)

black_ratio <- tax_data %>% 
  filter(percent_black >= 50) %>%
  summarize(output = weighted.mean(sales_ratio, sample_size, na.rm=T)) %>%
  pull(output)

# Method 2: Summarize data for each group based on the 10% most- and 10% least-Black neighborhoods
nb_sales_ratio <- tax_data %>% 
  filter(percent_black <= quantile(percent_black, 0.1)) %>%
  summarize(output = weighted.mean(sales_ratio, sample_size)) %>%
  pull(output)

black_ratio <- tax_data %>% 
  filter(percent_black >= quantile(percent_black, 0.9)) %>%
  summarize(output = weighted.mean(sales_ratio, sample_size, na.rm=T)) %>%
  pull(output)

prop_ratio <- nb_sales_ratio / black_ratio * tax_data_bn

# Method 3: model data using splines
library(splines)

t=lm(sales_ratio~bs(percent_black, knots = quantile(tax_data$percent_black, c(0.25, 0.5, 0.75))), data=tax_data)

plot(predict(t, newdata = list(percent_black = c(0:100))),ylim=c(85, 110),type="l")
points(tax_data$percent_black, tax_data$sales_ratio)

predict(t, newdata = list(percent_black = 0))

predict(t, newdata = list(percent_black = 50:100)) %>% mean()

test <- glptools::map_muw

test_pop <- glpdata::population_muw %>%
  filter(year == 2016, sex == "total", race %in% c("black", "total")) %>%
  select(-population_change, -population_change_adj) %>%
  pivot_wider(values_from = population, names_from = race)

test %<>% 
  left_join(test_pop) %>%
  mutate(pct_black = black / total * 100)

leaflet(test) %>%
  addTiles()%>%
  addPolygons(fill = test$pct_black >= 50)
  
library(glptools)

housing_vars_05_5yr <- build_census_var_df("acs5", "B25077")
housing_map <- get_census(filter(housing_vars_05_5yr, year == 2019), "tract")

pop_map <- glpdata::population_tract %>%
  filter(year == 2016, sex == "total", race == "total") %>%
  select(tract, population)

t=housing_map %>%
  select(tract, year, var_type, value) %>%
  pivot_vartype_wider(value) %>%
  left_join(muw_tract, by = "tract") %>%
  left_join(pop_data, by = "tract") %>%
  filter(neighborhood %not_in% c("Airport", "Minor Lane Heights")) %>%
  mutate(
    estimate = if_else(estimate %in% c(9999, -666666666), NA_real_, estimate),
    MOE = if_else(MOE %in% c(-333333333, -222222222), NA_real_, MOE))

black_neighborhood_summary <- t %>%
  group_by(percent_black >= 50) %>%
  summarize(
    #estimate = weighted.mean(estimate, total, na.rm = T),
    estimate = Hmisc::wtd.quantile(estimate, total, probs = 0.5, na.rm = T),
    MOE = sqrt(sum(MOE^2)))

neighborhood_summary <- t %>%
  group_by(neighborhood) %>%
  summarize(
    estimate = weighted.mean(estimate, population),
    MOE = sqrt(sum(MOE^2)))

housing_vars_05_5yr <- build_census_var_df("acs5", "B25082")
housing_map <- get_census(housing_vars_05_5yr, "tract") %>% filter(year == 2017)

t=housing_map %>% 
  filter(label == "Estimate!!Aggregate value (dollars):",
         var_type == "estimate") %>%
  mutate(value = if_else(value == -666666666, NA_real_, value)) %>%
  left_join(pop_data, by = "tract") %>%
  group_by(percent_black >= 50) %>%
  summarize(agg_value = sum(value, na.rm = TRUE))