Assignment 03
Emily Tran
Question 1
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionnba_data <- read.csv("C:\\Users\\Emily Tran\\Documents\\My RStudio Projects\\assignment3\\NBA_Stats_23_24.csv")
nba_data %>%
select(contains ("FG")) %>%
head(5) %>%
print()## FG FGA FG. eFG.
## 1 3.2 6.3 0.501 0.529
## 2 3.1 6.8 0.459 0.497
## 3 3.2 6.1 0.525 0.547
## 4 7.5 14.3 0.521 0.529
## 5 2.3 5.6 0.411 0.4831(a)
Number of players with Free Throws per game greater than 0.5 and Assists per game greater than 0.7.
nba_data %>%
filter(FT > 0.5 & AST > 0.7) %>%
summarize(count = n()) %>%
print()## count
## 1 4051(b)
Print the Player, Team, Field goals per game, Turnovers per game, and Points per game of the players with the 10 highest points, in descending order of points.
nba_data %>%
select("Player", "Tm", "FG", "TOV", "PTS") %>%
arrange(desc(PTS)) %>%
head(10) %>%
print()## Player Tm FG TOV PTS
## 1 Joel Embiid PHI 11.5 3.8 34.7
## 2 Luka Don?i? DAL 11.5 4.0 33.9
## 3 Giannis Antetokounmpo MIL 11.5 3.4 30.4
## 4 Shai Gilgeous-Alexander OKC 10.6 2.2 30.1
## 5 Jalen Brunson NYK 10.3 2.4 28.7
## 6 Devin Booker PHO 9.4 2.6 27.1
## 7 Kevin Durant PHO 10.0 3.3 27.1
## 8 Jayson Tatum BOS 9.1 2.5 26.9
## 9 De'Aaron Fox SAC 9.7 2.6 26.6
## 10 Donovan Mitchell CLE 9.1 2.8 26.6Which player has the seventh highest points?
Based on the
output, the player with the seventh highest points is Kevin Durant.
1(c)
Add two new columns to the dataframe: FGP (in percentage) is the ratio of FG to FGA, FTP (in percentage) is the ratio of FT to FTA. Note that the unit should be expressed in percentage (ranging from 0 to 100) and rounded to 2 decimal places (e.g., for Jamal Cain, FGP is 43.33) (mutate(), assign()).
nba_data <- nba_data %>%
mutate(
FGP = round((FG / FGA) * 100, 2),
FTP = round((FT / FTA) * 100, 2)
)What is the FGP and FTP for Josh Giddey?
print(nba_data$FGP[nba_data$Player == "Josh Giddey"])## [1] 47.17print(nba_data$FTP[nba_data$Player == "Josh Giddey"])## [1] 81.251(d)
Display the average, min and max Offensive rebounds per game for each team, in descending order of the team average. (group_by(), summarise(), groupby(), agg()). You can exclude NAs for this calculation.
ORB_data <- nba_data %>%
group_by(Tm) %>%
summarize(
avg_ORB = mean(ORB),
min_ORB = min(ORB),
max_ORB = max(ORB)
) %>%
arrange(desc(avg_ORB))Which team has the max Offensive rebounds per game?
print(ORB_data$Tm[max(ORB_data$max_ORB)])## [1] "ATL"1(e)
In question 1c, you added a new column called FTP. Impute the missing (or NaN) FTP values as the FGP (also added in 1c) multiplied by the average FTP for that team. Make a second copy of your dataframe, but this time impute missing (or NaN) FTP values with just the average FTP for that team. (group_by(), mutate(), groupby(),assign())
nba_data_copy1 <- nba_data %>%
group_by(Tm) %>%
mutate(
FTP = ifelse(is.na(FTP), FGP * mean(FTP, na.rm = TRUE), FTP)
) %>%
ungroup()
nba_data_copy2 <- nba_data %>%
group_by(Tm) %>%
mutate(
FTP = ifelse(is.na(FTP), mean(FTP, na.rm = TRUE), FTP)
) %>%
ungroup()
print(nba_data_copy1$Player[is.nan(nba_data_copy1$FTP)])## [1] "Marques Bolden" "Malcolm Cazalon" "Ron Harper Jr."
## [4] "Justin Jackson" "Trey Jemison" "Kira Lewis Jr."
## [7] "Filip Petru\x9aev" "Javonte Smart"print(nba_data_copy2$Player[is.nan(nba_data_copy2$FTP)])## character(0)What assumptions do these data filling methods make? Which is the
best way to impute the data, or do you see a better way, and why? You
may impute or remove other variables as you find appropriate. Briefly
explain your decisions.
The first method assumes that a
player’s FGP must be greater than zero. If it is also NaN, then the
imputing would have no effect, and as you can see, 8 players still had a
FTP of NaN after the change was implemented. The second method assumes
that at the very least, the entire team’s average FTP would not be 0,
which a highly likely assumption. However, that means the player’s FTP
will not be accurate to their actual performance (FTP of NaN is usually
caused by a FTA of 0). So, a more accurate method would be to make the
FTP of a player with NaN to be “0”.
Question 2
library(tidyr)
library(readr)
library(ggplot2)
billboard_longer <- billboard |>
pivot_longer(
cols = starts_with("wk"),
names_to = "week",
values_to = "rank",
values_drop_na = TRUE
) |>
mutate(
week = parse_number(week)
)
billboard_longer |>
ggplot(aes(x = week, y = rank, group = track)) +
geom_line(alpha = 0.25) +
scale_y_reverse()
billboard_longer## # A tibble: 5,307 × 5
## artist track date.entered week rank
## <chr> <chr> <date> <dbl> <dbl>
## 1 2 Pac Baby Don't Cry (Keep... 2000-02-26 1 87
## 2 2 Pac Baby Don't Cry (Keep... 2000-02-26 2 82
## 3 2 Pac Baby Don't Cry (Keep... 2000-02-26 3 72
## 4 2 Pac Baby Don't Cry (Keep... 2000-02-26 4 77
## 5 2 Pac Baby Don't Cry (Keep... 2000-02-26 5 87
## 6 2 Pac Baby Don't Cry (Keep... 2000-02-26 6 94
## 7 2 Pac Baby Don't Cry (Keep... 2000-02-26 7 99
## 8 2Ge+her The Hardest Part Of ... 2000-09-02 1 91
## 9 2Ge+her The Hardest Part Of ... 2000-09-02 2 87
## 10 2Ge+her The Hardest Part Of ... 2000-09-02 3 92
## # ℹ 5,297 more rows
# 2(a) Explain why this line “> mutate(week =
parse_number(week))” is necessary to properly tidy the data. What
happens if you skip this line?
If that line is skipped, the
resulting graph is no longer accurately placed. The x values are placed
in order of the string, so “wk10” is technically alphabetically first
compared to “wk9”. That graph did not accurately represent the lasting
popularity of a song, as a song that extends to week 70 would have a
shorter line than one that only went up to week 9.
2(b)
How many entries are removed from the dataset when you set
values_drop_na to true in the pivot_longer command (in this dataset)?
18785 entries were removed after values_drop_na was set to
true.
2(c)
Explain the difference between an explicit and implicit missing
value, in general. Can you find any implicit missing values in this
dataset? If so, where?
An explicit value is one that is missing
from a cell of a row when there should be an input. Usually that cell
would have a value of “NA”. An implicit missing value is when an entire
row of data is missing. If you mean implicit missing values in the
dataset after running “values_drop_na = TRUE”, then the first song “Baby
Don’t Cry” by 2Pac technically has missing rows for weeks 8-76 after
they were removed.
2(d)
Looking at the features (artist, track, date.entered, week, rank) in
the tidied data, are they all appropriately typed? Are there any
features you think would be better suited as a different type? Why or
why not?
The “week” and “rank” types are doubles when they
would be better suited as integers, considering weeks and ranks have no
reason to become decimals.
2(e)
Generate an informative visualization, which shows something about the data.
billboard_max_week <- billboard_longer %>%
group_by(artist, track) %>%
summarize(max_week = max(week), na.rm = TRUE)## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by artist and track.
## ℹ Output is grouped by artist.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(artist, track))` for per-operation grouping
## (`?dplyr::dplyr_by`) instead.ggplot(
data = billboard_max_week,
mapping = aes(x = max_week)
) +
geom_histogram() +
labs(
title = "Track Count by Its Max Week on Billboard",
x = "Total Weeks",
y = "Total Tracks"
)## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
Give a brief description of what it shows, and why you thought it
would be interesting to investigate.
The histogram shows the
count of tracks based on its max week on the Billboard. Based on the
output, most songs reach to around the 20th week on the Billboard. I
wanted to see how long songs usually last for once they’ve reached the
Billboard rankings.
2(f)
Generate a line plot showing the rank progression of a specific song over time. You can choose a song you like best from the dataset. (Hint: higher ranks are better so reverse your axis appropriately).
kryptonite <- billboard_longer %>%
filter(artist == "3 Doors Down" & track == "Kryptonite")
kryptonite |>
ggplot(aes(x = week, y = rank)) +
geom_line() +
scale_y_reverse(
limits = c(100,1),
breaks = seq(1, 100, by = 10)
) +
labs(
title = "Rank over Time: \"Kryptonite\" by 3 Doors Down"
)
Briefly describe what the plot shows.
The line plot shows
the rank progression of the song “Kryptonite” by 3 Doors Down. It first
started lower in the ranks, and steadily increased its ranking until
week 30, where it almost reached rank 1. After that, it eventually
decreased, approaching rank 50 by week 53.
2(g)
Produce a barplot to show the count of songs per artist in the dataset. Limit the plot to the top 15 artists by number of songs.
top_15 <- billboard_longer %>%
group_by(artist) %>%
summarize(song_count = n_distinct(track)) %>%
slice_max(song_count, n = 15, with_ties = FALSE)
top_15## # A tibble: 15 × 2
## artist song_count
## <chr> <int>
## 1 Jay-Z 5
## 2 Dixie Chicks, The 4
## 3 Houston, Whitney 4
## 4 Aguilera, Christina 3
## 5 Backstreet Boys, The 3
## 6 Braxton, Toni 3
## 7 DMX 3
## 8 Destiny's Child 3
## 9 Eminem 3
## 10 Jackson, Alan 3
## 11 Limp Bizkit 3
## 12 Lonestar 3
## 13 Martin, Ricky 3
## 14 McGraw, Tim 3
## 15 N'Sync 3ggplot(
data = top_15,
mapping = aes(
x = artist,
y = song_count
)
) +
geom_col() +
coord_flip() +
labs(
title = "Top 15: Song Count on Billboard Per Artist",
x = "Artist Name",
y = "Song Count in Billboard"
)
What are your thoughts about this top 15 list? Were you surprised by
the presence of any particular artist?
I did not expect Jay-Z to
be the one with the most songs on the Billboard, even surpassing Whitney
Houston. Also, who in the world are The Dixie Chicks?
2(h)
rev_data <- read.csv("C:\\Users\\Emily Tran\\Documents\\My RStudio Projects\\assignment3\\RevQtr.csv")Re-structure this table and show the code you would write to tidy the dataset (using gather()/pivot_longer() and separate()/pivot_wider() or melt() and pivot()) such that the columns are organized as: Group, Year, Interval_Type, Interval_ID and Revenue.
rev_data_tidy <- rev_data %>%
gather(key = "Interval_ID", value = "Revenue", 3:6)
rev_data_tidy$Interval_ID = as.numeric(gsub("\\D", "", rev_data_tidy$Interval_ID))
rev_data_tidy <- cbind(rev_data_tidy, Interval_Type = "Qtr")
rev_data_tidy <- rev_data_tidy %>%
relocate(Interval_Type, .after = Year)
print(head(rev_data_tidy, 5))## Group Year Interval_Type Interval_ID Revenue
## 1 1 2022 Qtr 1 61
## 2 1 2023 Qtr 1 30
## 3 1 2024 Qtr 1 84
## 4 2 2022 Qtr 1 31
## 5 2 2023 Qtr 1 39How many rows does the new dataset have?
The new dataset has
48 rows.