social_ads
2024-04-21
#Name: Fanshi Zhang
#Research Question: Is there a difference in age between those who will purchase after seeing the ads and those who will not?
To answer the question, we need to collect two variable: age, and whether one purchase or not.
#Hypothesis: Between the group who purchased and who don’t purchase after seeing the ads, the ages are different.
H0: μN = μY, the average age is the same.
H1: μN ≠ μY，the average age is different.
mydata <- read.table("./social_ads.csv",
header = TRUE,
sep = ",",
dec = ",")
head(mydata)## Age EstimatedSalary Purchased
## 1 19 19000 0
## 2 35 20000 0
## 3 26 43000 0
## 4 27 57000 0
## 5 19 76000 0
## 6 27 58000 0#Description
Age: age of the individual in years;
EstimatedSalary: Estimated salary of the individual per year in dollars;
Purchased: whether the individual made a purchase (1) or not (0) after seeing the advertisement
Unit: an individual
sample size: 400
Data source:https://www.kaggle.com/datasets/sakshisatre/social-advertisement-dataset?resource=download
The main variables are Age and Purchased, the EstimatedSalary is not needed in this research question.
mydata <- mydata[ , -2]
head(mydata)## Age Purchased
## 1 19 0
## 2 35 0
## 3 26 0
## 4 27 0
## 5 19 0
## 6 27 0mydata$PurchasedF <- factor(mydata$Purchased,
levels = c(0, 1),
labels = c("No", "Yes"))
library(psych)
describeBy(mydata$Age, mydata$Purchased)##
## Descriptive statistics by group
## group: 0
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 257 32.79 7.99 34 32.71 8.9 18 59 41 0.21 -0.17 0.5
## ------------------------------------------------------------
## group: 1
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 143 46.39 8.61 47 46.73 10.38 27 60 33 -0.28 -0.76 0.72In those who will not purchase after seeing the ads, the average age is 32.79, the standard deviation is 7.99 and the median is 34, which means half the people are younger than 34 and half are older than 34.
In those who will purchase, the average age is 46.39, the standard deviation is 46.39 and the median is 47.
library(ggplot2)##
## 载入程辑包：'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphaPurchase_no <- ggplot(mydata[mydata$PurchasedF == "No", ], aes(x = Age)) +
theme_linedraw() +
geom_histogram() +
ggtitle("Not Purchase")
Purchase_yes <- ggplot(mydata[mydata$PurchasedF == "Yes", ], aes(x = Age)) +
theme_linedraw() +
geom_histogram() +
ggtitle("Purchase")
library(ggpubr)
ggarrange(Purchase_no, Purchase_yes,
ncol = 2, nrow = 1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
library(car)## 载入需要的程辑包：carData##
## 载入程辑包：'car'## The following object is masked from 'package:psych':
##
## logitleveneTest(mydata$Age, group = mydata$PurchasedF)## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 1 0.2659 0.6064
## 398H0: the variance in two groups are the same
H1: the variance is different
since the p-value is greater than 0.05, we accept the H0, so the variance are the same.
library(dplyr)##
## 载入程辑包：'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(rstatix)##
## 载入程辑包：'rstatix'## The following object is masked from 'package:stats':
##
## filtermydata %>%
group_by(PurchasedF) %>%
shapiro_test(Age)## # A tibble: 2 × 4
## PurchasedF variable statistic p
## <fct> <chr> <dbl> <dbl>
## 1 No Age 0.979 0.000659
## 2 Yes Age 0.964 0.000863#shapiro test for group”purchase_no”
H0: the age is normally distributed in the group”purchase_no”
H1: the age is not normally distributed in the group”purchase_no”
the p-value is smaller than 0.05, we should reject null hypothesis, so the age is not normally distributed in group”purchase_no”.
#shapiro test for group”purchase_yes”
H0: the age is normally distributed in the group”Purchase_yes”
H1: the age is not normally distributed in the group”purchase_yes”
the p-value is smaller than 0.05, we should reject null hypothesis, so the age is not normally distributed in group”purchase_yes”.
#WILCOXON RANK SUM TEST
Since the people in two groups are different, they are independent samples.
Also, the age in two groups are not normally distributed, so we should use non-parametric test, Wilcoxin rank sum test, to test if the location of distribution of age is the same.
H0: the location of distribution of age between the group”purchase_no” and the group”purchase_yes” is the same.
H1: the location of distribution of age between the group”purchase_no” and the group”purchase_yes” is different.
wilcox.test(mydata$Age ~ mydata$PurchasedF,
paired = FALSE,
correct = FALSE,
exact = FALSE,
alternative = "two.sided")##
## Wilcoxon rank sum test
##
## data: mydata$Age by mydata$PurchasedF
## W = 4830, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0the P-value is much smaller than 0.05, so we reject the null hypothesis, so the locations of distribution of age between group”purchase_no” and group”purchase_yes” are different.
library(effectsize)##
## 载入程辑包：'effectsize'## The following objects are masked from 'package:rstatix':
##
## cohens_d, eta_squared## The following object is masked from 'package:psych':
##
## phieffectsize(wilcox.test(mydata$Age ~ mydata$PurchasedF,
paired = FALSE,
correct = FALSE,
exact = FALSE,
alternative = "two.sided"))## r (rank biserial) | 95% CI
## ----------------------------------
## -0.74 | [-0.79, -0.68]interpret_rank_biserial(0.74)## [1] "very large"
## (Rules: funder2019)#Conclusion
Based on the sample data, we can prove that the age differs between those who will not purchase after seeing the ads and those who will purchase.(The effect size is vary large, d = 0.74)