Reading in the data

summer_temp <- st_read(
  "https://drive.google.com/uc?export=download&id=1byhsYTBnqegfPGsZWtAHH4pZgGbSTr_s",
  quiet = TRUE
)

acs <- st_read(
  "https://drive.google.com/uc?export=download&id=1ffMbuX4ZQ8vuZK9uwFOBe61bEbKfKg1j",
  quiet = TRUE
) |>
  mutate(
    rural = if_else(rural == 1, "rural", "non-rural"),
    low_inc = if_else(low_inc == 1, "low-income", "high-income"),
    high_commute = if_else(high_commute == 1, "high commute", "low commute")
  )

pm <- st_read(
  "https://drive.google.com/uc?export=download&id=1zf1xk-7pOoSnEwGvGsNVa6XejFoPFzdJ",
  quiet = TRUE
) |>
  mutate(rural = if_else(rural == 1, "rural", "non-rural"))

mobility <- st_read(
  "https://drive.google.com/uc?export=download&id=1YbCNVR5K8jDF5HOKHcoJ25gz7VkRvDHa",
  quiet = TRUE
) |>
  mutate(rural = if_else(rural == 1, "rural", "non-rural"))

One-sample t-test

Before testing the mean, I checked the shape of the PM2.5 data. The histogram and Q-Q plot show some non-normality, but the sample is large enough for the sampling distribution of the mean to be approximately normal.

ggplot(pm, aes(x = meanpm_2016_2020)) +
  geom_histogram(binwidth = 0.5, color = "white", fill = "gray45") +
  labs(x = "Mean PM2.5, 2016-2020", y = "Count") +
  theme_minimal()

qqnorm(pm$meanpm_2016_2020)
qqline(pm$meanpm_2016_2020, col = "steelblue", lwd = 2)

Q1: Null hypothesis

H0: The mean PM2.5 value for North Carolina census tracts is equal to or greater than 7.8 ug/m3.

H1: The mean PM2.5 value for North Carolina census tracts is less than 7.8 ug/m3.

pm_mean <- mean(pm$meanpm_2016_2020, na.rm = TRUE)
pm_one_sample <- t.test(
  pm$meanpm_2016_2020,
  mu = 7.8,
  alternative = "less",
  conf.level = 0.95
)

pm_mean
## [1] 7.546838
pm_one_sample
## 
##  One Sample t-test
## 
## data:  pm$meanpm_2016_2020
## t = -12.94, df = 2671, p-value < 2.2e-16
## alternative hypothesis: true mean is less than 7.8
## 95 percent confidence interval:
##      -Inf 7.579029
## sample estimates:
## mean of x 
##  7.546838

The North Carolina mean is about 7.55 ug/m3. The p-value is below 0.05, so I reject the null hypothesis. The data support the conclusion that the North Carolina mean is lower than 7.8 ug/m3.

Two-sample t-test

The next question compares PM2.5 in non-rural and rural tracts. Levene’s test checks whether the two groups have similar variances.

pm_levene <- leveneTest(meanpm_2016_2020 ~ rural, data = pm)
pm_levene
## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value Pr(>F)
## group    1  0.1764 0.6746
##       2670

Q2: Null hypothesis

H0: Mean PM2.5 is the same in rural and non-rural census tracts.

H1: Mean PM2.5 differs between rural and non-rural census tracts.

pm_two_sample <- t.test(
  meanpm_2016_2020 ~ rural,
  data = pm,
  var.equal = TRUE,
  alternative = "two.sided"
)
pm_two_sample
## 
##  Two Sample t-test
## 
## data:  meanpm_2016_2020 by rural
## t = 20.389, df = 2670, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group non-rural and group rural is not equal to 0
## 95 percent confidence interval:
##  0.7590222 0.9205533
## sample estimates:
## mean in group non-rural     mean in group rural 
##                7.770299                6.930511

The p-value is below 0.05, so I reject the null hypothesis. Mean PM2.5 is significantly higher in non-rural tracts (about 7.77) than in rural tracts (about 6.93).

Paired t-test

These observations are paired because the same 480 locations were measured in both periods.

summer_temp <- summer_temp |>
  mutate(diff = av_summer_2010_2020 - av_summer_2000_2010)

ggplot(summer_temp, aes(x = diff)) +
  geom_histogram(binwidth = 0.05, color = "white", fill = "gray45") +
  labs(x = "Temperature difference", y = "Count") +
  theme_minimal()

qqnorm(summer_temp$diff)
qqline(summer_temp$diff, col = "steelblue", lwd = 2)

Q3: Null hypothesis

H0: The mean summer temperature in 2010-2020 is equal to or lower than the mean at the same locations in 2000-2010.

H1: The mean summer temperature in 2010-2020 is higher than the mean at the same locations in 2000-2010.

temperature_paired <- t.test(
  summer_temp$av_summer_2010_2020,
  summer_temp$av_summer_2000_2010,
  paired = TRUE,
  alternative = "greater",
  conf.level = 0.95
)
temperature_paired
## 
##  Paired t-test
## 
## data:  summer_temp$av_summer_2010_2020 and summer_temp$av_summer_2000_2010
## t = 192.75, df = 479, p-value < 2.2e-16
## alternative hypothesis: true mean difference is greater than 0
## 95 percent confidence interval:
##  1.139164      Inf
## sample estimates:
## mean difference 
##        1.148988

The p-value is below 0.05, so I reject the null hypothesis. The later period was warmer by about 1.15 units on average.

Chi-square test of independence

The tutorial first compares rural status with commute category.

commute_table <- table(acs$rural, acs$high_commute)
commute_chisq <- chisq.test(commute_table)

commute_table
##            
##             high commute low commute
##   non-rural          310        1620
##   rural              118         580
commute_chisq
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  commute_table
## X-squared = 0.20909, df = 1, p-value = 0.6475

This test is not significant (p = 0.65), so I fail to reject the null hypothesis that rural status and commute category are independent.

Q4: A second chi-square test

I used rural status and income category as the second pair.

H0: Rural/non-rural status and income category are independent.

H1: Rural/non-rural status and income category are associated.

income_table <- table(acs$rural, acs$low_inc)
income_chisq <- chisq.test(income_table)

income_table
##            
##             high-income low-income
##   non-rural        1590        340
##   rural             429        269
income_chisq
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  income_table
## X-squared = 124.86, df = 1, p-value < 2.2e-16

The p-value is below 0.05, so I reject the null hypothesis. Rural status and income category are associated in these data.

Mini-challenge

1. Workplace mobility maps

map_march_may <- tm_shape(mobility) +
  tm_polygons(
    "workplace_change",
    palette = "RdBu",
    title = "% Change Workplace Mobility\n(March-May 2020)"
  ) +
  tm_layout(
    main.title = "Workplace Mobility Change: March-May 2020",
    main.title.size = 0.9,
    legend.outside = TRUE
  )

map_may_dec <- tm_shape(mobility) +
  tm_polygons(
    "workplace_change_may_dec",
    palette = "RdBu",
    title = "% Change Workplace Mobility\n(May-Dec 2020)"
  ) +
  tm_layout(
    main.title = "Workplace Mobility Change: May-Dec 2020",
    main.title.size = 0.9,
    legend.outside = TRUE
  )

map_march_may

map_may_dec

The March-May map shows the sharpest workplace mobility drops in a few central and metropolitan counties, while many eastern and coastal counties had smaller drops. By May-December, values were generally less negative, suggesting some recovery. Spatial differences remained, but the statewide decline was not as severe as it was early in the pandemic.

2. Paired t-test across the two periods

H0: The mean workplace mobility change was the same in March-May and May-December 2020.

H1: The mean workplace mobility change differed between the two periods.

mobility <- mobility |>
  mutate(diff_mobility = workplace_change_may_dec - workplace_change)

ggplot(mobility, aes(x = diff_mobility)) +
  geom_histogram(binwidth = 5, color = "white", fill = "gray45") +
  labs(x = "Later period minus early period", y = "Count") +
  theme_minimal()

qqnorm(mobility$diff_mobility)
qqline(mobility$diff_mobility, col = "steelblue", lwd = 2)

mobility_paired <- t.test(
  mobility$workplace_change_may_dec,
  mobility$workplace_change,
  paired = TRUE,
  alternative = "two.sided",
  conf.level = 0.95
)
mobility_paired
## 
##  Paired t-test
## 
## data:  mobility$workplace_change_may_dec and mobility$workplace_change
## t = 17.288, df = 97, p-value < 2.2e-16
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  7.522023 9.473095
## sample estimates:
## mean difference 
##        8.497559

The mean paired difference was 8.50 percentage points, with t(97) = 17.29 and p < 0.001. I reject the null hypothesis. Workplace mobility was still below baseline later in 2020, but it was significantly less negative than during March-May.

3. Independent t-test for non-rural and rural counties

I used the March-May workplace mobility measure.

H0: Rural and non-rural counties had the same mean workplace mobility change in March-May 2020.

H1: Rural and non-rural counties had different mean workplace mobility changes in March-May 2020.

mobility_levene <- leveneTest(workplace_change ~ rural, data = mobility)
mobility_levene
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  2.0507 0.1554
##       96
# The tutorial's equal-variance version is used here.
mobility_rural_test <- t.test(
  workplace_change ~ rural,
  data = mobility,
  var.equal = TRUE,
  alternative = "two.sided"
)
mobility_rural_test
## 
##  Two Sample t-test
## 
## data:  workplace_change by rural
## t = -6.0817, df = 96, p-value = 2.415e-08
## alternative hypothesis: true difference in means between group non-rural and group rural is not equal to 0
## 95 percent confidence interval:
##  -11.715279  -5.949667
## sample estimates:
## mean in group non-rural     mean in group rural 
##               -37.98333               -29.15086

The test gives t(96) = -6.08 and p < 0.001, so I reject the null hypothesis. Non-rural counties averaged a 37.98% drop, compared with a 29.15% drop in rural counties. The early decline was about 8.83 percentage points larger in non-rural counties.

4. One-sample t-test comparing North Carolina with the U.S.

The known U.S. mean for March-May was -32%.

H0: The North Carolina county mean was -32%.

H1: The North Carolina county mean differed from -32%.

nc_mobility_mean <- mean(mobility$workplace_change, na.rm = TRUE)
nc_mobility_mean
## [1] -31.13366
ggplot(mobility, aes(x = workplace_change)) +
  geom_histogram(binwidth = 5, color = "white", fill = "gray45") +
  labs(x = "March-May workplace mobility change", y = "Count") +
  theme_minimal()

qqnorm(mobility$workplace_change)
qqline(mobility$workplace_change, col = "steelblue", lwd = 2)

mobility_one_sample <- t.test(
  mobility$workplace_change,
  mu = -32,
  alternative = "two.sided",
  conf.level = 0.95
)
mobility_one_sample
## 
##  One Sample t-test
## 
## data:  mobility$workplace_change
## t = 1.221, df = 97, p-value = 0.225
## alternative hypothesis: true mean is not equal to -32
## 95 percent confidence interval:
##  -32.54188 -29.72545
## sample estimates:
## mean of x 
## -31.13366

North Carolina’s mean was -31.13%. The test gives t(97) = 1.22 and p = 0.225, so I fail to reject the null hypothesis. North Carolina’s average drop was slightly smaller than the U.S. value, but the difference was not statistically significant.

Overall note

These tests follow the tutorial, but the observations are spatial. Nearby places may be related, so the usual independence assumption may not hold perfectly. The results should therefore be interpreted as introductory non-spatial tests rather than the final word on these geographic patterns.