Introduction

This memo describes initial data analysis done to identify clusters in the United States where a significant portion of homes are “underwater”, a decade after the sharp decline in home prices during the global financial crisis.

An underwater home is one where the estimated value of a home is lower than the estimated principal balance of the mortgage (negative loan-to-value or LTV).

The analysis also seeks to identify demographic and economic features shared by communities with high rates of negative LTV homes, and to understand how negative LTV rates have changed since 2009, when some communities had a majority of homes with negative LTVs.

Major findings

  • There were more than 10 clusters in the United States with high levels of negative equity in 2019, including parts of suburban and rural Maryland, southern and northern New Jersey, Connecticut, California and more. See the maps for details.
  • Though there are U.S. communities with troubling levels of negative equity, on the whole rates today are nowhere near where they were in 2009.
  • In general, communities with larger minority populations (specifically African-Americans and Hispanics) have higher rates of negative equity. The memo identifies ZIP codes and counties that exemplify this trend.
  • Many communities with the highest rates of underwater mortgages in 2009 are not on the list of problem areas in 2019, but there are exceptions. Prince George’s County, in Maryland, for example, was among the biggest trouble spots in 2009 and remained so in 2019.

Document setup code

Code to set up workspace for data work.

Click “Code” to expand the code block if you’d like to see what’s happening behind the scenes.

# Turn off scientific notation
options(scipen=9999)

## Load packages
# For general data science goodness
library(tidyverse)

# For data cleaning
library(janitor)

# For working with datetime
library(lubridate)

# For reading in Excel files
library(readxl)

# For working with ZIP Codes
library(zipcode)

# For mapping
library(maps)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(leafem)
library(raster)
library(tigris)

# For pulling census data
library(tidycensus)

# For data.world data
library(data.world)

# For correlations
library(corrr)
library(moderndive)
library(Hmisc)
library(broom)

# For graphics
library(scales)
library(ggthemes)
library(DT)
library(ggpubr)

# Function to flatten correlation matrix
flattenCorrMatrix <- function(cormat, pmat) {
  ut <- upper.tri(cormat)
  data.frame(
    row = rownames(cormat)[row(cormat)[ut]],
    column = rownames(cormat)[col(cormat)[ut]],
    cor  =(cormat)[ut],
    p = pmat[ut]
    )
}

# Store secret keys for data.world and tidycensus
# Store token in separate file that's gitignored
source('keys.r')

Data loading and cleaning

For this analysis, we used several data sets that describe:

  • Rates of negative equity in U.S. communities.
  • Demographic features of U.S. communities, including race, income, employment, poverty and ruralness.
  • Features of the housing market in U.S. communities, including home values and changes in home values.

Negative equity rate data

We have several data sets describing negative equity in U.S. communities, via CoreLogic and Zillow, two real estate analytics firms.

  • Topline negative equity share for each U.S. ZIP code in 2019 via CoreLogic.
  • Topline negative equity share for each U.S. county for each month from September 2009 to June 2019 via CoreLogic.
  • Negative equity share for each U.S. county and U.S. ZIP code for Q1 2017, including breakouts for loan-to-value buckets, allowing us to look at extremely underwater borrowers, via Zillow. Q1 2017 is most recent year we have this data, unfortunately.

Note: We are waiting for a third data set from CoreLogic, which they sent to us, but had errors I identified (only had data for four states), of negative equity share of all homes by ZIP code by month-year from 2009-present. We’ve also asked them for LTV bucket breakouts, but they’ve gone radio silent.

To see the code that loads and cleans the data, click “Code” to expand.

# Load negative equity share by county by month-year
underwater_county_month_year <- read_xlsx("../data/input_data/core_logic/negative_equity_share_county.xlsx")

# Clean negative equity share by county by month-year
underwater_county_month_year <- underwater_county_month_year %>%
  # create year column from yyyymm
  mutate(year=str_sub(yyyymm, 1,4)) %>%
  # create month column yyyymm
  mutate(month=str_sub(yyyymm,5,6)) %>%
  # select needed columns
  dplyr::select(state_code, fips_code, state_name, county_name,year, month, yyyymm, percent_negative_equity) %>%
  # fix busted fips codes by converting to character and adding a leading 0 to four digit codes
  mutate(fips_code = as.character(fips_code)) %>%
  mutate(fips_code = case_when(str_length(fips_code) < 5  ~ paste0("0",fips_code),
                                TRUE ~ fips_code)
         ) %>%
  mutate(percent_negative_equity = round(percent_negative_equity*100, 2)) 

# Create negative equity share by county by year, using average of 12 months in a given year as value for year.
underwater_county_year <- underwater_county_month_year %>%
  # Group by county and year
  group_by(state_code, fips_code, state_name, county_name, year) %>%
  # Average 12 months in each year
  summarise(percent_negative_equity = round(mean(percent_negative_equity),2)) %>%
  # Make the long data wide
  spread(year, percent_negative_equity) %>%
  # Fix column names
  rename_at(vars(matches("20")), funs(paste0("pct_negative_equity_y", .)))

# Remove underwater_county_month_year
rm(underwater_county_month_year)

# Load and clean ZIP Code from  2019
# Still need to get from CoreLogic an answer on time period

underwater_zips_2019 <- read_xlsx("../data/input_data/core_logic/corelogic_underwater_homes.xlsx") 

# Clean ZIP code from 2019
underwater_zips_2019 <- underwater_zips_2019 %>%
  # Fix column names
  clean_names() %>%
  # Fix zip codes
  mutate(zip_code = clean.zipcodes(zip_code)) %>%
  # Make negative equity share readable and standardize column name
  mutate(percent_negative_equity = round(share_of_homes_in_negative_equity*100, 2)) %>%
  dplyr::select(-share_of_homes_in_negative_equity)

## From Data.World Zillow Instance, also loading Q1 2017 Negative Equity data, most recent year they've released in detail. Allows us to look at buckets. 
# https://datadotworld.github.io/data.world-r/r-rstudio.html



# Set config
data.world::set_config(saved_cfg)
# https://data.world/zillow-data/all-zillow-metrics-zip-code/workspace/file?filename=Zip%2FBuyerSellerIndex_Zip.csv
# Define path to dataset
negative_equity_summary_url <- "https://data.world/zillow-data/negative-equity-summary"
# Define query to load dataset
negative_equity_summary_query <- data.world::qry_sql("SELECT * FROM NESummary_2017Q1_Public")
# Get data
negative_equity_summary <- data.world::query(negative_equity_summary_query, dataset = negative_equity_summary_url)
# Filter by county
negative_equity_summary_county <- negative_equity_summary %>%
  filter(regiontype == "County")
# Filter by zip
negative_equity_summary_zip <- negative_equity_summary %>%
  filter(regiontype == "Zip")

Demographic and economic data

We pulled race, income and poverty data points for U.S. ZIP Codes and counties from the U.S. Census American Community Survey product for 2017, the most recent available year via the Tidycensus package.

To see the code that loads and cleans the data, click “Code” to expand.

# Load variables for exploration
# acs_variable <- load_variables(2017, "acs5", cache = TRUE)

# Get percent white, percent black, percent hispanic, poverty rate, income data by county

acs_county_white <- get_acs(geography = "county", variables = c("B02001_002"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_white_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_white_2017) %>%
  clean_names()

acs_county_black <- get_acs(geography = "county", variables = c("B02001_003"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_black_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_black_2017) %>%
  clean_names()

acs_county_hispanic <- get_acs(geography = "county", variables = c("B03001_003"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_hispanic_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_hispanic_2017) %>%
  clean_names()

acs_county_poverty <- get_acs(geography = "county", variables = c("B06012_002"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_poverty_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_poverty_2017) %>%
  clean_names()

acs_county_income <- get_acs(geography = "county", variables = c("B19013_001"), geometry = FALSE, survey="acs5", year = 2017) %>%
  dplyr::select(GEOID,NAME, median_household_income_2017 = estimate) %>%
  clean_names()

# Join the variables into a single data frame

acs_data_county <- acs_county_white %>%
  inner_join(acs_county_black) %>%
  inner_join(acs_county_hispanic) %>%
  inner_join(acs_county_poverty) %>%
  inner_join(acs_county_income) %>%
  mutate(pct_white_2017 = round(pct_white_2017*100,2),
         pct_black_2017 = round(pct_black_2017*100,2),
         pct_hispanic_2017 = round(pct_hispanic_2017*100,2),
         pct_poverty_2017 = round(pct_poverty_2017*100,2),
         ) 
  
  
# Get list of fipscodes from Tigris package
fips_codes <- fips_codes %>%
  mutate(fips_code = paste0(state_code,county_code)) 

# Join fips codes to table of census variables
acs_data_county <- acs_data_county %>%
  inner_join(fips_codes, by=c("geoid" = "fips_code"))

# Remove everything except for single acs_data_county table
rm(list=ls(pattern="acs_county"))

# Get percent white, percent black, percent hispanic, poverty rate, income data by ZCTA

acs_zcta_white <- get_acs(geography = "zcta", variables = c("B02001_002"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_white_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_white_2017) %>%
  clean_names()

acs_zcta_black <- get_acs(geography = "zcta", variables = c("B02001_003"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_black_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_black_2017) %>%
  clean_names()

acs_zcta_hispanic <- get_acs(geography = "zcta", variables = c("B03001_003"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_hispanic_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_hispanic_2017) %>%
  clean_names()

acs_zcta_poverty <- get_acs(geography = "zcta", variables = c("B06012_002"), geometry = FALSE, survey="acs5", year = 2017, summary_var ="B01001_001") %>%
  mutate(pct_poverty_2017 = estimate/summary_est) %>%
  dplyr::select(GEOID,NAME,pct_poverty_2017) %>%
  clean_names()

acs_zcta_income <- get_acs(geography = "zcta", variables = c("B19013_001"), geometry = FALSE, survey="acs5", year = 2017) %>%
  dplyr::select(GEOID,NAME, median_household_income_2017 = estimate) %>%
  clean_names()

# Join the variables into a single data frame

acs_data_zcta <- acs_zcta_white %>%
  inner_join(acs_zcta_black) %>%
  inner_join(acs_zcta_hispanic) %>%
  inner_join(acs_zcta_poverty) %>%
  inner_join(acs_zcta_income) %>%
  mutate(pct_white_2017 = round(pct_white_2017*100,2),
         pct_black_2017 = round(pct_black_2017*100,2),
         pct_hispanic_2017 = round(pct_hispanic_2017*100,2),
         pct_poverty_2017 = round(pct_poverty_2017*100,2),
         )
  

# Remove everything except for single acs_data_zcta table

rm(list=ls(pattern="acs_zcta|fips_codes"))

Housing market characteristics data

From the real estate data firm Zillow, we pulled information on current home values, how those values have changed over select time periods, and how they are forecast to change in the coming year. Data is from October 2019 for U.S. ZIP codes and counties.

To see the code that loads and cleans the data, click “Code” to expand.

# https://www.zillow.com/research/data/

# Read in Zillow Region ID to County Crosswalk
zillow_crosswalk <- read_csv("../data/input_data/zillow/CountyCrossWalk_Zillow.csv") %>%
  mutate(fips_code = as.character(FIPS)) %>%
  mutate(fips_code = case_when(str_length(fips_code) < 5  ~ paste0("0",fips_code),
                                TRUE ~ fips_code)
         ) %>%
  dplyr::select(CountyRegionID_Zillow, fips_code) 

# Home values summary for current month (Oct 2019) and historical comparison by county 

county_ZHVI_summary_current_month <- read_csv("../data/input_data/zillow/County_Zhvi_Summary_AllHomes.csv") %>%
  mutate(five_year_pct_change = round(`5Year`*100,2),
         ten_year_pct_change = round(`10Year`*100,2),
         month_pct_change = round(MoM*100,2),
         quarter_pct_change = round(QoQ*100,2),
         year_pct_change = round(YoY*100,2)) %>%
  inner_join(zillow_crosswalk, by=c("RegionID" = "CountyRegionID_Zillow")) %>%
  dplyr::select(fips_code, RegionName, State, Zhvi, month_pct_change, quarter_pct_change, year_pct_change, five_year_pct_change, ten_year_pct_change)


# Home values summary for current month (Oct 2019) and historical comparison by ZIP

Zip_ZHVI_summary_current_month <- read_csv("../data/input_data/zillow/Zip_Zhvi_Summary_AllHomes.csv") %>%
   mutate(five_year_pct_change = round(`5Year`*100,2),
         ten_year_pct_change = round(`10Year`*100,2),
         month_pct_change = round(MoM*100,2),
         quarter_pct_change = round(QoQ*100,2),
         year_pct_change = round(YoY*100,2)) %>%
  dplyr::select(zip_code = RegionName, State, Zhvi,month_pct_change, quarter_pct_change, year_pct_change, five_year_pct_change, ten_year_pct_change)

# Year over year ZHVI forecast current month (Oct 2019), all geographics (long sheet, sted wide)
all_regions_forecasts <- read_csv("../data/input_data/zillow/AllRegionsForePublic-1.csv")

# Create year over year ZHVI forecast just for counties
county_forecasts <- all_regions_forecasts %>%
  filter(Region == "County")

# Create year over year ZHVI forecast just for ZIP
zip_forecasts <- all_regions_forecasts %>%
  filter(Region=="Zip")

# Join county summary plus forecast
county_summary_forecast <- county_ZHVI_summary_current_month %>%
  inner_join(county_forecasts, by=c("State" = "StateName","RegionName" = "CountyName")) %>%
  mutate(forecast_year_pct_change = round(ForecastYoYPctChange,2)) %>%
  dplyr::select(-Region, -RegionName.y, -CityName, -ForecastYoYPctChange) %>%
  rename(zhvi = Zhvi,
         zhvi_month_pct_change = month_pct_change,
         zhvi_quarter_pct_change = quarter_pct_change,
         zhvi_year_pct_change = year_pct_change,
         zhvi_five_year_pct_change = five_year_pct_change,
         zhvi_ten_year_pct_change = ten_year_pct_change,
         zhvi_forecast_year_pct_change = forecast_year_pct_change
         )


# Join ZIP summary plus forecast
zip_summary_forecast <- Zip_ZHVI_summary_current_month %>%
  inner_join(zip_forecasts, by=c("zip_code" = "RegionName")) %>%
  mutate(forecast_year_pct_change = round(ForecastYoYPctChange,2)) %>%
  dplyr::select(-Region, -StateName, -CountyName, -CityName, -ForecastYoYPctChange) %>%
  rename(zhvi = Zhvi,
         zhvi_month_pct_change = month_pct_change,
         zhvi_quarter_pct_change = quarter_pct_change,
         zhvi_year_pct_change = year_pct_change,
         zhvi_five_year_pct_change = five_year_pct_change,
         zhvi_ten_year_pct_change = ten_year_pct_change,
         zhvi_forecast_year_pct_change = forecast_year_pct_change
         )

# For later analysis Time series home values by County and Zip
#county_ZHVI_time_series <- read_csv("../data/input_data/zillow/County_Zhvi_AllHomes.csv")
#Zip_ZHVI_time_series <- read_csv("../data/input_data/zillow/Zip_Zhvi_AllHomes.csv")


## From Data.World Zillow Instance, also loading Q1 2017 Negative Equity data, most recent year they've released in detail. Allows us to look at buckets. 
# https://datadotworld.github.io/data.world-r/r-rstudio.html

# Set config
data.world::set_config(saved_cfg)
# https://data.world/zillow-data/all-zillow-metrics-zip-code/workspace/file?filename=Zip%2FBuyerSellerIndex_Zip.csv
# Define path to dataset
negative_equity_summary_url <- "https://data.world/zillow-data/negative-equity-summary"
# Define query to load dataset
negative_equity_summary_query <- data.world::qry_sql("SELECT * FROM NESummary_2017Q1_Public")
# Get data
negative_equity_summary <- data.world::query(negative_equity_summary_query, dataset = negative_equity_summary_url)
# Filter by county
negative_equity_summary_county <- negative_equity_summary %>%
  filter(regiontype == "County")
# Filter by zip
negative_equity_summary_zip <- negative_equity_summary %>%
  filter(regiontype == "Zip")

# Remove unneeded files
rm(list=c("county_ZHVI_summary_current_month","Zip_ZHVI_summary_current_month", "all_region_forecasts","zip_forecasts", "county_forecasts", "zillow_crosswalk"))

Urban-rural characteristic and unemployment data

We obtained from the USDA a classification system that defines each county on a scale from 1 (most urban) to 9 (most rural). Unemployment data is via Bureau of Labor Statistics, 2018 average by county.

To see the code that loads and cleans the data, click “Code” to expand.

# County rural urban code designation from USDA
# Spectrum from 1 (most urban) to 9 (most rural)
rural_urban <- read_xls("../data/input_data/rural_urban_codes/ruralurbancodes2013.xls") %>%
  rename(fips_code = FIPS)

# Unemployment by county from BLS 2018
unemployment <- read_xlsx("../data/input_data/bls/laucnty18.xlsx") %>%
  mutate(fips_code = paste0(state_fips,county_fips)) %>%
  dplyr::select(fips_code, county_state, unemployment_rate_2018 = unemployment_rate)

Create final data frames

The following code block creates the four tables we use most extensively in this analysis, two for ZIP codes and two for counties. For each geography, there’s a version which has been joined to the information from Zillow about home values and change in home values over time. Unfortunately, that data was not available for all counties and ZIP codes, so joining it gives us a smaller subset of counties/ZIPs to work with when we examine housing market characteristics. In general, Zillow data is more available for larger counties.

  • underwater_county_year_no_zillow: includes 2446 counties.
  • underwater_county_year_yes_zillow: includes 1447 counties.
  • underwater_zips_2019_no_zillow: includes 28989 ZIP codes
  • underwater_zips_2019_yes_zillow: includes 13729 ZIP codes

We also have the Q1 2017 data from Zillow with detailed loan-to-value buckets.

  • negative_equity_summary_county: includes 2340 counties.
  • negative_equity_summary_zip: includes 21697 ZIP codes.

To see the code that loads and cleans the data, click “Code” to expand.

## Make county data frames (2009-2019 time series)

# Underwater data, census data, rural data - 2446 counties
underwater_county_year_no_zillow <- underwater_county_year %>%
  ungroup() %>%
  inner_join(rural_urban) %>%
  dplyr::select(-State,-Population_2010, -County_Name, -Description) %>%
  inner_join(acs_data_county, by=c("fips_code" = "geoid")) %>%
  dplyr::select(fips_code, state_name = state_name.x, county_name, starts_with("RUCC"), starts_with("pct"), starts_with("median")) %>%
  inner_join(unemployment) %>%
  dplyr::select(-county_state)

# Underwater data, census data, rural data, Zillow data - 1477 counties 
underwater_county_year_yes_zillow <- underwater_county_year_no_zillow %>%
  inner_join(county_summary_forecast) %>%
  dplyr::select(-RegionName, -State) 

## Make ZIP Code dataframes (2019 only)

# Underwater data, census data - 28989 zip codes
underwater_zips_2019_no_zillow <- underwater_zips_2019 %>%
  ungroup() %>%
  inner_join(acs_data_zcta, by=c("zip_code" = "geoid")) %>%
  dplyr::select(zip_code, everything(),-name) 

# Underwater data, census data, Zillow data - 13729 zip codes

underwater_zips_2019_yes_zillow <- underwater_zips_2019_no_zillow %>%
  inner_join(zip_summary_forecast) %>%
  dplyr::select(-State) 

rm(list=setdiff(ls(), c("underwater_zips_2019_no_zillow", "underwater_zips_2019_yes_zillow", "underwater_county_year_no_zillow", "underwater_county_year_yes_zillow", "flattenCorrMatrix", "negative_equity_summary_county", "negative_equity_summary_zip")))

Load shapefiles

To make the maps later, we’ll need U.S. county and ZIP code shapes.

To see the code that loads and cleans the data, click “Code” to expand.

#ZCTAs can take several minutes to download.  To cache the data and avoid re-downloading in future R sessions, set `options(tigris_use_cache = TRUE)`
options(tigris_use_cache = TRUE)

# ZIP Code Points
data(zipcode)

# ZCTA shapefiles
zctas <- zctas(cb=TRUE)

# Counties
counties <- counties(cb = TRUE)

Detailed Findings

The rest of this document describes findings of our analysis in detail.

Negative equity clusters in 2019

Though negative equity rates are nowhere near 2009 levels, the analysis identified 10 prominent clusters with higher negative equity rates relative to the rest of the country.

In the map below, click on the two-letter buttons at right to zoom to that cluster. Only ZIPs with negative equity above 5% are shown.

Click on each ZIP code shape to see detailed data for that ZIP code.

Here are the clusters that jumped out to me. You may see others.

  • MD1 | Maryland+DC | Cluster of ZIP codes in Prince George’s County and Anacostia in D.C. and down through Waldorf, in Charles County.
  • MD2 | Maryland Eastern Shore | Huge chunks of the lower Eastern Shore, through Salisbury and Ocean City.
  • NJ1 | South New Jersey | Large swaths of southern New Jersey, including Atlantic City, Philly suburbs.
  • NJ2 | North Jersey+NYC | New York City suburbs, including Newark, Elizabeth, Paterson, parts of Queens
  • CT | Connecticut | Several areas, including Hartford and Waterbury, Bridgeport and New Haven, up to Rhode Island border.
  • IA | Iowa | a bunch of communities in Iowa with no real clusters. Can’t make heads or tails of this.
  • FL | Florida | Worst issues in Miami, Hialeah and Homestead, scattered parts of the state.
  • IL | Chicago | Huge issues surrounding Chicago, especially on South Side.
  • CA | California | Issues in Fresno, south of Monterey, scattered throughout.
  • NV | Las Vegas
  • No buttons, but interesting | Baton Rouge, New Orleans, Atlanta, North Dakota. Use manual zoom with +/-

To see the code that makes this map, click “Code” to expand.

# Filter for only high negative equity zip codes
high_negative_equity_zips <- underwater_zips_2019_no_zillow %>%
  filter(percent_negative_equity >= 5)

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_zips_geo <- geo_join(zctas, high_negative_equity_zips, 'GEOID10', 'zip_code', 
how = "inner")

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_zips_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_zips_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity), 
             values = high_negative_equity_zips_geo$percent_negative_equity,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

Below is a table with the same information that populates the map, for exploration. Scroll to the right to see more columns.

To see the code that makes this table, click “Code” to expand.

datatable(high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: ZIP codes with negative equity >= 5%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

Instead of ZIP codes, this map shows county-level averages. There were 89 counties with a negative equity rate above 4 percent in 2019, as shown on this map.

In the map below, click on the two-letter buttons at right to zoom to that cluster.

Click on each county to see detailed data for that county.

To see the code that makes this map, click “Code” to expand.

# Filter for 2019
high_negative_equity_county_2019 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2019) %>%
  filter(pct_negative_equity_y2019 >= 4) %>%
  arrange(desc(pct_negative_equity_y2019))

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2019_geo <- geo_join(counties, high_negative_equity_county_2019, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_county_2019_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2019_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

Below is a table with the same information that populates the map, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

Negative equity clusters in 2009

For comparison, this is every county in the U.S. in 2009 with a negative equity rate above 4 percent, 654 counties in total. The negative equity problem was much more widespread following the financial crisis.

Click on each county to see detailed data for that county.

To see the code that makes this map, click “Code” to expand.

# Filter for 2009
high_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
  filter(pct_negative_equity_y2009 >= 4) %>%
  arrange(desc(pct_negative_equity_y2009))

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2009_geo <- geo_join(counties, high_negative_equity_county_2009, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_county_2009_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2009_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_negative_equity_county_2009_geo$pct_negative_equity_y2009,
    title = "% Homes Negative Equity 2009",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

Below is a table with the same information that populates the map, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(high_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2009: Counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

In order to see where the problem was most pronounced in 2009, this map shows the top 89 negative equity rate counties in 2009. That’s the same number above 4 percent in 2019 (shown on the second map above). But, of course, the rates were much higher for these 89 counties in 2009.

Click on each county to see detailed data for that county.

To see the code that makes this map, click “Code” to expand.

# Filter for 2009
top_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
  arrange(desc(pct_negative_equity_y2009)) %>%
  head(n=89)

# Join zip code coordinates to negative equity by zipcode
top_negative_equity_county_2009_geo <- geo_join(counties, top_negative_equity_county_2009, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", top_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)

# Draw map
leaflet(top_negative_equity_county_2009_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(top_negative_equity_county_2009_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addLegend("bottomleft", 
             pal = binpal, 
             values =top_negative_equity_county_2009_geo$pct_negative_equity_y2009,
    title = "% Homes Negative Equity 2009",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

Below is a table with the same information that populates the map, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(top_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2009: 89 Counties with highest negative equity rates'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

Problem counties in 2009 and 2019

There’s not a lot of crossover between problematic counties in 2009 and 2019. Only 13 counties that were on the list of the highest negative equity counties in 2009 were also there in 2019, including two Maryland counties.

To see the code that makes this table, click “Code” to expand.

on_both <- top_negative_equity_county_2009 %>%
  inner_join(high_negative_equity_county_2019, by=c("fips_code", "county_name", "state_name", "pct_negative_equity_y2009", "pct_negative_equity_y2019")) %>%
  dplyr::select(fips_code, county_name, state_name, pct_negative_equity_y2009, pct_negative_equity_y2019)

on_both
#datatable(on_both, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
#    style = 'caption-side: bottom; text-align: left;',
#    'County with highest rates in 2019 and 2009'
#  ),
#  extensions = 'FixedColumns',
#  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
#)

2019 is not nearly as bad as 2009

On average, underwater rates are nowhere near as high as they were in the years immediately following the crash of the housing market.

In 2009, the average U.S. county had 5.5 percent of homes in negative equity, compared to 1.62 last year. A large number of very high negative equities skewed the mean in 2009. The median differences were much less pronounced.

In 2009, the median U.S. county had 2.2 percent of homes in negative equity, compared to 1.3 percent in 2019.

To see the code that makes this table, click “Code” to expand.

x <- underwater_county_year_no_zillow %>%
  pivot_longer(cols=c("pct_negative_equity_y2009", "pct_negative_equity_y2010", "pct_negative_equity_y2011", "pct_negative_equity_y2012","pct_negative_equity_y2013","pct_negative_equity_y2014","pct_negative_equity_y2015","pct_negative_equity_y2016","pct_negative_equity_y2017","pct_negative_equity_y2018","pct_negative_equity_y2019"), names_to = "year", values_to = "percent_negative_equity") %>%
  group_by(year) %>%
  filter(!is.na(percent_negative_equity)) %>%
  summarise(mean_percent_negative_equity = round(mean(percent_negative_equity),2),
    median_percent_negative_equity = round(median(percent_negative_equity),2)
            )

x
#datatable(x, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
#    style = 'caption-side: top; text-align: left;',
#    'Mean and median negative equity county rates by year 2009 and 2019'
#  ),
#  options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 11)
#)

Disproportionate racial impact

There’s a clear trend: places with higher rates of negative equity tend to have a higher proportion of minorities, specifically African-Americans and Hispanics. Places that are whiter tend to have lower rates of negative equity.

The table divides each U.S. ZIP code into one of two buckets by negative equity rate: greater than or equal to 4 percent and less than 4 percent. It then calculates the average percentage for each racial group in each bucket.

The percentage of African-Americans and Hispanics in the high negative equity bucket was nearly double the percentages in the low negative equity bucket.

To see the code that makes this table, click “Code” to expand.

# Average table
underwater_zips_2019_no_zillow %>%
  mutate(negative_equity_group = case_when(percent_negative_equity >= 4 ~ "greater than or equal to 4",
                                      TRUE ~ "less than 4")
         ) %>%
  filter(!is.na(pct_black_2017), !is.na(median_household_income_2017)) %>%
  group_by(negative_equity_group) %>%
  summarise(pct_black_2017 = round(mean(pct_black_2017),2),
            pct_white_2017 = round(mean(pct_white_2017),2),
            pct_hispanic_2017 = round(mean(pct_hispanic_2017),2),
            median_household_income_2017 = round(mean(median_household_income_2017),2)) 
#%>%
#    datatable(class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
#    style = 'caption-side: bottom; text-align: left;',
#    'Racial groups by negative equity bucket'
#  ),
#  extensions = 'FixedColumns',
#  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 1))
#)

We can also group each ZIP code into one of two buckets: greater than 50 percent white and less than 50 percent white. The negative equity rate in the “not majority white” ZIPs is about 50 percent higher than in majority white ZIPs.

To see the code that makes this table, click “Code” to expand.

# Average table
underwater_zips_2019_no_zillow %>%
  mutate(population_makeup= case_when(pct_white_2017 > 50 ~ "majority white",
                                      TRUE ~ " not majority white")
         ) %>%
  filter(!is.na(percent_negative_equity)) %>%
  group_by(population_makeup) %>%
  summarise(percent_negative_equity = round(mean(percent_negative_equity),2)) 
#%>%
#  datatable( class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
#    style = 'caption-side: bottom; text-align: left;',
#    'County with highest rates in 2019 and 2009'
#  ),
#  extensions = 'FixedColumns',
#  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
#)

We can also examine the subset of the highest negative equity ZIPs, (>= 4%).

By doing that, we see that there is a significant relationship between a ZIP code’s negative equity rate and the racial makeup of its population.

That’s not to say that racial makeup causes these differences, just that there’s an observed relationship that indicates the two variables move somewhat in tandem. It’s part of the evidence for our claim that the negative equity problem is hitting minority areas harder; in minority-heavy areas, negative equity rates tend to be higher.

The relationship is weak-to-moderate, but statistically significant (all less than p <.05). An r (correlation coefficient) of 1 indicates a perfect positive correlation, 0 indicates no correlation, and -1 indicates a perfect negative correlation, we see the following:

  • As the percentage of whites increases, negative equity rates decline (r=-.39)
  • As the percentage of blacks increases, negative equity rates rise (r=.32)
  • As the percentage of Hispanics increases, negative equity rates rise (r=.3)

For a good discussion, read these two links:

To see the code that makes this table, click “Code” to expand.

# Correlation for higher rate counties
underwater_zips_2019_no_zillow_trimmed <- underwater_zips_2019_no_zillow %>%
  dplyr::select(-zip_code,-state_name,-county_name) %>%
  filter(percent_negative_equity >=4)  

# Create correlation matrix
underwater_zips_2019_no_zillow_correlation_matrix <- rcorr(as.matrix(underwater_zips_2019_no_zillow_trimmed))

# Flatten correlation table, to only include significant predictors p < .05
underwater_zips_2019_no_zillow_correlation_matrix <- flattenCorrMatrix(underwater_zips_2019_no_zillow_correlation_matrix$r, underwater_zips_2019_no_zillow_correlation_matrix$P) %>%
  mutate(absolute_cor = abs(cor)) %>%
  filter(row == "percent_negative_equity") %>%
  filter(p < .05) %>%
  arrange(desc(absolute_cor)) %>%
  dplyr::select(-absolute_cor)

# Print correlation matrix.  Let's us see both r (correlation coefficient) and p value for each predictor on an individual level
underwater_zips_2019_no_zillow_correlation_matrix %>%
  filter(str_detect(column,"white|black|hispanic")) %>%
  mutate(var_1 = row, var_2 = column, cor_coef_r = cor, det_coef_r2 = cor*cor, sig_p = p ) %>%
  dplyr::select(var_1:sig_p)

The graph below plots each ZIP code as a dot, with locations determined by the ZIP code’s black population percentage (y axis) and negative equity rate (y axis).

The blue trend line helps us understand the relationship between the two variables. It says that, on the whole, for every 2.9 percent increase in the black population, we see a 1 percent increase in an area’s negative equity rate.

To see the code that makes this graph, click “Code” to expand.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_black_2017", add="reg.line", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x =20, label.y = 15) + 
  stat_regline_equation(label.x = 20, label.y = 32)

There’s a similar trend for Hispanics. For every 2.6 percent increase in the Hispanic population, we see a 1 percent increase in an area’s negative equity rate.

To see the code that makes this graph, click “Code” to expand.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_hispanic_2017", add="reg.line", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x =15, label.y = 15) + 
  stat_regline_equation(label.x = 15, label.y = 32)

As one might expect, the opposite is true for whiter areas. For every 4 percent increase in the white population, there’s a 1 percent decrease in the negative equity rate.

To see the code that makes this graph, click “Code” to expand.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_white_2017", add="reg.line", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x =15, label.y = 15) + 
  stat_regline_equation(label.x = 15, label.y = 32)

The disproportionate impact of negative equity in minority neighborhoods has been flagged by other researchers in the past.

These two papers, in particular, are worth reading:

Our analysis identified target ZIP codes where reporting could be focused that are emblematic of the larger trend towards higher rates of negative equity in minority neighborhoods.

For majority black neighborhoods, this includes:

  • 11208 in Brooklyn, a majority black neighborhood with 26% negative equity;
  • 07062 (in Plainfield), 07108 (Newark), 07114 (Newark). These north New Jersey neighborhoods all have greater than 16% negative equity.
  • A cluster of nine ZIP codes in Chicago with greater than 15% negative equity;
  • A ton more examples, if you look at the map and table below, which are all majority black neighborhoods.

This map shows majority black ZIP codes with a negative equity rate above 5%.

To see the code that makes this map, click “Code” to expand.

# Filter for only majority black high negative equity zip codes
maj_black_high_negative_equity_zips <- high_negative_equity_zips %>%
  filter(pct_black_2017 > 50) 

# Join zip code coordinates to negative equity by zipcode
maj_black_high_negative_equity_zips_geo <- geo_join(zctas, maj_black_high_negative_equity_zips, 'GEOID10', 'zip_code', how = "inner")

# Color Scheme
binpal <- colorBin("plasma", maj_black_high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)

# Draw map
leaflet(maj_black_high_negative_equity_zips_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(maj_black_high_negative_equity_zips_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = colorBin("plasma", maj_black_high_negative_equity_zips_geo $percent_negative_equity), 
             values = maj_black_high_negative_equity_zips_geo$percent_negative_equity,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(maj_black_high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Majority black ZIP codes with negative equity >= 5%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

At the county level, several areas with large African-American populations (>= 20%) have high negative (>4%) equity rates, including:

  • Five Maryland counties/city: Prince George’s, Baltimore (city), Charles, Somerset and Dorchester
  • Seven counties/cities in Virginia.
  • More in the map below.

To see the code that makes this map, click “Code” to expand.

# Filter for only large black population high negative equity counties
high_black_high_negative_equity_county_2019 <- high_negative_equity_county_2019 %>%
  dplyr::select(fips_code, state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_black_2017)) %>%
  filter(pct_black_2017 >= 20) 

# Join zip code coordinates to negative equity by zipcode
high_black_high_negative_equity_county_2019_geo <- geo_join(counties, high_black_high_negative_equity_county_2019, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_black_high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)

# Draw map
leaflet(high_black_high_negative_equity_county_2019_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_black_high_negative_equity_county_2019_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_black_high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(high_black_high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: High black pop counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

Our analysis identified target ZIP codes where reporting could be focused that are emblematic of the larger trend towards higher rates of negative equity in Hispanic neighborhoods, too.

This includes:

  • A cluster of five ZIP codes in Chicago with greater than 14% negative equity;
  • Two neighborhoods in Connecticut (06608, 06114)
  • Two neighborhoods in Fresno, California (93606, 93702)
  • Many more examples in the table below, including several Maryland ZIPs.

To see the code that makes this map, click “Code” to expand.

# Filter for only majority black high negative equity zip codes
maj_hispanic_high_negative_equity_zips <- high_negative_equity_zips %>%
  filter(pct_hispanic_2017 > 50) 

# Join zip code coordinates to negative equity by zipcode
maj_hispanic_high_negative_equity_zips_geo <- geo_join(zctas, maj_hispanic_high_negative_equity_zips, 'GEOID10', 'zip_code', how = "inner")

# Color Scheme
binpal <- colorBin("plasma", maj_hispanic_high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)

# Draw map
leaflet(maj_hispanic_high_negative_equity_zips_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(maj_hispanic_high_negative_equity_zips_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = colorBin("plasma", maj_hispanic_high_negative_equity_zips_geo $percent_negative_equity), 
             values = maj_hispanic_high_negative_equity_zips_geo$percent_negative_equity,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(maj_hispanic_high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Majority Hispanic ZIP codes with negative equity >= 5%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

At the county level, several areas with large Hispanic populations (>= 20%) have high negative (>4%) equity rates, including:

  • Miami-Dade in Florida
  • Several counties in California and New Jersey

To see the code that makes this map, click “Code” to expand.

# Filter for only large hispanic population high negative equity counties
high_hispanic_high_negative_equity_county_2019 <- high_negative_equity_county_2019 %>%
  dplyr::select(fips_code, state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_hispanic_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_hispanic_2017)) %>%
  filter(pct_hispanic_2017 >= 20) 

# Join zip code coordinates to negative equity by zipcode
high_hispanic_high_negative_equity_county_2019_geo <- geo_join(counties, high_hispanic_high_negative_equity_county_2019, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_hispanic_high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)

# Draw map
leaflet(high_hispanic_high_negative_equity_county_2019_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="hispanic", popup = popupTable(high_hispanic_high_negative_equity_county_2019_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_hispanic_high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(high_hispanic_high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: High hispanic pop counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

This is not to say that only majority-minority areas are affected.

There are hundreds of examples of overwhelmingly white neighborhoods (greater than 90% white) with high rates, including parts of Connecticut, Arizona, Iowa, New Jersey, Maryland and others.

See the map below.

To see the code that makes this map, click “Code” to expand.

# Filter for only majority black high negative equity zip codes
super_maj_white_high_negative_equity_zips <- high_negative_equity_zips %>%
  filter(pct_white_2017 > 90) 

# Join zip code coordinates to negative equity by zipcode
super_maj_white_high_negative_equity_zips_geo <- geo_join(zctas, super_maj_white_high_negative_equity_zips, 'GEOID10', 'zip_code', how = "inner")

# Color Scheme
binpal <- colorBin("plasma", super_maj_white_high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)

# Draw map
leaflet(super_maj_white_high_negative_equity_zips_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(super_maj_white_high_negative_equity_zips_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = colorBin("plasma", super_maj_white_high_negative_equity_zips_geo $percent_negative_equity), 
             values = super_maj_white_high_negative_equity_zips_geo$percent_negative_equity,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(super_maj_white_high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Supermajority white ZIP codes with negative equity >= 5%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

At the county level, places with supermajority white populations (>=66%) that have high negative equity rates (>=4%) include:

  • Several Iowa counties Illinois counties.
  • Parts of Maryland, New Jersey, Connecticut and Massachusetts.
  • Several others

To see the code that makes this map, click “Code” to expand.

# Filter for only large black population high negative equity counties
veryhigh_white_high_negative_equity_county_2019 <- high_negative_equity_county_2019 %>%
  dplyr::select(fips_code, state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_black_2017)) %>%
  filter(pct_white_2017 >= 75) 

# Join zip code coordinates to negative equity by zipcode
veryhigh_white_high_negative_equity_county_2019_geo <- geo_join(counties, veryhigh_white_high_negative_equity_county_2019, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", veryhigh_white_high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)

# Draw map
leaflet(veryhigh_white_high_negative_equity_county_2019_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(veryhigh_white_high_negative_equity_county_2019_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = binpal, 
             values = veryhigh_white_high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

This table shows the same information as the map above, for exploration.

To see the code that makes this table, click “Code” to expand.

datatable(veryhigh_white_high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Very white counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 3))
)

Property market characteristics

Counties with higher levels of negative equity have higher median home values, as measured by the Zillow Home Value Index (zhvi).

But property values in these areas are also growing more slowly, as measured by changes in the zillow home value index from the previous month, quarter and year. They are also forecast to grow slower in the next year. This is not to say that negative equity rates caused these trends, just that there are observable differences between the two.

To see the code that makes this table, click “Code” to expand.

x <- underwater_county_year_yes_zillow %>%
   mutate(negative_equity = case_when(pct_negative_equity_y2019 >= 4 ~ "neg_equity >= 4%",
                                     TRUE ~ "neg_equity < 4%"
                                     )) %>%
  group_by(negative_equity) %>%
  summarise(zhvi = round(mean(zhvi),2),
            zhvi_month_pct_change = round(mean(zhvi_month_pct_change),2),
            zhvi_quarter_pct_change = round(mean(zhvi_quarter_pct_change),2),
            zhvi_year_pct_change = round(mean(zhvi_year_pct_change),2),
            zhvi_five_year_pct_change = round(mean(zhvi_five_year_pct_change),2),
            zhvi_ten_year_pct_change = round(mean(zhvi_ten_year_pct_change),2),
            zhvi_forecast_year_pct_change = round(mean(zhvi_forecast_year_pct_change),2),
            ) 

datatable(x, class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    '2019: Very white counties with negative equity >= 4%'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 1)))

Prior year negative equity relationship

It’s fairly easy to predict a county’s negative equity rate in 2019 based on its negative equity rate in 2018. If it was high in 2018, it was – with few exceptions – high in 2019. Things don’t change that much from year to year.

As the table below shows, the correlation coefficient (r) between negative equity rates in 2019 and 2018 was .98, which is about as strong as it gets.

But this trend diminishes over time. The relationship between negative equity rates in 2019 and the rates a decade earlier, in 2009, was only weak-moderate (.41).

Put another way, just because a county had a high negative equity rate in 2009, it’s not a guarantee that it had a high negative equity rate in 2019.

To see the code that makes this table, click “Code” to expand.

underwater_county_year_yes_zillow %>%
  dplyr::select(-matches("code|state|name|county|date|region|Metro|County|City|Month|Quarter|Last|Time|Description")) %>%
  correlate(method = c("pearson")) %>%
  dplyr::select(-RUCC_2013, -pct_negative_equity_y2009:-pct_negative_equity_y2018, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  filter(!str_detect(rowname,"RUCC|_2017|_2018|2019|zhvi")) %>%
  mutate(corr_with_pct_negative_equity_y2019 = round(pct_negative_equity_y2019, 2)) %>%
  dplyr::select(-pct_negative_equity_y2019) %>%
  arrange(desc(rowname)) %>%
  datatable(class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    'correlations with pct_neg_equity_2019'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 1)))

But, there are places that were at the epicenter of the problem in 2009 and were still there a decade later, in 2019.

This table normalizes the specific negative equity rates for each county in 2009 and 2019 by ranking them on a scale from 0 (lowest rates) to 100 (highest rates), allowing us to more easily compare across years.

Places that were bad in 2009 and still bad in 2019 include: * Charles County and Prince George’s County, Maryland, which were in the top 99 percent in both 2009 and 2019. * Osceola County and Miami-Dade County, Florida, which were both in the top 97 percent in both years.

To see the code that makes this table, click “Code” to expand.

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(mean_2009_2019_negative_equity_rank = (pct_negative_equity_y2009_rank+pct_negative_equity_y2019_rank)/2) %>%
  dplyr::select(state_name, county_name, mean_2009_2019_negative_equity_rank, everything()) %>%
  arrange(desc(mean_2009_2019_negative_equity_rank)) %>%
  datatable(class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    'Consistently bad places, 2009-2019'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 2)))

There are also places that were among the worst in 2009 that now have some of the country’s lowest rates.

This includes several counties in California (perhaps because home prices have appreciated so fast)? Take Alameda County, California.

It’s negative equity rate was in the 90th percentile in 2009. In 2019, it was among the lowest in the U.S. (1st percentile).

To see the code that makes this table, click “Code” to expand.

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
  dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
  arrange(desc(negative_equity_rank_change_2009_2019)) %>%
  filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
  datatable(class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    'places that improved dramatically'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 2)))

The opposite is also true. Many places weren’t problematic in 2009 that are now.

Consider a place like Woodford County, Illinois.

It had one of the lowest rates of negative equity in 2009 (3rd percentile).

In 2019, it’s in the 96th percentile.

To see the code that makes this table, click “Code” to expand.

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
  dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
  arrange(negative_equity_rank_change_2009_2019) %>%
  filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
  datatable(class = 'cell-border stripe', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-align: left;',
    'correlations with pct_neg_equity_2019'
  ),
  extensions = 'FixedColumns',
  options = list(scrollX=TRUE, scrollCollapse=TRUE,fixedColumns = list(leftColumns = 2)))

Loan to Value Buckets

We have data from 2017 (nothing later) via Zillow that has loan to value buckets for each county and ZIP code. I’m still working on analyzing this.

Here’s raw the data for counties.

negative_equity_summary_county

Here’s the raw data for ZIP codes. Note that output is truncated to 10K rows.

negative_equity_summary_zip

-30-