Relationship between Division-Level Household Income and Division-Level Home Ownership Rates.

The following data shows the relationship between the percentage of people who own a home and the amount of income they make for the counties of Williamson, Rutherford, and Davidson. The relationship is strong, meaning that the counties shown with the most income will also be the county with the most homeowners. looking at the scatter-plot, you will plainly see that Williamson (noted by the green dots) has the majority of the space at the top of the graph. Williamson is far and away the most urban area shone with the most wealthy people, so it makes sense that they would also have the most people that own a home, at least out of these three counties. While Davidson and Rutherford, more rural areas of Tennessee, don’t have a lot of people that make huge income, so not a ton of people in those areas own homes. Looking at the box-plot the story is the same.

Code

# ----------------------------------------------------------
# Step 1: Install required packages (if missing)
# ----------------------------------------------------------

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("plotly"))
  install.packages("plotly")

# ----------------------------------------------------------
# Step 2: Load libraries
# ----------------------------------------------------------

library(tidyverse)
library(plotly)

# ----------------------------------------------------------
# Step 3: Read data from CSV file
# ----------------------------------------------------------

mydata <- read_csv(
  "https://raw.githubusercontent.com/drkblake/Data/main/MGRData.csv"
)

Histogram <- plot_ly(
  data = mydata,
  x = ~ Ownership,
  type = "histogram",
  nbinsx = 10,
  opacity = 0.6,
  marker = list(
    color = "#4C78A8",
    line = list(color = "black", width = 1)
  )
) %>%
  layout(
    title = "Distribution of Home Ownership",
    xaxis = list(title = "Home Ownsership (%)"),
    yaxis = list(title = "Number of Districts")
  )

Histogram

Boxplot <- plot_ly(
  data = mydata,
  x = ~County,
  y = ~Ownership,        
  type = "box",
  color = ~County,
  colors = c(
    "Davidson"   = "#d73027",
    "Rutherford" = "#fc8d59",
    "Williamson" = "#1a9850"
  ),
  boxpoints = "outliers",
  opacity = 0.8
) %>%
  layout(
    title = "Home Ownership Rate by County",  
    xaxis = list(title = "County"),
    yaxis = list(title = "Home Ownership Rate (%)"),  
    showlegend = FALSE   # optional, since x-axis already labels groups
  )

Boxplot

Scatterplot <- plot_ly(
  data = mydata,
  x = ~Med_Income,
  y = ~Ownership,          
  type = "scatter",
  mode = "markers",
  text = ~County,
  hoverinfo = "text+x+y",
  color = ~County,
  colors = c(
    "Davidson"   = "#d73027",
    "Rutherford" = "#fc8d59",
    "Williamson" = "#1a9850"
  ),
  marker = list(
    size = 8,
    opacity = 0.7
  )
) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    x = ~Med_Income,
    y = fitted(lm(Ownership ~ Med_Income, data = mydata)),  
    name = "OLS trend",
    line = list(color = "black", width = 2),
    inherit = FALSE
  ) %>%
  layout(
    title = "Home Ownership Rate by Median Household Income",
    xaxis = list(title = "Median Household Income"),
    yaxis = list(title = "Home Ownership Rate (%)"),  
    legend = list(title = list(text = "County"))
  )

Scatterplot