DATA607_Project2
library(tidyverse)
library(lubridate)Dataset 1 - Populous States
library(tidyverse)
population <- read_csv("census_top10_states_2022_untidy.csv")## Rows: 10 Columns: 5
## ── Column specification ─────────────────────
## Delimiter: ","
## chr (1): Geographic Area
## dbl (4): Rank, April 1, 2020 (Estimates B...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.head(population)## # A tibble: 6 × 5
## Rank `Geographic Area`
## <dbl> <chr>
## 1 1 California
## 2 2 Texas
## 3 3 Florida
## 4 4 New York
## 5 5 Pennsylvania
## 6 6 Illinois
## # ℹ 3 more variables:
## # `April 1, 2020 (Estimates Base)` <dbl>,
## # `July 1, 2021` <dbl>,
## # `July 1, 2022` <dbl>glimpse(population)## Rows: 10
## Columns: 5
## $ Rank <dbl> 1,…
## $ `Geographic Area` <chr> "C…
## $ `April 1, 2020 (Estimates Base)` <dbl> 39…
## $ `July 1, 2021` <dbl> 39…
## $ `July 1, 2022` <dbl> 39…# Convert population data from wide to long format
population_long <- population %>%
pivot_longer(
cols = -c(Rank, `Geographic Area`),
names_to = "Year",
values_to = "Population"
)
# View
head(population_long)## # A tibble: 6 × 4
## Rank `Geographic Area` Year Population
## <dbl> <chr> <chr> <dbl>
## 1 1 California April 1… 39538245
## 2 1 California July 1,… 39142991
## 3 1 California July 1,… 39029342
## 4 2 Texas April 1… 29145428
## 5 2 Texas July 1,… 29558864
## 6 2 Texas July 1,… 30029572# Calculate population changes from 2020 to 2022
population_change <- population_long %>%
filter(Year %in% c(
"April 1, 2020 (Estimates Base)",
"July 1, 2022"
)) %>%
select(`Geographic Area`, Year, Population) %>%
pivot_wider(
names_from = Year,
values_from = Population
) %>%
mutate(
Population_Change = `July 1, 2022` -
`April 1, 2020 (Estimates Base)`,
Percent_Change = round(
Population_Change /
`April 1, 2020 (Estimates Base)` * 100, 2
)
) %>%
arrange(desc(Percent_Change))
# Display results
print(population_change)## # A tibble: 10 × 5
## `Geographic Area` April 1, 2020 (Estimat…¹
## <chr> <dbl>
## 1 Florida 21538226
## 2 Texas 29145428
## 3 North Carolina 10439414
## 4 Georgia 10711937
## 5 Pennsylvania 13002689
## 6 Ohio 11799374
## 7 Michigan 10077325
## 8 California 39538245
## 9 Illinois 12812545
## 10 New York 20201230
## # ℹ abbreviated name:
## # ¹`April 1, 2020 (Estimates Base)`
## # ℹ 3 more variables: `July 1, 2022` <dbl>,
## # Population_Change <dbl>,
## # Percent_Change <dbl># Display all columns
print(population_change, width = Inf)## # A tibble: 10 × 5
## `Geographic Area`
## <chr>
## 1 Florida
## 2 Texas
## 3 North Carolina
## 4 Georgia
## 5 Pennsylvania
## 6 Ohio
## 7 Michigan
## 8 California
## 9 Illinois
## 10 New York
## `April 1, 2020 (Estimates Base)`
## <dbl>
## 1 21538226
## 2 29145428
## 3 10439414
## 4 10711937
## 5 13002689
## 6 11799374
## 7 10077325
## 8 39538245
## 9 12812545
## 10 20201230
## `July 1, 2022` Population_Change
## <dbl> <dbl>
## 1 22244823 706597
## 2 30029572 884144
## 3 10698973 259559
## 4 10912876 200939
## 5 12972008 -30681
## 6 11756058 -43316
## 7 10034113 -43212
## 8 39029342 -508903
## 9 12582032 -230513
## 10 19677151 -524079
## Percent_Change
## <dbl>
## 1 3.28
## 2 3.03
## 3 2.49
## 4 1.88
## 5 -0.24
## 6 -0.37
## 7 -0.43
## 8 -1.29
## 9 -1.8
## 10 -2.59Results & Conclusions
After changing the populace data from wide to long, I computed the population changes for the top 10 most populous states between April 2020 and July 2022.
Florida had the greatest percent increase with 3.28%, rigth before Texas at 3.03%. However, Texas had the biggest numerical increase, getting about 884,000 residents.
New York seemed to have experienced the biggest percent decrease at 2.59 %, which equated to a loss of 524,000 residents. California and illinois also faced apparent population declines.
Dataset 2: US Average Tuition (2004–2016)
# Dataset 2: US Average Tuition
tuition <- read_csv("us_avg_tuition(Table 5).csv")## Rows: 50 Columns: 13
## ── Column specification ─────────────────────
## Delimiter: ","
## chr (13): State, 2004-05, 2005-06, 2006-0...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Inspect the dataset
head(tuition)## # A tibble: 6 × 13
## State `2004-05` `2005-06` `2006-07`
## <chr> <chr> <chr> <chr>
## 1 Alabama $5,683 $5,841 $5,753
## 2 Alaska $4,328 $4,633 $4,919
## 3 Arizona $5,138 $5,416 $5,481
## 4 Arkansas $5,772 $6,082 $6,232
## 5 California $5,286 $5,528 $5,335
## 6 Colorado $4,704 $5,407 $5,596
## # ℹ 9 more variables: `2007-08` <chr>,
## # `2008-09` <chr>, `2009-10` <chr>,
## # `2010-11` <chr>, `2011-12` <chr>,
## # `2012-13` <chr>, `2013-14` <chr>,
## # `2014-15` <chr>, `2015-16` <chr>glimpse(tuition)## Rows: 50
## Columns: 13
## $ State <chr> "Alabama", "Alaska", "Ari…
## $ `2004-05` <chr> "$5,683", "$4,328", "$5,1…
## $ `2005-06` <chr> "$5,841", "$4,633", "$5,4…
## $ `2006-07` <chr> "$5,753", "$4,919", "$5,4…
## $ `2007-08` <chr> "$6,008", "$5,070", "$5,6…
## $ `2008-09` <chr> "$6,475", "$5,075", "$6,0…
## $ `2009-10` <chr> "$7,189", "$5,455", "$7,2…
## $ `2010-11` <chr> "$8,071", "$5,759", "$8,8…
## $ `2011-12` <chr> "$8,452", "$5,762", "$9,9…
## $ `2012-13` <chr> "$9,098", "$6,026", "$10,…
## $ `2013-14` <chr> "$9,359", "$6,012", "$10,…
## $ `2014-15` <chr> "$9,496", "$6,149", "$10,…
## $ `2015-16` <chr> "$9,751", "$6,571", "$10,…# Check missing values
colSums(is.na(tuition))## State 2004-05 2005-06 2006-07 2007-08
## 0 0 0 0 0
## 2008-09 2009-10 2010-11 2011-12 2012-13
## 0 0 0 0 0
## 2013-14 2014-15 2015-16
## 0 0 0names(tuition)## [1] "State" "2004-05" "2005-06" "2006-07"
## [5] "2007-08" "2008-09" "2009-10" "2010-11"
## [9] "2011-12" "2012-13" "2013-14" "2014-15"
## [13] "2015-16"# Transform from wide to long format
tuition_long <- tuition %>%
pivot_longer(
cols = -State,
names_to = "Academic_Year",
values_to = "Tuition"
) %>%
mutate(
Tuition = readr::parse_number(as.character(Tuition))
)
# Check transformed data
head(tuition_long)## # A tibble: 6 × 3
## State Academic_Year Tuition
## <chr> <chr> <dbl>
## 1 Alabama 2004-05 5683
## 2 Alabama 2005-06 5841
## 3 Alabama 2006-07 5753
## 4 Alabama 2007-08 6008
## 5 Alabama 2008-09 6475
## 6 Alabama 2009-10 7189# Average tuition by state across all years
state_avg <- tuition_long %>%
group_by(State) %>%
summarise(
Average_Tuition = round(mean(Tuition, na.rm = TRUE), 2),
.groups = "drop"
) %>%
arrange(desc(Average_Tuition))
print(state_avg, n = 10)## # A tibble: 50 × 2
## State Average_Tuition
## <chr> <dbl>
## 1 Vermont 13067.
## 2 New Hampshire 12781.
## 3 New Jersey 12054.
## 4 Pennsylvania 11970
## 5 Illinois 11228.
## 6 Michigan 10477
## 7 South Carolina 10377.
## 8 Delaware 10099.
## 9 Massachusetts 10058.
## 10 Ohio 9942.
## # ℹ 40 more rows# Highest tuition states in 2015-16
highest_tuition <- tuition_long %>%
filter(Academic_Year == "2015-16") %>%
arrange(desc(Tuition))
print(head(highest_tuition, 10))## # A tibble: 10 × 3
## State Academic_Year Tuition
## <chr> <chr> <dbl>
## 1 New Hampshire 2015-16 15160
## 2 Vermont 2015-16 14993
## 3 Pennsylvania 2015-16 13395
## 4 New Jersey 2015-16 13303
## 5 Illinois 2015-16 13189
## 6 Michigan 2015-16 11991
## 7 Virginia 2015-16 11819
## 8 South Carolina 2015-16 11816
## 9 Delaware 2015-16 11676
## 10 Massachusetts 2015-16 11588# Compare tuition in the first and last years
tuition_change <- tuition_long %>%
filter(Academic_Year %in% c("2004-05", "2015-16")) %>%
pivot_wider(
names_from = Academic_Year,
values_from = Tuition
) %>%
mutate(
Change = `2015-16` - `2004-05`,
Percent_Change = round(Change / `2004-05` * 100, 2)
) %>%
arrange(desc(Percent_Change))
print(tuition_change, n = 10)## # A tibble: 50 × 5
## State `2004-05` `2015-16` Change
## <chr> <dbl> <dbl> <dbl>
## 1 Hawaii 4267 10175 5908
## 2 Colorado 4704 9748 5044
## 3 Arizona 5138 10646 5508
## 4 Georgia 4298 8447 4149
## 5 Nevada 3621 6667 3046
## 6 Louisiana 4453 7871 3418
## 7 California 5286 9270 3984
## 8 Alabama 5683 9751 4068
## 9 Tennessee 5426 9263 3837
## 10 Kentucky 5640 9567 3927
## # ℹ 40 more rows
## # ℹ 1 more variable: Percent_Change <dbl># Average tuition across states by academic year
yearly_tuition <- tuition_long %>%
group_by(Academic_Year) %>%
summarise(
Average_Tuition = mean(Tuition, na.rm = TRUE),
.groups = "drop"
)
# Plot tuition trends
ggplot(yearly_tuition,
aes(x = Academic_Year, y = Average_Tuition, group = 1)) +
geom_line(color = "steelblue", linewidth = 1) +
geom_point() +
labs(
title = "Average US Tuition, 2004-2016",
x = "Academic Year",
y = "Average Tuition ($)"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
head(state_avg, 5)## # A tibble: 5 × 2
## State Average_Tuition
## <chr> <dbl>
## 1 Vermont 13067.
## 2 New Hampshire 12781.
## 3 New Jersey 12054.
## 4 Pennsylvania 11970
## 5 Illinois 11228.head(tuition_change, 5)## # A tibble: 5 × 5
## State `2004-05` `2015-16` Change
## <chr> <dbl> <dbl> <dbl>
## 1 Hawaii 4267 10175 5908
## 2 Colorado 4704 9748 5044
## 3 Arizona 5138 10646 5508
## 4 Georgia 4298 8447 4149
## 5 Nevada 3621 6667 3046
## # ℹ 1 more variable: Percent_Change <dbl>tail(tuition_change, 5)## # A tibble: 5 × 5
## State `2004-05` `2015-16` Change
## <chr> <dbl> <dbl> <dbl>
## 1 Iowa 6813 7877 1064
## 2 Missouri 7477 8564 1087
## 3 Montana 5630 6351 721
## 4 Maryland 8531 9163 632
## 5 Ohio 10378 10196 -182
## # ℹ 1 more variable: Percent_Change <dbl>Results & Conclusions
After transforming the tuition dataset from wide to long, I was able to compare every state’s tuition throughout academic years.
Seeing the results, Iowa faced a 15.62% increase between 2004-05 and 2015-16, while Missouri went up by 14.54% and Montana went up by 12.81%. Maryland also saw an upwards of 7.41%.
Ohio showcased a 1.75% decrease over the same period. This insinuates that tuiton trends were not uniform throughout the states.
Dataset 3: Business Costs and Revenue
# Dataset 3: Business Costs and Revenue
business <- read_csv("5A_BusinessCostsRevenue.csv")## Rows: 5 Columns: 14
## ── Column specification ─────────────────────
## Delimiter: ","
## chr (2): Location, Name
## dbl (11): Jan Revenue, Feb Cost (k), Feb ...
## num (1): Jan Cost
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Inspect structure
head(business)## # A tibble: 5 × 14
## Location Name `Jan Cost` `Jan Revenue`
## <chr> <chr> <dbl> <dbl>
## 1 Boston Bobby 29000 50000
## 2 Chicago Denise 41000 45000
## 3 LA Ethan 30500 39000
## 4 New York April 19000 31500
## 5 Dallas Emma 38000 42000
## # ℹ 10 more variables: `Feb Cost (k)` <dbl>,
## # `Feb Revenue` <dbl>,
## # `March Cost (k)` <dbl>,
## # `March Revenue` <dbl>, April_Cost <dbl>,
## # April_revenue <dbl>, `May Cost` <dbl>,
## # `may revenue` <dbl>, `June Cost` <dbl>,
## # `June Revenue` <dbl>names(business)## [1] "Location" "Name"
## [3] "Jan Cost" "Jan Revenue"
## [5] "Feb Cost (k)" "Feb Revenue"
## [7] "March Cost (k)" "March Revenue"
## [9] "April_Cost" "April_revenue"
## [11] "May Cost" "may revenue"
## [13] "June Cost" "June Revenue"glimpse(business)## Rows: 5
## Columns: 14
## $ Location <chr> "Boston", "Chicago…
## $ Name <chr> "Bobby", "Denise",…
## $ `Jan Cost` <dbl> 29000, 41000, 3050…
## $ `Jan Revenue` <dbl> 50000, 45000, 3900…
## $ `Feb Cost (k)` <dbl> 50.0, 50.6, 31.0, …
## $ `Feb Revenue` <dbl> 52000, 34000, 3800…
## $ `March Cost (k)` <dbl> 40, 14, 60, 28, 31
## $ `March Revenue` <dbl> 48000, 41000, 6500…
## $ April_Cost <dbl> 50000, 56000, 6000…
## $ April_revenue <dbl> 53000, 34000, 5800…
## $ `May Cost` <dbl> 25000, 14000, 3600…
## $ `may revenue` <dbl> 6150000, 21000, 37…
## $ `June Cost` <dbl> 45000, 38000, 6200…
## $ `June Revenue` <dbl> 44000, 46000, 5500…# Standardize column names
business_clean <- business %>%
rename(
Jan_Cost = `Jan Cost`,
Jan_Revenue = `Jan Revenue`,
Feb_Cost = `Feb Cost (k)`,
Feb_Revenue = `Feb Revenue`,
March_Cost = `March Cost (k)`,
March_Revenue = `March Revenue`,
April_Cost = April_Cost,
April_Revenue = April_revenue,
May_Cost = `May Cost`,
May_Revenue = `may revenue`,
June_Cost = `June Cost`,
June_Revenue = `June Revenue`
) %>%
mutate(
Feb_Cost = Feb_Cost * 1000,
March_Cost = March_Cost * 1000
)
# Convert wide data into long format
business_long <- business_clean %>%
pivot_longer(
cols = -c(Location, Name),
names_to = c("Month", ".value"),
names_sep = "_"
) %>%
mutate(
Month = factor(
Month,
levels = c("Jan", "Feb", "March",
"April", "May", "June")
),
Profit = Revenue - Cost
)
# Inspect transformed data
print(business_long, n = 30)## # A tibble: 30 × 6
## Location Name Month Cost Revenue Profit
## <chr> <chr> <fct> <dbl> <dbl> <dbl>
## 1 Boston Bobby Jan 29000 50000 21000
## 2 Boston Bobby Feb 50000 52000 2000
## 3 Boston Bobby March 40000 48000 8000
## 4 Boston Bobby April 50000 53000 3000
## 5 Boston Bobby May 25000 6150000 6125000
## 6 Boston Bobby June 45000 44000 -1000
## 7 Chicago Deni… Jan 41000 45000 4000
## 8 Chicago Deni… Feb 50600 34000 -16600
## 9 Chicago Deni… March 14000 41000 27000
## 10 Chicago Deni… April 56000 34000 -22000
## 11 Chicago Deni… May 14000 21000 7000
## 12 Chicago Deni… June 38000 46000 8000
## 13 LA Ethan Jan 30500 39000 8500
## 14 LA Ethan Feb 31000 38000 7000
## 15 LA Ethan March 60000 65000 5000
## 16 LA Ethan April 60000 58000 -2000
## 17 LA Ethan May 36000 37000 1000
## 18 LA Ethan June 62000 55000 -7000
## 19 New York April Jan 19000 31500 12500
## 20 New York April Feb 22000 31000 9000
## 21 New York April March 28000 33000 5000
## 22 New York April April 30000 31000 1000
## 23 New York April May 37000 39500 2500
## 24 New York April June 29000 30000 1000
## 25 Dallas Emma Jan 38000 42000 4000
## 26 Dallas Emma Feb 16000 58000 42000
## 27 Dallas Emma March 31000 35000 4000
## 28 Dallas Emma April 35000 33000 -2000
## 29 Dallas Emma May 24000 34000 10000
## 30 Dallas Emma June 20000 28000 8000# Calculate monthly business performance
monthly_summary <- business_long %>%
group_by(Month) %>%
summarise(
Total_Cost = sum(Cost, na.rm = TRUE),
Total_Revenue = sum(Revenue, na.rm = TRUE),
Total_Profit = sum(Profit, na.rm = TRUE),
.groups = "drop"
)
print(monthly_summary)## # A tibble: 6 × 4
## Month Total_Cost Total_Revenue Total_Profit
## <fct> <dbl> <dbl> <dbl>
## 1 Jan 157500 207500 50000
## 2 Feb 169600 213000 43400
## 3 March 173000 222000 49000
## 4 April 231000 209000 -22000
## 5 May 136000 6281500 6145500
## 6 June 194000 203000 9000Results & Conclusions
After cleaning the business dataset via standardization of column names and dollar conversions across february and March, I was able to restructure the data into long form and compute profits by reducing costs from revenue.
The results show that January produced 50,000 in profit, then came March with 49,000 and February with 43,000. April was the single month with a staggering loss of 22,000.
The sudden profit gain of 6, 145, 000 in May showed an unusual turnout that may need to be studied before coming towards conclusive business decision.
Ultimately, reshaping the dataset facilitated the process of comparing monthly performance and pinpont unusual observations that can affect analysis.