Posts | Adam Bibler

Income vs. Rent Growth, Part 2

Fri, 04 Oct 2024 00:00:00 +0000

In the previous post, I looked at median gross rent and median household income growth from 2005 - 2023 according to the American Community Survey. But that analysis was only at the national level. What about the state level? Let’s find out.

Again, I’ll pull the median household income and median gross rent from the ACS. But this time I’ll select states. Additionally, I’ll switch to looking at median household income only for renter households. Finally, rather than looking at the full time series, I’ll only pull the starting and ending years.

state_hh_income <- get_ACS("NAME,B25119_003E","state",2005,2005,1)
state_hh_income2 <- get_ACS("B25119_003E","state",2023,2023,1)
state_hh_income$inc05 <- as.numeric(state_hh_income$B25119_003E)
state_hh_income2$inc23 <- as.numeric(state_hh_income2$B25119_003E)
state_hh_income <- cbind(state = state_hh_income$NAME,
inc05 = state_hh_income$inc05,
inc23 = state_hh_income2$inc23)
state_hh_income <- as_tibble(state_hh_income)
state_hh_income <- state_hh_income %>%
mutate(inc_growth = as.numeric(inc23) / as.numeric(inc05) - 1)
state_hh_rent <- get_ACS("B25064_001E,NAME","state",2005,2005,1)
state_hh_rent2 <- get_ACS("B25064_001E","state",2023,2023,1)
state_hh_rent$rent05 <- as.numeric(state_hh_rent$B25064_001E)
state_hh_rent2$rent23 <- as.numeric(state_hh_rent2$B25064_001E)
state_hh_rent <- cbind(state = state_hh_rent$NAME,
rent05 = state_hh_rent$rent05,
rent23 = state_hh_rent2$rent23)
state_hh_rent <- as_tibble(state_hh_rent)
state_hh_rent <- state_hh_rent %>%
mutate(rent_growth = as.numeric(rent23) / as.numeric(rent05) - 1
)
state_income_rent <- merge(state_hh_income, state_hh_rent, by = "state")
state_income_rent <- state_income_rent %>%
mutate(diff = rent_growth - inc_growth)
state_income_rent <- arrange(state_income_rent, desc(diff))
state_income_rent2 <- state_income_rent %>%
select(state, inc_growth, rent_growth, diff) %>%
mutate(across(c("inc_growth", "rent_growth", "diff"), function(x) (paste0(round(x, 4) * 100,"%"))))

States with the largest difference:

knitr::kable(head(state_income_rent2))

state	inc_growth	rent_growth	diff
Arizona	90.42%	124.27%	33.85%
Florida	81.34%	112.48%	31.14%
Hawaii	66.36%	94.97%	28.62%
Delaware	45.8%	71.25%	25.45%
Nevada	63.83%	88.39%	24.56%
Wyoming	61.81%	86.22%	24.41%

Arizona and Florida had some of the fastest rent growth post-Covid, so this makes sense.

States with the smallest difference:

knitr::kable(tail(state_income_rent2))

	state	inc_growth	rent_growth	diff
47	Ohio	74.57%	65.42%	-9.15%
48	Puerto Rico	55.94%	46.58%	-9.37%
49	Vermont	86.61%	75.99%	-10.62%
50	West Virginia	87.45%	75.98%	-11.47%
51	Illinois	80.26%	68.66%	-11.59%
52	District of Columbia	144.39%	128.85%	-15.54%

Let’s redo the national analysis, but this time with the renter median household income.

us_hh_income <- get_ACS("B25119_003E","us",2005,2019,1)
us_hh_income2 <- get_ACS("B25119_003E","us",2021,2023,1)
us_hh_income <- rbind(us_hh_income, us_hh_income2)
us_rent <- get_ACS("B25064_001E","us",2005,2019,1)
us_rent2 <- get_ACS("B25064_001E","us",2021,2023,1)
us_rent <- rbind(us_rent, us_rent2)
us_hh_income$B25119_003E[1]

## [1] "28251"

us_hh_income <- us_hh_income %>%
mutate(income_index = as.numeric(B25119_003E) * 100 / 28251)
rent_start <- us_rent$B25064_001E[1]
us_rent <- us_rent %>%
mutate(rent_index = as.numeric(B25064_001E) * 100/ 728)
rent_income <- inner_join(us_hh_income, us_rent, by = "year")
rent_income$Difference <- rent_income$rent_index - rent_income$income_index
total_change <- rent_income %>%
select(rent_index, income_index, Difference)
total_change <- total_change[18,]
total_change2 <- total_change %>%
mutate(across(everything(), function(x) (paste0(round(x, 2),"%"))))
knitr::kable(total_change2)

rent_index	income_index	Difference
193.13%	183.07%	10.06%

df <- rent_income %>%
select(year, rent_index, income_index) %>%
rename(renter_income_index = income_index) %>%
gather(key = "variable", value = "value", -year)
x <- ggplot(df, aes(x = year, y = value)) +
geom_line(aes(color = variable), size = 1.5) +
scale_color_manual(values = c("Orange", "cyan3")) +
labs(caption = "Source: American Community Survey \n @abibler.bsky.social",
title =
"Median Gross Rent vs. Median Household Income (Renters), \n 2005 = 100") +
ylab("Index") +
xlab("Year") +
theme_minimal() +
scale_y_continuous(breaks=(seq(100, 200, 25)), limits = c(100, 200)) +
theme(legend.title = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
plot.title = element_text(size = 18, face = "bold"))
x

We can see that this time the difference is “only” 10%, and now the difference seems to be more due to the post-Covid rent spike.

Income vs. Rent Growth, 2005 - 2023

Tue, 01 Oct 2024 00:00:00 +0000

Background

The 1-year ACS data was released last month. Every year, the release is exciting to me since it means the time series of available data gets a little longer. As someone interested in rent affordability I thought I would take a look at the overall change in rents and incomes from the inception of the ACS (2005) to the most recent data year (2023).

This analysis will make use of ‘get_ACS’ function, described in an earlier post.

First, get the median household income and median gross rent tables. Because the 2020 ACS data was not released, I split each in to two separate calls.

us_hh_income <- get_ACS("B19013_001E","us",2005,2019,1)
us_hh_income2 <- get_ACS("B19013_001E","us",2021,2023,1)
us_hh_income <- rbind(us_hh_income, us_hh_income2)
us_rent <- get_ACS("B25064_001E","us",2005,2019,1)
us_rent2 <- get_ACS("B25064_001E","us",2021,2023,1)
us_rent <- rbind(us_rent, us_rent2)

Next, get the starting year values, and covert each time series in to an index.

us_hh_income$B19013_001E[1]
us_hh_income <- us_hh_income %>%
mutate(income_index = as.numeric(B19013_001E) * 100 / 46242)
rent_start <- us_rent$B25064_001E[1]
us_rent <- us_rent %>%
mutate(rent_index = as.numeric(B25064_001E) * 100/ 728)

Join the income and rent series together.

rent_income <- inner_join(us_hh_income, us_rent, by = "year")

Look at the total difference between the two.

rent_income$Difference <- rent_income$rent_index - rent_income$income_index
total_change <- rent_income %>% select(rent_index, income_index, Difference)
total_change <- total_change[18,]
total_change2 <- total_change %>%
mutate(across(everything(), function(x) (paste0(round(x, 2),"%"))))
knitr::kable(total_change2)

rent_index	income_index	Difference
193.13%	168.07%	25.06%

Cumulatively, rent has grown 25% more than income. But how does this compare over time?

library(ggplot2)
df <- rent_income %>%
select(year, rent_index, income_index) %>%
gather(key = "variable", value = "value", -year)
x <- ggplot(df, aes(x = year, y = value)) +
geom_line(aes(color = variable), size = 1.5) +
scale_color_manual(values = c("dodgerblue1", "Orange")) +
labs(caption = "Source: American Community Survey \n @abibler.bsky.social",
title =
"Median Gross Rent vs. Median Household Income, \n 2005 = 100") +
ylab("Index") +
xlab("Year") +
theme_minimal() +
scale_y_continuous(breaks=(seq(100, 200, 25)), limits = c(100, 200)) +
theme(legend.title = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
plot.title = element_text(size = 18, face = "bold"))
x

It looks like much of the difference is explained by the great recession, when income fell and rent continued to rise.

Note that this is just at the national level. It would be interesting to look at state differences. Also, this is comparing rent to income, across all types of households (renters and owners). I’ll tackle just renters in a future post.

Voucher Locations Part 1

Thu, 08 Feb 2024 00:00:00 +0000

Background

The Housing Choice Voucher program is the United States’s largest rental assistance program, providing rental subsidies to over 2.3 million households.

Location of Voucher Households

HUD provides geographic data on its assisted households in a variety of ways. HUD’s enterprise GIS service provides voucher locations by Census tract. HUD also provides data on Housing Choice Voucher households (and households in its other direct rental assistance programs) through an annual data set known as the ‘Picture of Subsidized Households.’ For this analysis we’ll look at the Picture data at the state level.

First we’ll want to set up our necessary packages.

# set libraries
library(httr)
library(readxl)
library(rjson)
library(tidycensus)
library(tidyverse)
library(tigris)
#

Next, we’ll download the Picture data.

# # Download Picture of Subsidized Household Data
# # icesTAF::mkdir("Data")
# # download.file("https://www.huduser.gov/portal/datasets/pictures/files/STATE_2023_2020census.xlsx", "Data/STATE_2023_2020census.xlsx", mode = "wb")
#

Then, we’ll read the data in to R and examine it.

#Read in picture data
state_picture <- read_excel("Data/STATE_2023_2020census.xlsx")
#Filter the data to only by the HCV program
vouchers_state <- state_picture %>% filter (program_label == "Housing Choice Vouchers")
#Look at states with the most and least vouchers
vouchers_state <- vouchers_state %>% arrange(desc(number_reported))
head(vouchers_state$States)

## [1] "CA California" "NY New York" "TX Texas" "FL Florida"
## [5] "IL Illinois" "MA Massachusetts"

tail(vouchers_state$States)

## [1] "DE Delaware" "AK Alaska"
## [3] "WY Wyoming" "GU Guam"
## [5] "VI U.S. Virgin Islands" "MP Northern Mariana Islands"

Not surprisingly, California, New York, and Texas have the most voucher households as these states are the most populous. However, the relationship between vouchers and population isn’t quite perfect, as Texas (and Florida) actually have greater populations than New York. We can download population from the Census Bureau and attach it to the HUD data to examine this more closely.

# Get population from the ACS, using the tidycensus package, including a shapefile for mapping
state_population <- get_acs(
geography = "state",
variables = "B01003_001",
year = 2022,
survey = "acs1",
geometry = TRUE,
resolution = "20m"
) %>% shift_geometry()

# Attach the population the the Picture data
vouchers_pop <- inner_join(state_population, vouchers_state, by = c("GEOID" = "code"))
vouchers_pop <- vouchers_pop %>% rename(vouchers = number_reported)
# Plot the voucher data by state
ggplot(data = vouchers_pop, aes(fill = vouchers)) +
geom_sf() +
labs(title = "Vouchers By State",
caption = "Source: HUD Picture of Subsidized Households") +
scale_fill_continuous(name = "", label = scales::comma_format()) +
theme_void()

ggplot(vouchers_pop, aes(x=estimate, y=vouchers)) +
geom_text(label = vouchers_pop$State) +
geom_smooth(method=lm) +
labs(title = "Population vs. Total Vouchers by State")

lmpop <- lm(vouchers ~ estimate, data = vouchers_pop)
summary(lmpop)

##
## Call:
## lm(formula = vouchers ~ estimate, data = vouchers_pop)
##
## Residuals:
## Min 1Q Median 3Q Max
## -60948 -8550 -155 5643 90054
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.868e+03 3.923e+03 -0.476 0.636
## estimate 7.420e-03 4.023e-04 18.444 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 21160 on 50 degrees of freedom
## Multiple R-squared: 0.8719, Adjusted R-squared: 0.8693
## F-statistic: 340.2 on 1 and 50 DF, p-value: < 2.2e-16

Even though population explains about 87% of the variation in Vouchers by State, we see that New York and Massachusetts for example are overrepresented while stats like Texas and Florida are underrepresented.

Of course, Vouchers are not available to anyone but rather to low-income households. It is more likely that differences in low-income population sizes would explain differences in Voucher sizes better than overall population. We can get low-income population estimates from HUD’s Comprehensive Housing Affordability Strategy (CHAS) data.

# Read in the CHAS data
chas_states <- read_csv("Data\\CHAS\\2005thru2009-040-csv\\table1.csv")
#Calculate totals (Adding renters with and without conditions)
chas_states <- chas_states %>% mutate(
fips = substr(geoid, 8, 9),
Total_HHs_LE_30pct = T1_est77 + T1_est113,
Total_HHs_LE_30pct_moe = (T1_moe77^2 + T1_moe113^2)^.5,
Share_HHs_LE_30pct = Total_HHs_LE_30pct / T1_est75,
Total_HHs_LE_50pct = Total_HHs_LE_30pct + T1_est84 + T1_est120,
Total_HHs_LE_50pct_moe = (Total_HHs_LE_30pct_moe^2 + T1_moe84^2 + T1_moe120^2)^.5,
Share_HHs_LE_50pct = Total_HHs_LE_50pct / T1_est75,
Share_HHs_LE_50pct_moe = Total_HHs_LE_50pct_moe / T1_est1,
Total_HHs_LE_80pct = Total_HHs_LE_50pct + T1_est91 + T1_est127,
Share_HHs_LE_80pct = Total_HHs_LE_80pct / T1_est75)
# Attache the CHAS data to the population and Voucher data
pop_program <- inner_join(vouchers_pop, chas_states, by = c("GEOID" = "ST"))
lm_vli <- lm(vouchers ~ Total_HHs_LE_80pct, data = pop_program)
summary(lm_vli)

##
## Call:
## lm(formula = vouchers ~ Total_HHs_LE_80pct, data = pop_program)
##
## Residuals:
## Min 1Q Median 3Q Max
## -41785 -9400 1133 7250 66621
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.276e+03 3.644e+03 -1.722 0.0912 .
## Total_HHs_LE_80pct 4.800e-02 2.305e-03 20.826 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19000 on 50 degrees of freedom
## Multiple R-squared: 0.8966, Adjusted R-squared: 0.8946
## F-statistic: 433.7 on 1 and 50 DF, p-value: < 2.2e-16

#Plot the relationship
ggplot(pop_program, aes(x=Total_HHs_LE_80pct, y=vouchers)) +
geom_text(label = vouchers_pop$State) +
geom_smooth(method=lm) +
labs(title = "Low Income Population vs. Total Vouchers by State")

It turns out that low-income renter population explains the variation in state vouchers only modestly more than overall population.

We can also look at the share of the very low-income population receiving vouchers by state.

pop_program <- pop_program %>% mutate(voucher_share_VLI = vouchers / Total_HHs_LE_50pct)
ggplot(data = pop_program, aes(fill = voucher_share_VLI)) +
geom_sf() +
labs(title = "Vouchers By State",
caption = "Source: HUD Picture of Subsidized Households") +
scale_fill_continuous(name = "", label = scales::comma_format()) +
theme_void()

summary(pop_program$voucher_share_VLI)

## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.02770 0.04459 0.05174 0.06100 0.07199 0.17931

A (Very) Simple Function for Getting Census ACS Data into R

Sat, 23 Apr 2022 00:00:00 +0000

The Census Bureau provides data to the public in a number of ways, the most direct way being through data.census.gov. While data.census.gov has improved since its initial launch, it is still frustrating and lacking in its ability to browse and download data. As one example, it seems that as of April 2022 the American Community Survey (ACS) estimates from 2005-2009 are not available.

The “Years” option only goes back to 2010

Fortunately, the Census Bureau also provides an API for more “sophisticated” users to query and download data. In this post, I share and demonstrate a simple function for downloading ACS data in R via the Census API. Note of course there are entire R packages that do this is as well, like acs and tidycensus. However, if I simply want to grab some data I find this simple function is sufficient.

library(janitor)
library(jsonlite)
library(tidyverse)
get_ACS <- function(vars, geo, start_year, stop_year, vintage) {
out_tibble <- tibble()
years <- seq(from = start_year, to = stop_year)
for (year in years) {
query <- paste0("https://api.census.gov/data/",
year,
"/acs/acs",
vintage,
"?get=",
vars,
"&for=",
geo)
myJSON <- fromJSON(query)
myTibble <- as_tibble(myJSON, name_repail = "minimal")
myTibble <- janitor::row_to_names(myTibble,1)
myTibble <- myTibble %>% mutate(year = year)
out_tibble <- rbind(out_tibble, myTibble)
}
return(out_tibble)
}

Having defined the function we can now use it! Let’s get the estimate of Median Family Income in the United States (Table B19113¹) from 2005-2019.

us_fam_income <- get_ACS("B19113_001E","us",2005,2019,1)
knitr::kable(us_fam_income)

B19113_001E	us	year
55832	1	2005
58526	1	2006
61173	1	2007
63366	1	2008
61082	1	2009
60609	1	2010
61455	1	2011
62527	1	2012
64030	1	2013
65910	1	2014
68260	1	2015
71062	1	2016
73891	1	2017
76401	1	2018
80944	1	2019

Note that the estimate value is being stored as a character variable. The Census uses character codes like “*” to indicate missing or topcoded values. As is often the case, it is necessary to perform additional cleaning after retrieving the data.

For a list of these table codes, see here ↩︎

Exploring Census Household Pulse Survey Part 1

Sun, 30 Jan 2022 00:00:00 +0000

Background

The Census Bureau began the Household Pulse Survey to measure the impacts of the Coronavirus Pandemic on the U.S. Household Population. This post will demonstrate some basics of downloading the data, getting it into R, and doing some simple analysis.

Download this post as an R Markdown file here.

Getting the data

This analysis will be based around using the Public Use File (PUF). The PUF contains the person-level responses to the survey and can be used to produce custom estimates. The PUFs for each week are published at https://www.census.gov/programs-surveys/household-pulse-survey/datasets.html.

The code below will download and unzip the data.

# icesTAF::mkdir("Data")
# download.file("https://www2.census.gov/programs-surveys/demo/datasets/hhp/2020/wk1/HPS_Week01_PUF_CSV.zip", "Data/HPS_Week01_PUF_CSV.zip")
# unzip("Data/HPS_Week01_PUF_CSV.zip", exdir = "Data/HPS_Week01_PUF_CSV")

Working with the data

library(forcats)
library(scales)
library(srvyr)
library(tidyverse)

First, we read in the PUF.

puf <- read_csv(file = "Data/HPS_Week01_PUF_CSV/pulse2020_puf_01.csv")

The PUF contains the PWEIGHT variable to produce (weighted) estimates. In order to calculate standard errors though, we also need the “Replicate Weights” file, attaching it to the PUF.

repweights <- read_csv(file = "Data/HPS_Week01_PUF_CSV/pulse2020_repwgt_puf_01.csv")
puf_w_weights <- inner_join(puf, repweights, by = c("SCRAM","WEEK"))

Now, we convert data frame to survey object. This allows for calculating summary statistics without re-specifying the weight each time.

wgts <- colnames(repweights)[3:length(colnames(repweights))]
survey_puf <- as_survey_rep(puf_w_weights, id = SCRAM, weights = PWEIGHT,
repweights = all_of(wgts), type = "Fay", rho = 0.5005)

And now we should be all set to start analyzing the data. First, let’s make sure we know what we are doing by estimating something that already appears in the Detailed Tables. Specifically, we’ll look at the Housing 2b table. The table states that there are 8,918,242 persons in renter occupied housing units with No Confidence in the Ability to Pay Next Month’s Rent, 12,571,649 with slight confidence, and so on. We can replicate these numbers, adding the category IDs from the data.

renters_payment_confidence <-
survey_puf %>%
filter(WEEK == "1" & TENURE == "3") %>%
group_by(MORTCONF) %>%
survey_count() %>%
mutate_if(is.numeric, round, digits = 0)
renters_payment_confidence$MORTCONF <- factor(renters_payment_confidence$MORTCONF, labels =
c( "Question Seen But Category Not Collected",
"Missing / Did Not Report",
"No Confidence",
"Slight Confidence",
"Moderate Confidence",
"High Confidence",
"Payment Deferred"))
knitr::kable(renters_payment_confidence, format.args = list(big.mark = ","))

MORTCONF	n	n_se
Question Seen But Category Not Collected	170,927	61,811
Missing / Did Not Report	153,139	37,374
No Confidence	8,918,242	377,552
Slight Confidence	12,571,649	374,676
Moderate Confidence	18,070,862	480,523
High Confidence	30,643,777	609,009
Payment Deferred	938,815	153,909

We see that we were able to successfully reproduce the estimates. However, the standard errors are slightly off. (If anyone knows why, please let me know.)

Now we can produce custom estimates. For example, the pulse asks respondents a series of questions about their mental health. Health Table 2a lists Symptoms of Anxiety By Selected Characteristics. However, the respondent’s housing situation is not one of the characteristics.

Let’s look at the symptoms of anxiety for renters.

anxiety_for_all_renters <- survey_puf %>%
filter(WEEK == "1" & TENURE == "3") %>%
group_by(ANXIOUS) %>%
summarise(proportion = survey_mean())
anxiety_for_all_renters$Group <- "All Renters"
anxiety_for_renters_w_no_conf <- survey_puf %>%
filter( WEEK == "1" &
TENURE == "3" &
MORTCONF == "1" ) %>%
group_by(ANXIOUS) %>%
summarise(proportion = survey_mean())
anxiety_for_renters_w_no_conf$Group <- "Renters With No Confidence
in Paying Next Month's Rent"
anxiety_for_renters <- rbind(anxiety_for_all_renters, anxiety_for_renters_w_no_conf)
anxiety_for_renters$ANXIOUS <- factor(anxiety_for_renters$ANXIOUS, labels = c("Missing",
"Not at all",
"Several days",
"More than half the days",
"Nearly every day"))
ggplot(anxiety_for_renters, aes(x = ANXIOUS, y = proportion, fill = Group)) +
geom_bar(stat = "identity", position = "dodge") +
theme(axis.text.x = element_text(angle = 45)) +
xlab("Over the last 7 days, how often have you been bothered by the
following problems: Feeling nervous, anxious, or on edge? Would you
say not at all, several days, more than half the days, or nearly every
day?") +
ylab("Share of Respondants") +
scale_y_continuous(labels = scales::percent)

As might be expected, renters who report not being confident in their ability to pay next month’s rent also report feeling anxious more often.

One thing to note about the Pulse is that tenure (whether the home is owned or rented) is missing for a large number of the respondents.

tenure_w_missing <- survey_puf %>%
filter(WEEK == "1") %>%
group_by(TENURE) %>%
summarise(proportion = survey_mean())
tenure_w_missing$TENURE <- factor(tenure_w_missing$TENURE, labels =
c( "Question Seen But Category Not Collected",
"Missing / Did Not Report",
"Owned free and clear",
"Owned with a mortgage",
"Rented",
"Occupied without payment of rent"))
tenure_w_missing$proportion <- scales::label_percent()(tenure_w_missing$proportion)
tenure_w_missing[,1:2]

## # A tibble: 6 x 2
## TENURE proportion
## <fct> <chr>
## 1 Question Seen But Category Not Collected 0.5%
## 2 Missing / Did Not Report 10.2%
## 3 Owned free and clear 18.3%
## 4 Owned with a mortgage 40.8%
## 5 Rented 28.7%
## 6 Occupied without payment of rent 1.5%

We can see from below that even though tenure is missing for a large share of respondants, the proportion of owners and renters appears in line with that reported in the American Community Survey.

tenure_no_missing <- survey_puf %>%
filter(WEEK == "1" & TENURE != "-88" & TENURE != "-99") %>%
group_by(TENURE) %>%
summarise(proportion = survey_mean())
tenure_no_missing$TENURE <- factor(tenure_no_missing$TENURE, labels =
c( "Owned free and clear",
"Owned with a mortgage",
"Rented",
"Occupied without payment of rent"))
tenure_no_missing$proportion <- scales::label_percent()(tenure_no_missing$proportion)
tenure_no_missing[,1:2]

## # A tibble: 4 x 2
## TENURE proportion
## <fct> <chr>
## 1 Owned free and clear 21%
## 2 Owned with a mortgage 46%
## 3 Rented 32%
## 4 Occupied without payment of rent 2%