Rationale

Priming theory, defined as the influence of media affects on an individual on their short-term behaviors and attitudes that are a result of processing attitudinal and behavioral cues embedded in media content, focuses specifically on the external response of an individual.

In this experiment, the variables of “Actions” and “NextDay” are reliant on the “Group” that they were subsequentially categorized in. Through the theory, it is expected for a certain amount of stimulus to affect an individual dependent on what group they were in, but the affect it had on them will diminish over time since Priming theory is so based in short-term results.

Hypothesis

Among the Violent group distribution over the two testing days, the average of violent acts will moderately decrease from the initial reading into the next day.

Variables & Method

Both the “Action” variable, the variable measuring the amount of violent actions after their initial stimulus, and “NextDay” variable, the variable following the amount of violent actions of the same groups after a 24 hour time period between the initial exposure, are dependent on the “Group” category, specifically focusing with the “Violent Game” group and the resulting violent actions from their stimulus. Therefore, a paired-sample t-test would be used to test the information.

Results

This analysis hypothesized that among the Violent group distribution over the two testing days, the average of violent acts will moderately decrease from the initial reading into the next day. The analysis found that over the 24 hour period, the average of violent acts from the violent game group decreased by approximately 4.8 acts over the course of the days. A Shapiro-Wilks test indicated that a paired sample t-test would be suitable. Therefore, the t-test found the difference to be statistically significant (t(-13.416) = 39, p < .05).

Code and output

# Read the data from the web
FetchedData <- read.csv("https://drkblake.com/wp-content/uploads/2023/10/Priming2day.csv")
# Save the data on your computer
write.csv(FetchedData, "Priming2day.csv", row.names=FALSE)
# remove the data from the environment
rm (FetchedData)

# Installing required packages
if (!require("dplyr"))
  install.packages("dplyr")
## Loading required package: 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
if (!require("tidyverse"))
  install.packages("tidyverse")
## Loading required package: tidyverse
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ readr     2.1.4
## ✔ ggplot2   3.4.3     ✔ stringr   1.5.0
## ✔ lubridate 1.9.2     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
library(ggplot2)
options(scipen = 999)

# Read the data
mydata <- read.csv("Priming2day.csv") #Edit YOURFILENAME.csv

# Specify the two variables involved
mydata$V1 <- mydata$Actions
mydata$V2 <- mydata$NextDay

# Look at the distribution of the pair differences
mydata$PairDifferences <- mydata$V2 - mydata$V1

ggplot(mydata, aes(x = PairDifferences)) +
  geom_histogram(color = "black", fill = "#1f78b4") +
  geom_vline(aes(xintercept = mean(PairDifferences)))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Get descriptive statistics for pair differences
mydata %>%
  select(PairDifferences) %>%
  summarise(
    count = n(),
    mean = mean(PairDifferences, na.rm = TRUE),
    sd = sd(PairDifferences, na.rm = TRUE),
    min = min(PairDifferences, na.rm = TRUE),
    max = max(PairDifferences, na.rm = TRUE)
  )
##   count   mean       sd min max
## 1    40 -4.825 2.274581 -10   0
# Shapiro-Wilk test
options(scipen = 999)
shapiro.test(mydata$PairDifferences)
## 
##  Shapiro-Wilk normality test
## 
## data:  mydata$PairDifferences
## W = 0.97758, p-value = 0.6003
mydata %>%
  select(V1, V2) %>%
  summarise_all(list(Mean = mean, SD = sd))
##   V1_Mean V2_Mean   V1_SD    V2_SD
## 1    14.7   9.875 1.77157 2.652406
wilcox.test(mydata$V1, mydata$V2, paired = TRUE)
## Warning in wilcox.test.default(mydata$V1, mydata$V2, paired = TRUE): cannot
## compute exact p-value with ties
## Warning in wilcox.test.default(mydata$V1, mydata$V2, paired = TRUE): cannot
## compute exact p-value with zeroes
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  mydata$V1 and mydata$V2
## V = 780, p-value = 0.00000005065
## alternative hypothesis: true location shift is not equal to 0
# If the pair differences are normally distributed,
# though, you may use a paired-samples t-test.

mydata %>%
  select(V1, V2) %>%
  summarise_all(list(Mean = mean, SD = sd))
##   V1_Mean V2_Mean   V1_SD    V2_SD
## 1    14.7   9.875 1.77157 2.652406
options(scipen = 999)
t.test(mydata$V2, mydata$V1,
       paired = TRUE)
## 
##  Paired t-test
## 
## data:  mydata$V2 and mydata$V1
## t = -13.416, df = 39, p-value = 0.0000000000000003399
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -5.552446 -4.097554
## sample estimates:
## mean difference 
##          -4.825