library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.3
setwd("C:/Users/amode/OneDrive/Documents/Dida 325")
data <- read.csv("final/data.csv")
#View(data)
popularity_range <- range(data$popularity)
print(popularity_range)
## [1] 0 100
data2 <- data %>%
group_by(year) %>%
filter(rank(desc(popularity)) <= n() * 0.1) %>%
ungroup()
#View(data2)
summary(data2)
## id name artists duration_ms
## Length:16946 Length:16946 Length:16946 Min. : 30241
## Class :character Class :character Class :character 1st Qu.: 176533
## Mode :character Mode :character Mode :character Median : 212640
## Mean : 228709
## 3rd Qu.: 259487
## Max. :2220135
## release_date year acousticness danceability
## Length:16946 Min. :1921 Min. :0.0000 Min. :0.0000
## Class :character 1st Qu.:1957 1st Qu.:0.0854 1st Qu.:0.4560
## Mode :character Median :1978 Median :0.4210 Median :0.5770
## Mean :1977 Mean :0.4591 Mean :0.5653
## 3rd Qu.:1999 3rd Qu.:0.8300 3rd Qu.:0.6860
## Max. :2020 Max. :0.9960 Max. :0.9880
## energy instrumentalness liveness loudness
## Min. :0.0000201 Min. :0.0000000 Min. :0.0000 Min. :-41.808
## 1st Qu.:0.2990000 1st Qu.:0.0000000 1st Qu.:0.0941 1st Qu.:-13.313
## Median :0.5140000 Median :0.0000437 Median :0.1290 Median : -9.721
## Mean :0.5094580 Mean :0.1095927 Mean :0.1891 Mean :-10.491
## 3rd Qu.:0.7240000 3rd Qu.:0.0102000 3rd Qu.:0.2380 3rd Qu.: -6.571
## Max. :0.9990000 Max. :1.0000000 Max. :0.9930 Max. : -0.007
## speechiness tempo valence mode
## Min. :0.0000 Min. : 0.00 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0337 1st Qu.: 95.03 1st Qu.:0.3480 1st Qu.:0.0000
## Median :0.0424 Median :115.67 Median :0.5660 Median :1.0000
## Mean :0.0740 Mean :117.76 Mean :0.5519 Mean :0.7041
## 3rd Qu.:0.0650 3rd Qu.:135.09 3rd Qu.:0.7650 3rd Qu.:1.0000
## Max. :0.9630 Max. :216.30 Max. :0.9910 Max. :1.0000
## key popularity explicit
## Min. : 0.000 Min. : 1.00 Min. :0.00000
## 1st Qu.: 2.000 1st Qu.: 38.00 1st Qu.:0.00000
## Median : 5.000 Median : 57.00 Median :0.00000
## Mean : 5.195 Mean : 50.38 Mean :0.07689
## 3rd Qu.: 8.000 3rd Qu.: 66.00 3rd Qu.:0.00000
## Max. :11.000 Max. :100.00 Max. :1.00000
ggplot(data2) +
geom_point(aes(x=year, y=popularity)) +
xlab("Engine Displacement (L)") +
ylab("Miles Per Gallon (City Driving)")
most_popular <- data2 %>%
group_by(year) %>%
filter(rank(desc(popularity)) == 1) %>%
ungroup()
ggplot(most_popular, aes(x = year, y = popularity)) +
geom_line() +
geom_point() +
labs(x = "Year", y = "Popularity", title = "Popularity of the Most Popular Songs by Year")
most_popular <- data2 %>%
group_by(year) %>%
filter(rank(desc(tempo)) == 1) %>%
ungroup()
ggplot(most_popular, aes(x = year, y = tempo)) +
geom_line() +
geom_point() +
labs(x = "Year", y = "Popularity", title = "tempo of the Most Popular Songs by Year")
most_popular <- data2 %>%
group_by(year) %>%
filter(rank(desc(speechiness)) == 1) %>%
ungroup()
ggplot(most_popular, aes(x = year, y = speechiness)) +
geom_line() +
geom_point() +
labs(x = "Year", y = "Popularity", title = "speechiness of the Most Popular Songs by Year")
ggplot(data2) +
geom_jitter(aes(x=year, y=speechiness), width=0.5) +
xlab("Engine Displacement (L)") +
ylab("Miles Per Gallon (City Driving)")
set.seed(210191)
split <- 0.80
rows <- nrow(data2)
train.entries <- sample(rows, rows*split)
data2.train <- data2[train.entries, ]
data2.valid <- data2[-train.entries, ]
model <- lm(year ~ duration_ms + tempo + speechiness, data=data2.train)
summary(model)
##
## Call:
## lm(formula = year ~ duration_ms + tempo + speechiness, data = data2.train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -109.593 -19.459 -0.751 21.149 53.842
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.958e+03 1.047e+00 1869.573 < 2e-16 ***
## duration_ms 3.950e-05 2.419e-06 16.328 < 2e-16 ***
## tempo 9.140e-02 7.178e-03 12.734 < 2e-16 ***
## speechiness -9.862e+00 2.079e+00 -4.742 2.13e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.16 on 13552 degrees of freedom
## Multiple R-squared: 0.03002, Adjusted R-squared: 0.02981
## F-statistic: 139.8 on 3 and 13552 DF, p-value: < 2.2e-16
model <- step(model, trace = 0)
summary(model)
##
## Call:
## lm(formula = year ~ duration_ms + tempo + speechiness, data = data2.train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -109.593 -19.459 -0.751 21.149 53.842
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.958e+03 1.047e+00 1869.573 < 2e-16 ***
## duration_ms 3.950e-05 2.419e-06 16.328 < 2e-16 ***
## tempo 9.140e-02 7.178e-03 12.734 < 2e-16 ***
## speechiness -9.862e+00 2.079e+00 -4.742 2.13e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.16 on 13552 degrees of freedom
## Multiple R-squared: 0.03002, Adjusted R-squared: 0.02981
## F-statistic: 139.8 on 3 and 13552 DF, p-value: < 2.2e-16
data2.train <- data2.train %>%
mutate(yhat = predict(model, newdata = data2.train)) %>%
mutate(residual = year - yhat)
data2.valid <- data2.valid %>%
mutate(yhat = predict(model, newdata = data2.valid)) %>%
mutate(residual = year - yhat)
options(scipen=999)
ggplot(data2.valid) +
geom_jitter(data = filter(data2.valid, yhat <= 2020),
aes(x = yhat, y = residual), width = 2) +
geom_hline(aes(yintercept = 0), linetype = "dashed", color = "blue") +
xlab("Predicted Popularity") +
ylab("Residual") +
ggtitle("Residuals vs. Year Popularity")
sd(data2.valid$residual)
## [1] 24.91839
sd(data2.train$residual)
## [1] 25.15971
library(dplyr)
library(ggplot2)
setwd("C:/Users/amode/OneDrive/Documents/Dida 325")
data <- read.csv("final/data.csv")
# View(data)
popularity_range <- range(data$popularity)
print(popularity_range)
## [1] 0 100
data$decade <- cut(data$year, breaks = seq(1920, 2020, by = 10),
labels = c("1920s", "1930s", "1940s", "1950s", "1960s",
"1970s", "1980s", "1990s", "2000s", "2010s"))
data2 <- data %>%
group_by(year) %>%
filter(rank(desc(popularity)) <= n() * 0.1) %>%
ungroup()
# View(data2)
summary(data2)
## id name artists duration_ms
## Length:16946 Length:16946 Length:16946 Min. : 30241
## Class :character Class :character Class :character 1st Qu.: 176533
## Mode :character Mode :character Mode :character Median : 212640
## Mean : 228709
## 3rd Qu.: 259487
## Max. :2220135
##
## release_date year acousticness danceability
## Length:16946 Min. :1921 Min. :0.0000 Min. :0.0000
## Class :character 1st Qu.:1957 1st Qu.:0.0854 1st Qu.:0.4560
## Mode :character Median :1978 Median :0.4210 Median :0.5770
## Mean :1977 Mean :0.4591 Mean :0.5653
## 3rd Qu.:1999 3rd Qu.:0.8300 3rd Qu.:0.6860
## Max. :2020 Max. :0.9960 Max. :0.9880
##
## energy instrumentalness liveness loudness
## Min. :0.0000201 Min. :0.0000000 Min. :0.0000 Min. :-41.808
## 1st Qu.:0.2990000 1st Qu.:0.0000000 1st Qu.:0.0941 1st Qu.:-13.313
## Median :0.5140000 Median :0.0000437 Median :0.1290 Median : -9.721
## Mean :0.5094580 Mean :0.1095927 Mean :0.1891 Mean :-10.491
## 3rd Qu.:0.7240000 3rd Qu.:0.0102000 3rd Qu.:0.2380 3rd Qu.: -6.571
## Max. :0.9990000 Max. :1.0000000 Max. :0.9930 Max. : -0.007
##
## speechiness tempo valence mode
## Min. :0.0000 Min. : 0.00 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0337 1st Qu.: 95.03 1st Qu.:0.3480 1st Qu.:0.0000
## Median :0.0424 Median :115.67 Median :0.5660 Median :1.0000
## Mean :0.0740 Mean :117.76 Mean :0.5519 Mean :0.7041
## 3rd Qu.:0.0650 3rd Qu.:135.09 3rd Qu.:0.7650 3rd Qu.:1.0000
## Max. :0.9630 Max. :216.30 Max. :0.9910 Max. :1.0000
##
## key popularity explicit decade
## Min. : 0.000 Min. : 1.00 Min. :0.00000 1960s :2018
## 1st Qu.: 2.000 1st Qu.: 38.00 1st Qu.:0.00000 1970s :2017
## Median : 5.000 Median : 57.00 Median :0.00000 1980s :2000
## Mean : 5.195 Mean : 50.38 Mean :0.07689 2000s :1992
## 3rd Qu.: 8.000 3rd Qu.: 66.00 3rd Qu.:0.00000 1990s :1986
## Max. :11.000 Max. :100.00 Max. :1.00000 1950s :1974
## (Other):4959
ggplot(data2, aes(x = year, y = popularity, color = decade)) +
geom_point() +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
xlab("Year") +
ylab("Popularity") +
ggtitle("Popularity of Songs by Year and Decade")
most_popular <- data2 %>%
group_by(year) %>%
filter(rank(desc(popularity)) == 1) %>%
ungroup()
ggplot(most_popular, aes(x = year, y = popularity, color = decade)) +
geom_line() +
geom_point() +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
labs(x = "Year", y = "Popularity", title = "Popularity of the Most Popular Songs by Year and Decade")
most_tempo <- data2 %>%
group_by(year) %>%
filter(rank(desc(tempo)) == 1) %>%
ungroup()
ggplot(most_tempo, aes(x = year, y = tempo, color = decade)) +
geom_line() +
geom_point() +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
labs(x = "Year", y = "Tempo", title = "Tempo of the Most Popular Songs by Year and Decade")
most_speechiness <- data2 %>%
group_by(year) %>%
filter(rank(desc(speechiness)) == 1) %>%
ungroup()
ggplot(most_speechiness, aes(x = year, y = speechiness, color = decade)) +
geom_line() +
geom_point() +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
labs(x = "Year", y = "Speechiness", title = "Speechiness of the Most Popular Songs by Year and Decade")
ggplot(data2, aes(x = year, y = speechiness, color = decade)) +
geom_jitter(width = 0.5) +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
xlab("Year") +
ylab("Speechiness") +
ggtitle("Speechiness of Songs by Year and Decade")
set.seed(210191)
split <- 0.80
rows <- nrow(data2)
train.entries <- sample(rows, rows * split)
data2.train <- data2[train.entries, ]
data2.valid <- data2[-train.entries, ]
model <- lm(year ~ duration_ms + tempo + speechiness, data = data2.train)
summary(model)
##
## Call:
## lm(formula = year ~ duration_ms + tempo + speechiness, data = data2.train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -109.593 -19.459 -0.751 21.149 53.842
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1958.239735179 1.047426385 1869.573 < 0.0000000000000002 ***
## duration_ms 0.000039500 0.000002419 16.328 < 0.0000000000000002 ***
## tempo 0.091402268 0.007177720 12.734 < 0.0000000000000002 ***
## speechiness -9.861665535 2.079465002 -4.742 0.00000213 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.16 on 13552 degrees of freedom
## Multiple R-squared: 0.03002, Adjusted R-squared: 0.02981
## F-statistic: 139.8 on 3 and 13552 DF, p-value: < 0.00000000000000022
model <- step(model, trace = 0)
summary(model)
##
## Call:
## lm(formula = year ~ duration_ms + tempo + speechiness, data = data2.train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -109.593 -19.459 -0.751 21.149 53.842
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1958.239735179 1.047426385 1869.573 < 0.0000000000000002 ***
## duration_ms 0.000039500 0.000002419 16.328 < 0.0000000000000002 ***
## tempo 0.091402268 0.007177720 12.734 < 0.0000000000000002 ***
## speechiness -9.861665535 2.079465002 -4.742 0.00000213 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.16 on 13552 degrees of freedom
## Multiple R-squared: 0.03002, Adjusted R-squared: 0.02981
## F-statistic: 139.8 on 3 and 13552 DF, p-value: < 0.00000000000000022
data2.train <- data2.train %>%
mutate(yhat = predict(model, newdata = data2.train)) %>%
mutate(residual = year - yhat)
data2.valid <- data2.valid %>%
mutate(yhat = predict(model, newdata = data2.valid)) %>%
mutate(residual = year - yhat)
options(scipen = 999)
ggplot(data2.valid, aes(x = yhat, y = residual, color = decade)) +
geom_jitter(data = filter(data2.valid, yhat <= 2020), width = 2) +
geom_hline(aes(yintercept = 0), linetype = "dashed", color = "blue") +
scale_color_manual(values = rainbow(10, start = 0.1, end = 0.9)) +
xlab("Predicted Popularity") +
ylab("Residual") +
ggtitle("Residuals vs. Predicted Popularity by Decade")
