Code
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.5.3
## Warning: package 'ggplot2' was built under R version 4.5.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.2
## ✔ purrr 1.2.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
acs <- read.csv("acs_2015_county_data_revised.csv")
dim(acs)
## [1] 3142 35
Explanation
I imported using the read_csv() function from the Tidyverse package. The dataset contains 3,142 rows and 35 columns.
Code
acs <- acs %>%
mutate(census_id = as.character(census_id))
glimpse(acs)
## Rows: 3,142
## Columns: 35
## $ census_id <chr> "1001", "1003", "1005", "1007", "1009", "1011", "1013",…
## $ state <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", …
## $ county <chr> "Autauga", "Baldwin", "Barbour", "Bibb", "Blount", "Bul…
## $ total_pop <int> 55221, 195121, 26932, 22604, 57710, 10678, 20354, 11664…
## $ men <int> 26745, 95314, 14497, 12073, 28512, 5660, 9502, 56274, 1…
## $ women <int> 28476, 99807, 12435, 10531, 29198, 5018, 10852, 60374, …
## $ hispanic <dbl> 2.6, 4.5, 4.6, 2.2, 8.6, 4.4, 1.2, 3.5, 0.4, 1.5, 7.6, …
## $ white <dbl> 75.8, 83.1, 46.2, 74.5, 87.9, 22.2, 53.3, 73.0, 57.3, 9…
## $ black <dbl> 18.5, 9.5, 46.7, 21.4, 1.5, 70.7, 43.8, 20.3, 40.3, 4.8…
## $ native <dbl> 0.4, 0.6, 0.2, 0.4, 0.3, 1.2, 0.1, 0.2, 0.2, 0.6, 0.4, …
## $ asian <dbl> 1.0, 0.7, 0.4, 0.1, 0.1, 0.2, 0.4, 0.9, 0.8, 0.3, 0.3, …
## $ pacific <dbl> 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, …
## $ citizen <int> 40725, 147695, 20714, 17495, 42345, 8057, 15581, 88612,…
## $ income <int> 51281, 50254, 32964, 38678, 45813, 31938, 32229, 41703,…
## $ income_per_cap <int> 24974, 27317, 16824, 18431, 20532, 17580, 18390, 21374,…
## $ poverty <dbl> 12.9, 13.4, 26.7, 16.8, 16.7, 24.6, 25.4, 20.5, 21.6, 1…
## $ child_poverty <dbl> 18.6, 19.2, 45.3, 27.9, 27.2, 38.4, 39.2, 31.6, 37.2, 3…
## $ professional <dbl> 33.2, 33.1, 26.8, 21.5, 28.5, 18.8, 27.5, 27.3, 23.3, 2…
## $ service <dbl> 17.0, 17.7, 16.1, 17.9, 14.1, 15.0, 16.6, 17.7, 14.5, 1…
## $ office <dbl> 24.2, 27.1, 23.1, 17.8, 23.9, 19.7, 21.9, 24.2, 26.3, 1…
## $ construction <dbl> 8.6, 10.8, 10.8, 19.0, 13.5, 20.1, 10.3, 10.5, 11.5, 13…
## $ production <dbl> 17.1, 11.2, 23.1, 23.7, 19.9, 26.4, 23.7, 20.4, 24.4, 2…
## $ drive <dbl> 87.5, 84.7, 83.8, 83.2, 84.9, 74.9, 84.5, 85.3, 85.1, 8…
## $ carpool <dbl> 8.8, 8.8, 10.9, 13.5, 11.2, 14.9, 12.4, 9.4, 11.9, 12.1…
## $ transit <dbl> 0.1, 0.1, 0.4, 0.5, 0.4, 0.7, 0.0, 0.2, 0.2, 0.2, 0.2, …
## $ walk <dbl> 0.5, 1.0, 1.8, 0.6, 0.9, 5.0, 0.8, 1.2, 0.3, 0.6, 1.1, …
## $ other_transp <dbl> 1.3, 1.4, 1.5, 1.5, 0.4, 1.7, 0.6, 1.2, 0.4, 0.7, 1.4, …
## $ work_at_home <dbl> 1.8, 3.9, 1.6, 0.7, 2.3, 2.8, 1.7, 2.7, 2.1, 2.5, 1.9, …
## $ mean_commute <dbl> 26.5, 26.4, 24.1, 28.8, 34.9, 27.5, 24.6, 24.1, 25.1, 2…
## $ employed <int> 23986, 85953, 8597, 8294, 22189, 3865, 7813, 47401, 136…
## $ private_work <dbl> 73.6, 81.5, 71.8, 76.8, 82.0, 79.5, 77.4, 74.1, 85.1, 7…
## $ public_work <dbl> 20.9, 12.3, 20.8, 16.1, 13.5, 15.1, 16.2, 20.8, 12.1, 1…
## $ self_employed <dbl> 5.5, 5.8, 7.3, 6.7, 4.2, 5.4, 6.2, 5.0, 2.8, 7.9, 4.1, …
## $ family_work <dbl> 0.0, 0.4, 0.1, 0.4, 0.4, 0.0, 0.2, 0.1, 0.0, 0.5, 0.5, …
## $ unemployment <dbl> 7.6, 7.5, 17.6, 8.3, 7.7, 18.0, 10.9, 12.3, 8.9, 7.9, 9…
Explanation
Most variables were imported with the correct data types. I changed census_id from numeric to character because it is used to identify counties, not perform calculations. I used the glimpse() function to confirm the data types after making the change
Code
colSums(is.na(acs))
## census_id state county total_pop men
## 0 0 0 0 0
## women hispanic white black native
## 0 0 0 0 0
## asian pacific citizen income income_per_cap
## 0 0 0 1 0
## poverty child_poverty professional service office
## 0 1 0 0 0
## construction production drive carpool transit
## 0 0 0 0 0
## walk other_transp work_at_home mean_commute employed
## 0 0 0 0 0
## private_work public_work self_employed family_work unemployment
## 0 0 0 0 0
acs <- acs %>%
drop_na()
colSums(is.na(acs))
## census_id state county total_pop men
## 0 0 0 0 0
## women hispanic white black native
## 0 0 0 0 0
## asian pacific citizen income income_per_cap
## 0 0 0 0 0
## poverty child_poverty professional service office
## 0 0 0 0 0
## construction production drive carpool transit
## 0 0 0 0 0
## walk other_transp work_at_home mean_commute employed
## 0 0 0 0 0
## private_work public_work self_employed family_work unemployment
## 0 0 0 0 0
dim(acs)
## [1] 3140 35
Explanation
There were two missing values in the dataset, one in the income variable and one in the child_poverty variable. I decided to remove the observations containing missing values because they represent a very small portion of the dataset. After cleaning, the dataset contains 3,140 rows and 35 columns with no missing values.
Code
summary(acs)
## census_id state county total_pop
## Length:3140 Length:3140 Length:3140 Min. : 267
## Class :character Class :character Class :character 1st Qu.: 11036
## Mode :character Mode :character Mode :character Median : 25793
## Mean : 100801
## 3rd Qu.: 67621
## Max. :10038388
## men women hispanic white
## Min. : 136 Min. : 131 Min. : 0.000 Min. : 0.90
## 1st Qu.: 5551 1st Qu.: 5488 1st Qu.: 1.900 1st Qu.:65.67
## Median : 12838 Median : 12916 Median : 3.700 Median :84.65
## Mean : 49597 Mean : 51204 Mean : 8.819 Mean :77.31
## 3rd Qu.: 33328 3rd Qu.: 34123 3rd Qu.: 9.000 3rd Qu.:93.33
## Max. :4945351 Max. :5093037 Max. :98.700 Max. :99.80
## black native asian pacific
## Min. : 0.000 Min. : 0.000 Min. : 0.000 Min. : 0.00000
## 1st Qu.: 0.600 1st Qu.: 0.100 1st Qu.: 0.200 1st Qu.: 0.00000
## Median : 2.100 Median : 0.300 Median : 0.500 Median : 0.00000
## Mean : 8.885 Mean : 1.763 Mean : 1.253 Mean : 0.07357
## 3rd Qu.:10.200 3rd Qu.: 0.600 3rd Qu.: 1.200 3rd Qu.: 0.00000
## Max. :85.900 Max. :92.100 Max. :41.600 Max. :11.10000
## citizen income income_per_cap poverty
## Min. : 199 Min. : 19328 Min. : 8292 Min. : 1.4
## 1st Qu.: 8276 1st Qu.: 38826 1st Qu.:20470 1st Qu.:12.0
## Median : 19455 Median : 45095 Median :23575 Median :16.0
## Mean : 70849 Mean : 46824 Mean :24331 Mean :16.7
## 3rd Qu.: 50795 3rd Qu.: 52248 3rd Qu.:27138 3rd Qu.:20.3
## Max. :6046749 Max. :123453 Max. :65600 Max. :53.3
## child_poverty professional service office
## Min. : 0.00 Min. :13.50 Min. : 5.00 Min. : 4.10
## 1st Qu.:16.10 1st Qu.:26.70 1st Qu.:15.90 1st Qu.:20.20
## Median :22.50 Median :30.00 Median :18.00 Median :22.40
## Mean :23.29 Mean :31.05 Mean :18.25 Mean :22.13
## 3rd Qu.:29.50 3rd Qu.:34.42 3rd Qu.:20.20 3rd Qu.:24.30
## Max. :72.30 Max. :74.00 Max. :36.60 Max. :35.40
## construction production drive carpool
## Min. : 1.70 Min. : 0.00 Min. : 5.2 Min. : 0.00
## 1st Qu.: 9.80 1st Qu.:11.50 1st Qu.:76.6 1st Qu.: 8.50
## Median :12.20 Median :15.40 Median :80.6 Median : 9.90
## Mean :12.75 Mean :15.82 Mean :79.1 Mean :10.33
## 3rd Qu.:15.00 3rd Qu.:19.40 3rd Qu.:83.6 3rd Qu.:11.90
## Max. :40.30 Max. :55.60 Max. :94.6 Max. :29.90
## transit walk other_transp work_at_home
## Min. : 0.0000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 0.1000 1st Qu.: 1.400 1st Qu.: 0.90 1st Qu.: 2.800
## Median : 0.4000 Median : 2.400 Median : 1.30 Median : 4.000
## Mean : 0.9681 Mean : 3.294 Mean : 1.61 Mean : 4.694
## 3rd Qu.: 0.8000 3rd Qu.: 4.000 3rd Qu.: 1.90 3rd Qu.: 5.700
## Max. :61.7000 Max. :71.200 Max. :39.10 Max. :37.200
## mean_commute employed private_work public_work
## Min. : 4.90 Min. : 166 Min. :29.50 Min. : 5.80
## 1st Qu.:19.30 1st Qu.: 4532 1st Qu.:70.90 1st Qu.:13.07
## Median :22.90 Median : 10657 Median :75.85 Median :16.10
## Mean :23.15 Mean : 46416 Mean :74.45 Mean :17.33
## 3rd Qu.:26.60 3rd Qu.: 29272 3rd Qu.:79.80 3rd Qu.:20.10
## Max. :44.00 Max. :4635465 Max. :88.30 Max. :66.20
## self_employed family_work unemployment
## Min. : 0.000 Min. :0.0000 Min. : 0.000
## 1st Qu.: 5.400 1st Qu.:0.1000 1st Qu.: 5.500
## Median : 6.900 Median :0.2000 Median : 7.500
## Mean : 7.922 Mean :0.2917 Mean : 7.815
## 3rd Qu.: 9.400 3rd Qu.:0.3000 3rd Qu.: 9.700
## Max. :36.600 Max. :9.8000 Max. :29.400
acs %>%
filter(total_pop < 0 |
unemployment < 0 |
unemployment > 100 |
carpool < 0 |
carpool > 100 |
mean_commute < 0)
## [1] census_id state county total_pop men
## [6] women hispanic white black native
## [11] asian pacific citizen income income_per_cap
## [16] poverty child_poverty professional service office
## [21] construction production drive carpool transit
## [26] walk other_transp work_at_home mean_commute employed
## [31] private_work public_work self_employed family_work unemployment
## <0 rows> (or 0-length row.names)
Explanation
Using the summary() function I examined the dataset for unusual values. I noticed some large differences in population, unemployment rates, and commute times across counties. However, these differences are reasonable because counties vary in size and demographics. I also checked for negative values and percentages outside the valid range and found none in the variables tested. Therefore, I decided to keep the observations because there was no clear evidence that these unusual values were errors.
Code
acs %>%
filter(women > men) %>%
nrow()
## [1] 1984
Explanation
I used the filter() function to identify counties where the number of women was greater than the number of men. I then used nrow() to count these counties. The results showed that 1,985 counties had more women than men in the original dataset.
Code
acs %>%
filter(unemployment < 10) %>%
nrow()
## [1] 2419
Explanation
I used the filter() function to identify counties with an unemployment rate below 10%. I then used nrow() to count the counties that met this condition. The results showed that 2,419 counties had an unemployment rate lower than 10%.
Code
acs %>%
slice_max(order_by = mean_commute, n = 10, with_ties = FALSE) %>%
select(census_id, county, state, mean_commute) %>%
arrange(desc(mean_commute))
## census_id county state mean_commute
## 1 42103 Pike Pennsylvania 44.0
## 2 36005 Bronx New York 43.0
## 3 24017 Charles Maryland 42.8
## 4 51187 Warren Virginia 42.7
## 5 36081 Queens New York 42.6
## 6 36085 Richmond New York 42.6
## 7 51193 Westmoreland Virginia 42.5
## 8 8093 Park Colorado 42.4
## 9 36047 Kings New York 41.7
## 10 54015 Clay West Virginia 41.4
Explanation
I used the slice_max() function to identify the 10 counties with the highest mean commute times. I then selected the required variables and sorted the results from highest to lowest. Pike County, Pennsylvania, had the highest mean commute time at 44 minutes, followed by Bronx County, New York, at 43 minutes. The results show that several counties in New York and Virginia have some of the longest average commute times.
Code
acs <- acs %>%
mutate(women_percentage = (women / total_pop) * 100)
acs %>%
slice_min(order_by = women_percentage, n = 10) %>%
select(census_id, county, state, women_percentage) %>%
arrange(women_percentage)
## census_id county state women_percentage
## 1 42053 Forest Pennsylvania 26.77747
## 2 8011 Bent Colorado 31.36556
## 3 51183 Sussex Virginia 31.47336
## 4 13309 Wheeler Georgia 32.10156
## 5 6035 Lassen California 33.16588
## 6 48095 Concho Texas 33.28439
## 7 13053 Chattahoochee Georgia 33.35572
## 8 2013 Aleutians East Borough Alaska 33.47458
## 9 22125 West Feliciana Louisiana 33.64904
## 10 32027 Pershing Nevada 33.72508
Explanation
I created a new variable called women_percentage by dividing the number of women by the total population and multiplying by 100. I then used slice_min() to identify the 10 counties with the lowest percentages of women. Forest County, Pennsylvania, had the lowest percentage at approximately 26.78%, followed by Bent County, Colorado, at 31.37%. These counties have noticeably smaller female populations compared to their total populations.
acs <- acs %>%
mutate(race_sum = hispanic + white + black +
native + asian + pacific)
I created a new variable called race_sum by adding the six race percentage variables together.
acs %>%
slice_min(order_by = race_sum, n = 10,
with_ties = FALSE) %>%
select(census_id, county, state, race_sum) %>%
arrange(race_sum)
## census_id county state race_sum
## 1 15001 Hawaii Hawaii 76.4
## 2 15009 Maui Hawaii 79.2
## 3 40097 Mayes Oklahoma 79.7
## 4 15003 Honolulu Hawaii 81.5
## 5 40123 Pontotoc Oklahoma 82.8
## 6 47061 Grundy Tennessee 83.0
## 7 2282 Yakutat City and Borough Alaska 83.4
## 8 40069 Johnston Oklahoma 84.0
## 9 15007 Kauai Hawaii 84.1
## 10 40003 Alfalfa Oklahoma 85.1
Hawaii County, Hawaii, had the lowest sum at 76.4%, followed by Maui County, Hawaii, at 79.2%.
acs %>%
group_by(state) %>%
summarise(avg_race_sum = mean(race_sum)) %>%
arrange(avg_race_sum) %>%
slice_head(n = 1)
## # A tibble: 1 × 2
## state avg_race_sum
## <chr> <dbl>
## 1 Hawaii 80.3
Hawaii had the lowest average race sum at 80.3%.
acs %>%
filter(race_sum > 100) %>%
select(census_id, county, state, race_sum)
## census_id county state race_sum
## 1 28021 Claiborne Mississippi 100.0
## 2 31073 Gosper Nebraska 100.1
## 3 31091 Hooker Nebraska 100.1
## 4 31125 Nance Nebraska 100.1
## 5 48017 Bailey Texas 100.1
## 6 48131 Duval Texas 100.0
## 7 48137 Edwards Texas 100.1
## 8 48261 Kenedy Texas 100.0
## 9 48263 Kent Texas 100.0
## 10 48377 Presidio Texas 100.0
## 11 49001 Beaver Utah 100.0
Yes, 11 counties had a race sum greater than 100%. This is likely due to rounding in the percentages.
acs %>%
filter(round(race_sum, 1) == 100) %>%
summarise(number_of_states = n_distinct(state))
## number_of_states
## 1 16
There were 16 states with at least one county whose race sum equaled exactly 100%.
acs <- acs %>%
mutate(carpool_rank = min_rank(desc(carpool)))
I used the min_rank() function to create a new variable called carpool_rank. Counties with higher carpool percentages received better rankings, with rank 1 being the highest.
acs %>%
arrange(carpool_rank) %>%
select(census_id, county, state, carpool, carpool_rank) %>%
slice_head(n = 10)
## census_id county state carpool carpool_rank
## 1 13061 Clay Georgia 29.9 1
## 2 18087 LaGrange Indiana 27.0 2
## 3 13165 Jenkins Georgia 25.3 3
## 4 5133 Sevier Arkansas 24.4 4
## 5 20175 Seward Kansas 23.4 5
## 6 48079 Cochran Texas 22.8 6
## 7 48247 Jim Hogg Texas 22.6 7
## 8 48393 Roberts Texas 22.4 8
## 9 39075 Holmes Ohio 21.8 9
## 10 21197 Powell Kentucky 21.6 10
Clay County, Georgia, had the highest carpool percentage at 29.9%, followed by LaGrange County, Indiana, at 27.0%.
acs %>%
arrange(desc(carpool_rank), census_id) %>%
select(census_id, county, state, carpool, carpool_rank) %>%
slice_head(n = 10)
## census_id county state carpool carpool_rank
## 1 48261 Kenedy Texas 0.0 3139
## 2 48269 King Texas 0.0 3139
## 3 48235 Irion Texas 0.9 3138
## 4 31183 Wheeler Nebraska 1.3 3137
## 5 36061 New York New York 1.9 3136
## 6 13309 Wheeler Georgia 2.3 3134
## 7 38029 Emmons North Dakota 2.3 3134
## 8 30019 Daniels Montana 2.6 3132
## 9 31057 Dundy Nebraska 2.6 3132
## 10 46069 Hyde South Dakota 2.8 3130
Kenedy County and King County, Texas, had the lowest carpool percentages at 0%, sharing a rank of 3139.
acs %>%
group_by(state) %>%
summarise(avg_rank = mean(carpool_rank)) %>%
arrange(avg_rank) %>%
slice_head(n = 1)
## # A tibble: 1 × 2
## state avg_rank
## <chr> <dbl>
## 1 Hawaii 651.
Hawaii had the best average county carpool ranking at 651.25.
acs %>%
group_by(state) %>%
summarise(avg_rank = mean(carpool_rank)) %>%
arrange(avg_rank) %>%
slice_head(n = 5)
## # A tibble: 5 × 2
## state avg_rank
## <chr> <dbl>
## 1 Hawaii 651.
## 2 Arizona 970.
## 3 Utah 1019.
## 4 Arkansas 1054.
## 5 Alaska 1086.
The five best-ranked states based on average county rankings were Hawaii, Arizona, Utah, Arkansas, and Alaska.