Rationale

The examination of these two variables is based on cultivation theory, which suggests that people’s perceptions of reality can be influenced by their exposure to television content. In this conducted study, video represents the average number of hours participants spent watching television each week, while pct represents the percentage of the U.S. population that participants estimated to work in law enforcement/criminal justice, medicine, or emergency response services.

These occupations are frequently represented in television programming, particularly in crime dramas, medical shows, and emergency-response programs. Therefore, participants who spend more time watching television may have different perceptions of how common these occupations are in the real world. A regression analysis can be used to examine whether the amount of television a participant watches is associated with their estimate of the percentage of the population working in these professions. In this analysis, pct would be the independent variable and video would be the dependent variable.

Hypothesis

The estimated percentage of the U.S. population employed in law enforcement/criminal justice, medicine, or emergency response services (pct) is linearly related to the average weekly hours spent watching television content (video).

Variables & Method

The independent variable in the analysis was the estimated percentage of the U.S. population employed in law enforcement/criminal justice, medicine, or emergency response services (pct). The dependent variable was the average number of hours per week each participant spent watching television content (video).

A sample of 400 participants was gathered from a random sample of U.S. adults. Participants connected a monitoring device to their household television or other devices used to watch television content. The device recorded the number of hours each participant personally spent watching television content each week. Data were collected over a six-month period. After the six-month monitoring period, participants completed a questionnaire asking them to estimate the percentage of the U.S. population employed in law enforcement/criminal justice, medicine, or emergency response services. The percentages for each occupation were then summed to create the pct variable.

A linear regression analysis was used to test for a statistically significant linear relationship between the estimated percentage of the population employed in these occupations (pct) and the average weekly hours spent watching television content (video).

Results & Discussion

The graphs below show a linear regression line that plots our independent and dependent variables together. As well as a Regression Analysis Result.

## `geom_smooth()` using formula = 'y ~ x'

Regression Analysis Results
Coefficient Estimates
Term Estimate Std. Error t p-value
(Intercept) 14.9525 1.4656 10.2026 0.0000
IV 0.3686 0.0275 13.4056 0.0000

As shown in our Regression Analysis Result, we see that our p-value is below the .05 threshold and thus confirms that there is a statistically significant relationship between pct and video.

Code

##################################################
# 1. Install and load required packages
##################################################
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("gt")) install.packages("gt")
if (!require("gtExtras")) install.packages("gtExtras")

library(tidyverse)
library(gt)
library(gtExtras)


##################################################
# 2. Read in the dataset
##################################################
# Replace "YOURFILENAME.csv" with the actual filename
mydata <- read.csv("Cultivation.csv")


# ################################################
# # (Optional) 2b. Remove specific cases by row number
# ################################################
# # Example: remove rows 10 and 25
# rows_to_remove <- c(10, 25) # Edit and uncomment this line
# mydata <- mydata[-rows_to_remove, ] # Uncomment this line


##################################################
# 3. Define dependent variable (DV) and independent variable (IV)
##################################################
# Replace YOURDVNAME and YOURIVNAME with actual column names
mydata$DV <- mydata$video
mydata$IV <- mydata$pct


##################################################
# 4. Explore distributions of DV and IV
##################################################
# Make a histogram for DV
DVGraph <- ggplot(mydata, aes(x = DV)) + 
  geom_histogram(color = "black", fill = "#1f78b4")

# Make a histogram for IV
IVGraph <- ggplot(mydata, aes(x = IV)) + 
  geom_histogram(color = "black", fill = "#1f78b4")


##################################################
# 5. Fit and summarize initial regression model
##################################################
# Suppress scientific notation
options(scipen = 999)

# Fit model
myreg <- lm(DV ~ IV, data = mydata)

# Model summary
summary(myreg)


##################################################
# 6. Visualize regression and check for bivariate outliers
##################################################
# Create scatterplot with regression line as a ggplot object
RegressionPlot <- ggplot(mydata, aes(x = IV, y = DV)) +
  geom_point(color = "#1f78b4") +
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(
    title = "Scatterplot of DV vs IV with Regression Line",
    x = "Independent Variable (IV)",
    y = "Dependent Variable (DV)"
  ) +
  theme_minimal()


##################################################
# 7. Check for potential outliers (high leverage points)
##################################################
# Calculate leverage values
hat_vals <- hatvalues(myreg)

# Rule of thumb: leverage > 2 * (number of predictors + 1) / n may be influential
threshold <- 2 * (length(coef(myreg)) / nrow(mydata))

# Create table showing 10 largest leverage values
outliers <- data.frame(
  Obs = 1:nrow(mydata),
  Leverage = hatvalues(myreg)
) %>%
  arrange(desc(Leverage)) %>%
  slice_head(n = 10)

# Format as a gt table
outliers_table <- outliers %>%
  gt() %>%
  tab_header(
    title = "Leverage estimates for 10 largest outliers"
  ) %>%
  cols_label(
    Obs = "Row #",
    Leverage = "Leverage"
  ) %>%
  fmt_number(
    columns = Leverage,
    decimals = 4
  )


##################################################
# 8. Create nicely formatted regression results tables
##################################################
# --- Coefficient-level results ---
reg_results <- as.data.frame(coef(summary(myreg))) %>%
  tibble::rownames_to_column("Term") %>%
  rename(
    Estimate = Estimate,
    `Std. Error` = `Std. Error`,
    t = `t value`,
    `p-value` = `Pr(>|t|)`
  )

reg_table <- reg_results %>%
  gt() %>%
  tab_header(
    title = "Regression Analysis Results",
    subtitle = "Coefficient Estimates"
  ) %>%
  fmt_number(
    columns = c(Estimate, `Std. Error`, t, `p-value`),
    decimals = 4
  )


# --- Model fit statistics ---
reg_summary <- summary(myreg)

fit_stats <- tibble::tibble(
  `R-squared` = reg_summary$r.squared,
  `Adj. R-squared` = reg_summary$adj.r.squared,
  `F-statistic` = reg_summary$fstatistic[1],
  `df (model)` = reg_summary$fstatistic[2],
  `df (residual)` = reg_summary$fstatistic[3],
  `Residual Std. Error` = reg_summary$sigma
)

fit_table <- fit_stats %>%
  gt() %>%
  tab_header(
    title = "Model Fit Statistics",
    subtitle = "Overall Regression Performance"
  ) %>%
  fmt_number(
    columns = everything(),
    decimals = 4
  )


##################################################
# 9. Final print of key graphics and tables
##################################################
DVGraph
IVGraph
RegressionPlot
outliers_table
reg_table
fit_table