Data Dive - 11

library(ggplot2)

Keep up to date with changes at https://tidyverse.org/blog/

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, union

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ lubridate 1.9.4     ✔ tibble    3.2.1
✔ purrr     1.0.2     ✔ tidyr     1.3.1
✔ readr     2.1.5     ── Conflicts ────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors

#Reading the data set
data <- read.csv("dataset.csv")
conflicted::conflicts_prefer(dplyr::filter)

[conflicted] Will prefer dplyr::filter over any other package.

# Filtering dataset where explicit is "True" and taking a sample of 9,000 rows
sample_data <- data |> filter(explicit == "True") |> sample_n(9000)
data <- sample_data
data

Build a linear (or generalized linear) model as you like.Use whatever response variable and explanatory variables you prefer.

model <- lm(popularity ~ danceability + energy + acousticness + valence + tempo + loudness + duration_ms, data = data)
summary(model)

Call:
lm(formula = popularity ~ danceability + energy + acousticness + 
    valence + tempo + loudness + duration_ms, data = data)

Residuals:
   Min     1Q Median     3Q    Max 
-47.20 -15.57   0.13  18.71  65.83 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)   5.990e+01  3.069e+00  19.521  < 2e-16 ***
danceability -5.341e+00  1.863e+00  -2.867 0.004158 ** 
energy       -2.727e+01  2.067e+00 -13.189  < 2e-16 ***
acousticness -6.563e-01  1.144e+00  -0.574 0.566073    
valence       7.031e-01  1.243e+00   0.566 0.571564    
tempo         3.037e-02  8.651e-03   3.511 0.000449 ***
loudness      6.289e-01  1.144e-01   5.498 3.96e-08 ***
duration_ms  -1.228e-06  3.014e-06  -0.407 0.683693    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 24 on 8992 degrees of freedom
Multiple R-squared:  0.02459,   Adjusted R-squared:  0.02383 
F-statistic: 32.38 on 7 and 8992 DF,  p-value: < 2.2e-16

Use the tools from previous weeks to diagnose the model.

1.Residual Histogram

# Assuming your linear model is called 'lm_model'
# Calculate residuals
residuals <- residuals(lm_model)

# Plot histogram of residuals
hist(residuals, main="Histogram of Residuals", xlab="Residuals", col="lightblue", border="black")

The histogram displays the distribution of residuals from the model, showing their frequency across different ranges. It suggests that the residuals are approximately symmetric but may not perfectly follow a normal distribution.

2. Residuals vs Fitted Values Plot

# Plot residuals vs fitted values
plot(fitted(lm_model), residuals, main="Residuals vs Fitted Values", xlab="Fitted Values", ylab="Residuals", pch=20)
abline(h=0, col="red", lwd=2)  # Add a horizontal line at 0

The plot shows residuals versus fitted values from a linear regression model. Residuals are scattered randomly around the red line at zero, indicating no obvious pattern and suggesting the model fits the data reasonably well.

3. QQ-Plot

# Generate QQ-Plot
qqnorm(residuals)
qqline(residuals, col="red", lwd=2)

The Normal Q-Q plot compares the residuals of a model to a theoretical normal distribution. Most points align with the red diagonal line, indicating approximate normality, but deviations at the tails suggest potential outliers or non-normal behavior. This may impact the model’s assumptions and require further diagnostics.

4. Cook’s Distance by Observation

# Calculate Cook's Distance
cooks_d <- cooks.distance(lm_model)

# Plot Cook's Distance by observation
plot(cooks_d, type="h", main="Cook's Distance by Observation", xlab="Observation", ylab="Cook's Distance", col="blue")
abline(h=4 / length(cooks_d), col="red", lwd=2)  # Threshold line

The graph represents Cook’s Distance for each observation in a dataset, which measures the influence of individual observations on the regression model.Most observations have very low Cook’s Distance (below the red threshold line), indicating they have minimal impact on the model’s coefficients. A few spikes above the red threshold line suggest influential observations that could disproportionately affect the model’s results.

Highlight any issues with the model.

Key Model Issues Identified:

Non-Normal Residuals: Q-Q plot deviations at the tails and histogram asymmetry suggest residuals may violate normality assumptions.

Potential Heteroscedasticity: Slight funnel-shaped pattern in residuals vs. fitted implies non-constant variance, risking biased error estimates.

Influential Outliers: High Cook’s Distance values and outlier residuals indicate data points disproportionately affecting model accuracy.

Interpret at least one of the coefficients.

Let’s interpret the “danceability” coefficient from the model:

Coefficient for Danceability: -4.742e+00 (or -4.742)

Interpretation: For every one-unit increase in danceability, the dependent variable (e.g., popularity) is expected to decrease by 4.742 units, holding all other variables constant.

Significance: The p-value for danceability is 0.010899, which is less than 0.05, indicating that the relationship between danceability and the dependent variable is statistically significant at the 5% level.

Context: A negative coefficient means that as the danceability of a track increases, the outcome variable decreases, suggesting that higher danceability may negatively influence the target variable(popularity) in this model.