Case Study 1
Brett Stokes
2/2/2021
R Markdown
Data1: Facebook Metrics - case study1 data
fbook=read.csv(“dataset_Facebook.csv”, header=TRUE)
library(mice)## Warning: package 'mice' was built under R version 4.0.3##
## Attaching package: 'mice'## The following object is masked from 'package:stats':
##
## filter## The following objects are masked from 'package:base':
##
## cbind, rbindlibrary(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, unionlibrary(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectlibrary(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recodelibrary(olsrr)## Warning: package 'olsrr' was built under R version 4.0.3##
## Attaching package: 'olsrr'## The following object is masked from 'package:MASS':
##
## cement## The following object is masked from 'package:datasets':
##
## riverslibrary(RColorBrewer)
library(moderndive)## Warning: package 'moderndive' was built under R version 4.0.3coul <- brewer.pal(5, "Set2")
setwd("C:/Users/bstok/Desktop/Park DA 6213 Data Drive Decision Making and Design/Case Study 1")
fbook=read.csv("dataset_Facebook.csv", header=TRUE)
head(fbook)## Page.total.likes Type Category Post.Month Post.Weekday Post.Hour Paid
## 1 139441 Photo 2 12 4 3 0
## 2 139441 Status 2 12 3 10 0
## 3 139441 Photo 3 12 3 3 0
## 4 139441 Photo 2 12 2 10 1
## 5 139441 Photo 2 12 2 3 0
## 6 139441 Status 2 12 1 9 0
## Lifetime.Post.Total.Reach Lifetime.Post.Total.Impressions
## 1 2752 5091
## 2 10460 19057
## 3 2413 4373
## 4 50128 87991
## 5 7244 13594
## 6 10472 20849
## Lifetime.Engaged.Users Lifetime.Post.Consumers Lifetime.Post.Consumptions
## 1 178 109 159
## 2 1457 1361 1674
## 3 177 113 154
## 4 2211 790 1119
## 5 671 410 580
## 6 1191 1073 1389
## Lifetime.Post.Impressions.by.people.who.have.liked.your.Page
## 1 3078
## 2 11710
## 3 2812
## 4 61027
## 5 6228
## 6 16034
## Lifetime.Post.reach.by.people.who.like.your.Page
## 1 1640
## 2 6112
## 3 1503
## 4 32048
## 5 3200
## 6 7852
## Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post comment
## 1 119 4
## 2 1108 5
## 3 132 0
## 4 1386 58
## 5 396 19
## 6 1016 1
## like share Total.Interactions
## 1 79 17 100
## 2 130 29 164
## 3 66 14 80
## 4 1572 147 1777
## 5 325 49 393
## 6 152 33 186fbook$weekday =
fbook$weekday[fbook$Post.Weekday==1]="Weekend";
fbook$weekday[fbook$Post.Weekday==2]="Weekday";
fbook$weekday[fbook$Post.Weekday==3]="Weekday";
fbook$weekday[fbook$Post.Weekday==4]="Weekday";
fbook$weekday[fbook$Post.Weekday==5]="Weekday";
fbook$weekday[fbook$Post.Weekday==6]="Weekend";
fbook$weekday[fbook$Post.Weekday==7]="Weekend";
fbook$timeofday =
fbook$timeofday[between(fbook$Post.Hour, 6, 12)]="Morning";
fbook$timeofday[between(fbook$Post.Hour, 12, 18)]="Afternoon";
fbook$timeofday[between(fbook$Post.Hour, 18, 24)]="Evening";
fbook$timeofday[between(fbook$Post.Hour, 0, 6)]="Late Night";
fbook$categorylabel =
fbook$categorylabel[fbook$Category==1]="Action";
fbook$categorylabel[fbook$Category==2]="Product";
fbook$categorylabel[fbook$Category==3]="Inspiration";
fbook$month =
fbook$month[fbook$Post.Month==1]="Q1";
fbook$month[fbook$Post.Month==2]="Q1";
fbook$month[fbook$Post.Month==3]="Q1";
fbook$month[fbook$Post.Month==4]="Q2";
fbook$month[fbook$Post.Month==5]="Q2";
fbook$month[fbook$Post.Month==6]="Q2";
fbook$month[fbook$Post.Month==7]="Q3";
fbook$month[fbook$Post.Month==8]="Q3";
fbook$month[fbook$Post.Month==9]="Q3";
fbook$month[fbook$Post.Month==10]="Q4";
fbook$month[fbook$Post.Month==11]="Q4";
fbook$month[fbook$Post.Month==12]="Q4";
ismissing = fbook[rowSums(is.na(fbook))!=0,]
print(ismissing)## Page.total.likes Type Category Post.Month Post.Weekday Post.Hour Paid
## 111 136736 Photo 1 10 6 8 0
## 120 136393 Photo 1 10 7 9 0
## 124 136393 Photo 1 10 7 6 0
## 164 135428 Photo 1 9 5 10 0
## 490 81370 Photo 2 1 4 4 NA
## Lifetime.Post.Total.Reach Lifetime.Post.Total.Impressions
## 111 1261 2158
## 120 584 1029
## 124 677 1285
## 164 1060 2004
## 490 4188 7292
## Lifetime.Engaged.Users Lifetime.Post.Consumers Lifetime.Post.Consumptions
## 111 37 37 49
## 120 273 271 308
## 124 251 246 297
## 164 266 251 337
## 490 564 524 743
## Lifetime.Post.Impressions.by.people.who.have.liked.your.Page
## 111 1911
## 120 943
## 124 1210
## 164 1705
## 490 3861
## Lifetime.Post.reach.by.people.who.like.your.Page
## 111 1077
## 120 511
## 124 615
## 164 870
## 490 2200
## Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post comment
## 111 33 0
## 120 232 0
## 124 211 0
## 164 204 0
## 490 316 0
## like share Total.Interactions weekday timeofday categorylabel month
## 111 NA NA 0 Weekend Morning Action Q4
## 120 2 NA 2 Weekend Morning Action Q4
## 124 7 NA 7 Weekend Late Night Action Q4
## 164 18 NA 18 Weekday Morning Action Q3
## 490 91 28 119 Weekday Late Night Product Q1# Exploratory Data
# Lifetime.Post.reach.by.people.who.like.your.Pageismissing = fbook[rowSums(is.na(fbook))!=0,]
print(ismissing)## Page.total.likes Type Category Post.Month Post.Weekday Post.Hour Paid
## 111 136736 Photo 1 10 6 8 0
## 120 136393 Photo 1 10 7 9 0
## 124 136393 Photo 1 10 7 6 0
## 164 135428 Photo 1 9 5 10 0
## 490 81370 Photo 2 1 4 4 NA
## Lifetime.Post.Total.Reach Lifetime.Post.Total.Impressions
## 111 1261 2158
## 120 584 1029
## 124 677 1285
## 164 1060 2004
## 490 4188 7292
## Lifetime.Engaged.Users Lifetime.Post.Consumers Lifetime.Post.Consumptions
## 111 37 37 49
## 120 273 271 308
## 124 251 246 297
## 164 266 251 337
## 490 564 524 743
## Lifetime.Post.Impressions.by.people.who.have.liked.your.Page
## 111 1911
## 120 943
## 124 1210
## 164 1705
## 490 3861
## Lifetime.Post.reach.by.people.who.like.your.Page
## 111 1077
## 120 511
## 124 615
## 164 870
## 490 2200
## Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post comment
## 111 33 0
## 120 232 0
## 124 211 0
## 164 204 0
## 490 316 0
## like share Total.Interactions weekday timeofday categorylabel month
## 111 NA NA 0 Weekend Morning Action Q4
## 120 2 NA 2 Weekend Morning Action Q4
## 124 7 NA 7 Weekend Late Night Action Q4
## 164 18 NA 18 Weekday Morning Action Q3
## 490 91 28 119 Weekday Late Night Product Q1str(fbook)## 'data.frame': 490 obs. of 23 variables:
## $ Page.total.likes : int 139441 139441 139441 139441 139441 139441 139441 139441 139441 139441 ...
## $ Type : chr "Photo" "Status" "Photo" "Photo" ...
## $ Category : int 2 2 3 2 2 2 3 3 2 3 ...
## $ Post.Month : int 12 12 12 12 12 12 12 12 12 12 ...
## $ Post.Weekday : int 4 3 3 2 2 1 1 7 7 6 ...
## $ Post.Hour : int 3 10 3 10 3 9 3 9 3 10 ...
## $ Paid : int 0 0 0 1 0 0 1 1 0 0 ...
## $ Lifetime.Post.Total.Reach : int 2752 10460 2413 50128 7244 10472 11692 13720 11844 4694 ...
## $ Lifetime.Post.Total.Impressions : int 5091 19057 4373 87991 13594 20849 19479 24137 22538 8668 ...
## $ Lifetime.Engaged.Users : int 178 1457 177 2211 671 1191 481 537 1530 280 ...
## $ Lifetime.Post.Consumers : int 109 1361 113 790 410 1073 265 232 1407 183 ...
## $ Lifetime.Post.Consumptions : int 159 1674 154 1119 580 1389 364 305 1692 250 ...
## $ Lifetime.Post.Impressions.by.people.who.have.liked.your.Page : int 3078 11710 2812 61027 6228 16034 15432 19728 15220 4309 ...
## $ Lifetime.Post.reach.by.people.who.like.your.Page : int 1640 6112 1503 32048 3200 7852 9328 11056 7912 2324 ...
## $ Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post: int 119 1108 132 1386 396 1016 379 422 1250 199 ...
## $ comment : int 4 5 0 58 19 1 3 0 0 3 ...
## $ like : int 79 130 66 1572 325 152 249 325 161 113 ...
## $ share : int 17 29 14 147 49 33 27 14 31 26 ...
## $ Total.Interactions : int 100 164 80 1777 393 186 279 339 192 142 ...
## $ weekday : chr "Weekday" "Weekday" "Weekday" "Weekday" ...
## $ timeofday : chr "Late Night" "Morning" "Late Night" "Morning" ...
## $ categorylabel : chr "Product" "Product" "Inspiration" "Product" ...
## $ month : chr "Q4" "Q4" "Q4" "Q4" ...ismissing = fbook[rowSums(is.na(fbook))!=0,]
print(ismissing)## Page.total.likes Type Category Post.Month Post.Weekday Post.Hour Paid
## 111 136736 Photo 1 10 6 8 0
## 120 136393 Photo 1 10 7 9 0
## 124 136393 Photo 1 10 7 6 0
## 164 135428 Photo 1 9 5 10 0
## 490 81370 Photo 2 1 4 4 NA
## Lifetime.Post.Total.Reach Lifetime.Post.Total.Impressions
## 111 1261 2158
## 120 584 1029
## 124 677 1285
## 164 1060 2004
## 490 4188 7292
## Lifetime.Engaged.Users Lifetime.Post.Consumers Lifetime.Post.Consumptions
## 111 37 37 49
## 120 273 271 308
## 124 251 246 297
## 164 266 251 337
## 490 564 524 743
## Lifetime.Post.Impressions.by.people.who.have.liked.your.Page
## 111 1911
## 120 943
## 124 1210
## 164 1705
## 490 3861
## Lifetime.Post.reach.by.people.who.like.your.Page
## 111 1077
## 120 511
## 124 615
## 164 870
## 490 2200
## Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post comment
## 111 33 0
## 120 232 0
## 124 211 0
## 164 204 0
## 490 316 0
## like share Total.Interactions weekday timeofday categorylabel month
## 111 NA NA 0 Weekend Morning Action Q4
## 120 2 NA 2 Weekend Morning Action Q4
## 124 7 NA 7 Weekend Late Night Action Q4
## 164 18 NA 18 Weekday Morning Action Q3
## 490 91 28 119 Weekday Late Night Product Q1sum(fbook$T == 0)## [1] 0which.valid = (fbook$Total.Interactions != 0)
fbook=fbook[which.valid, ]
sapply(fbook, function(x) sum(is.na(x)))## Page.total.likes
## 0
## Type
## 0
## Category
## 0
## Post.Month
## 0
## Post.Weekday
## 0
## Post.Hour
## 0
## Paid
## 1
## Lifetime.Post.Total.Reach
## 0
## Lifetime.Post.Total.Impressions
## 0
## Lifetime.Engaged.Users
## 0
## Lifetime.Post.Consumers
## 0
## Lifetime.Post.Consumptions
## 0
## Lifetime.Post.Impressions.by.people.who.have.liked.your.Page
## 0
## Lifetime.Post.reach.by.people.who.like.your.Page
## 0
## Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post
## 0
## comment
## 0
## like
## 0
## share
## 3
## Total.Interactions
## 0
## weekday
## 0
## timeofday
## 0
## categorylabel
## 0
## month
## 0na.obs=is.na(fbook)
sum(na.obs)## [1] 4fbook2=fbook[-na.obs,]###Lifetime post total reach vs Page total likes
plot(log(fbook$Page.total.likes), log(fbook$Total.Interactions))
Total Interactions by Weekday
median.weekday = median(fbook$Total.Interactions[fbook$weekday == "Weekday"])
median.weekend = median(fbook$Total.Interactions[fbook$weekday == "Weekend"])
### bar plot by days
median.vec = c(median.weekday,median.weekend)
bplot = barplot(median.vec, names.arg = c("weekend","weekday"), ylim = c(0, max(median.vec)+50), ylab = "Total Interactions", xlab = "Weekday vs Weekend",col=coul)
text(x = bplot, y = median.vec, label = round(median.vec), pos = 3)
median.product = median(fbook$Lifetime.Post.Total.Reach[fbook$categorylabel == "Product"])
median.inspiration = median(fbook$Lifetime.Post.Total.Reach[fbook$categorylabel == "Inspiration"])
median.action = median(fbook$Lifetime.Post.Total.Reach[fbook$categorylabel == "Action"])
### bar plot by days
median.vec = c(median.product,median.inspiration, median.action)
bplot = barplot(median.vec, names.arg = c("product","inspiration","action"), ylim = c(0, max(median.vec)+2000), ylab = "Lifetime Post Total Reach", xlab = "Catego",col=coul)
text(x = bplot, y = median.vec, label = round(median.vec), pos = 3)
Lifetime Post Total Reach by Weekday
median.lptr_weekday = median(fbook$Lifetime.Post.Total.Reach[fbook$weekday == "Weekday"])
median.lptr_weekend = median(fbook$Lifetime.Post.Total.Reach[fbook$weekday == "Weekend"])
### bar plot by days
median.lptr = c(median.lptr_weekday,median.lptr_weekend)
bplot_lptr = barplot(median.lptr, names.arg = c("weekend","weekday"), ylim = c(0, max(median.lptr)+500), ylab = "Lifetime Post Total Reach", xlab = "Weekday vs Weekend",col=coul)
text(x = bplot, y = median.lptr, label = round(median.lptr), pos = 3)
median.lptr_photo = median(fbook$Total.Interactions[fbook$Type == "Photo"])
median.lptr_photo## [1] 122median.lptr_status = median(fbook$Total.Interactions[fbook$Type == "Status"])
median.lptr_status## [1] 186median.lptr_link = median(fbook$Total.Interactions[fbook$Type == "Link"])
median.lptr_Video = median(fbook$Total.Interactions[fbook$Type == "Video"])
### bar plot by days
median_lptr_type = c(median.lptr_photo,median.lptr_status,median.lptr_link,median.lptr_Video)
bplot_lptr_type = barplot(median_lptr_type, names.arg = c("Photo","Status","Link","Video"), ylim = c(0, max(median_lptr_type)+100), ylab = "Total Interactions", xlab = "Type",col=coul)
text(x = bplot_lptr_type, y = median_lptr_type, label = round(median_lptr_type), pos = 3)
median.lptr_photo = mean(fbook$Total.Interactions[fbook$Type == "Photo"])
median.lptr_photo## [1] 200.1942median.lptr_status = mean(fbook$Total.Interactions[fbook$Type == "Status"])
median.lptr_status## [1] 217.0444median.lptr_link = mean(fbook$Total.Interactions[fbook$Type == "Link"])
median.lptr_Video = mean(fbook$Total.Interactions[fbook$Type == "Video"])
### bar plot by days
median_lptr_type = c(median.lptr_photo,median.lptr_status,median.lptr_link,median.lptr_Video)
bplot_lptr_type = barplot(median_lptr_type, names.arg = c("Photo","Status","Link","Video"), ylim = c(0, max(median_lptr_type)+100), ylab = "Total Interactions", xlab = "Type",col=coul)
text(x = bplot_lptr_type, y = median_lptr_type, label = round(median_lptr_type), pos = 3)
median.lptr_photo = median(fbook$Lifetime.Post.Total.Reach[fbook$Type == "Photo"])
median.lptr_status = median(fbook$Lifetime.Post.Total.Reach[fbook$Type == "Status"])
median.lptr_link = median(fbook$Lifetime.Post.Total.Reach[fbook$Type == "Link"])
median.lptr_Video = median(fbook$Lifetime.Post.Total.Reach[fbook$Type == "Video"])
### bar plot by days
median_lptr_type = c(median.lptr_photo,median.lptr_status,median.lptr_link,median.lptr_Video)
bplot_lptr_type = barplot(median_lptr_type, names.arg = c("Photo","Status","Link","Video"), ylim = c(0, max(median_lptr_type)+2500), ylab = "Lifetime Post Total Reach", xlab = "Type",col=coul)
text(x = bplot_lptr_type, y = median_lptr_type, label = round(median_lptr_type), pos = 3)
median_lpwhlypaewyp_Q1 = median(fbook$Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post[fbook$month == "Q1"])
median_lpwhlypaewyp_Q2 = median(fbook$Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post[fbook$month == "Q2"])
median_lpwhlypaewyp_Q3 = median(fbook$Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post[fbook$month == "Q3"])
median_lpwhlypaewyp_Q4 = median(fbook$Lifetime.People.who.have.liked.your.Page.and.engaged.with.your.post[fbook$month == "Q4"])
### bar plot by days
median_lpwhlypaewyp_month = c(median_lpwhlypaewyp_Q1,median_lpwhlypaewyp_Q2,median_lpwhlypaewyp_Q3,median_lpwhlypaewyp_Q4)
bplot_lptr = barplot(median_lpwhlypaewyp_month, names.arg = c("Q1","Q2","Q3","Q4"), ylim = c(0, max(median_lpwhlypaewyp_month)+500), ylab = "Lifetime People who have liked your Page and engaged with your post", xlab = "Month", col=coul)
text(x = bplot_lptr, y = median_lpwhlypaewyp_month, label = round(median_lpwhlypaewyp_month),pos=3)
median_lptr_Q1 = median(fbook$Lifetime.Post.Total.Reach[fbook$month == "Q1"])
median_lptr_Q2 = median(fbook$Lifetime.Post.Total.Reach[fbook$month == "Q2"])
median_lptr_Q3 = median(fbook$Lifetime.Post.Total.Reach[fbook$month == "Q3"])
median_lptr_Q4 = median(fbook$Lifetime.Post.Total.Reach[fbook$month == "Q4"])
### bar plot by days
median_lptr_month = c(median_lptr_Q1,median_lptr_Q2,median_lptr_Q3,median_lptr_Q4)
bplot_lptr = barplot(median_lptr_month, names.arg = c("Q1","Q2","Q3","Q4"), ylim = c(0, max(median_lptr_month)+500), ylab = "Lifetime Post Total Reach", xlab="Quarter", col=coul)
text(x = bplot_lptr, y = median_lptr_month, label = round(median_lptr_month),pos=3)
Total Interactions By Quarter
median_ti_Q1 = median(fbook$Total.Interactions[fbook$month == "Q1"])
median_ti_Q2 = median(fbook$Total.Interactions[fbook$month == "Q2"])
median_ti_Q3 = median(fbook$Total.Interactions[fbook$month == "Q3"])
median_ti_Q4 = median(fbook$Total.Interactions[fbook$month == "Q4"])
### bar plot by days
median_ti_month = c(median_ti_Q1,median_ti_Q2,median_ti_Q3,median_ti_Q4)
bplot_ti_month = barplot(median_ti_month, names.arg = c("Q1","Q2","Q3","Q4"), ylim = c(0, max(median_ti_month)+100), ylab = "Total Interactions", xlab = "Month",col = coul)
text(x = bplot_ti_month, y = median_ti_month, label = round(median_ti_month), pos = 3,adj=1)
?barplot## starting httpd help server ... donemedian_lptr_morning = median(fbook$Lifetime.Post.Total.Reach[fbook$timeofday == "Morning"])
median_lptr_afternoon = median(fbook$Lifetime.Post.Total.Reach[fbook$timeofday == "Afternoon"])
median_lptr_evening = median(fbook$Lifetime.Post.Total.Reach[fbook$timeofday == "Evening"])
median_lptr_latenight = median(fbook$Lifetime.Post.Total.Reach[fbook$timeofday == "Late Night"])
### bar plot by days
median_lptr_timeofday = c(median_lptr_morning,median_lptr_afternoon,median_lptr_evening,median_lptr_latenight)
bplot_lptr_timeofday = barplot(median_lptr_timeofday, names.arg = c("Morning","Afternoon","Evening","Late Night"), ylim = c(0, max(median_lptr_timeofday)+500), ylab = "Total Interactions", xlab = "Time of Day", col=coul)
text(x = bplot_lptr_timeofday, y = median_lptr_timeofday, label = round(median_lptr_timeofday), pos = 3)
?textlinear regression output variable: lifetime post total reach
hist(log(fbook$Total.Interactions),col="Palegreen1", main = "Histogram of log Total Interactions", xlab = "log(Total Interactions)")
hist(log(fbook$Lifetime.Post.Total.Reach),col="Steelblue1",main = "Histogram of log Lifetime Post Total Reach", xlab = "log(Lifetime Post Total Reach)")
sum(fbook$T == 0)## [1] 0which.valid = (fbook$Total.Interactions != 0)
lm.fbook=lm(log(fbook$Total.Interactions) ~ Page.total.likes + Type + as.factor(categorylabel) + as.factor(month) + as.factor(weekday) + as.factor(timeofday) + as.factor(Paid), data=fbook[which.valid, ])
summary(lm.fbook)##
## Call:
## lm(formula = log(fbook$Total.Interactions) ~ Page.total.likes +
## Type + as.factor(categorylabel) + as.factor(month) + as.factor(weekday) +
## as.factor(timeofday) + as.factor(Paid), data = fbook[which.valid,
## ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3472 -0.5602 -0.0057 0.5647 3.0695
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.043e+00 9.828e-01 5.132 4.21e-07 ***
## Page.total.likes -1.355e-05 1.027e-05 -1.319 0.187931
## TypePhoto 4.828e-01 2.305e-01 2.095 0.036712 *
## TypeStatus 6.331e-01 2.866e-01 2.209 0.027671 *
## TypeVideo 1.243e+00 5.057e-01 2.457 0.014361 *
## as.factor(categorylabel)Inspiration 7.430e-01 1.155e-01 6.433 3.10e-10 ***
## as.factor(categorylabel)Product 5.727e-01 1.315e-01 4.355 1.63e-05 ***
## as.factor(month)Q2 4.865e-01 2.888e-01 1.684 0.092782 .
## as.factor(month)Q3 7.921e-01 4.260e-01 1.859 0.063637 .
## as.factor(month)Q4 6.848e-01 4.765e-01 1.437 0.151413
## as.factor(weekday)Weekend -3.575e-01 9.330e-02 -3.832 0.000144 ***
## as.factor(timeofday)Evening -4.911e-01 3.976e-01 -1.235 0.217406
## as.factor(timeofday)Late Night 1.871e-01 1.301e-01 1.438 0.151121
## as.factor(timeofday)Morning 3.454e-02 1.360e-01 0.254 0.799626
## as.factor(Paid)1 2.153e-01 1.049e-01 2.052 0.040677 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.004 on 468 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2019, Adjusted R-squared: 0.1781
## F-statistic: 8.458 on 14 and 468 DF, p-value: 2.24e-16lm.fbook=lm(log(fbook$Total.Interactions) ~ Page.total.likes + Type + as.factor(categorylabel) + as.factor(month) + as.factor(weekday) + as.factor(timeofday) + as.factor(Paid), data=fbook[which.valid, ],)
summary(lm.fbook)##
## Call:
## lm(formula = log(fbook$Total.Interactions) ~ Page.total.likes +
## Type + as.factor(categorylabel) + as.factor(month) + as.factor(weekday) +
## as.factor(timeofday) + as.factor(Paid), data = fbook[which.valid,
## ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3472 -0.5602 -0.0057 0.5647 3.0695
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.043e+00 9.828e-01 5.132 4.21e-07 ***
## Page.total.likes -1.355e-05 1.027e-05 -1.319 0.187931
## TypePhoto 4.828e-01 2.305e-01 2.095 0.036712 *
## TypeStatus 6.331e-01 2.866e-01 2.209 0.027671 *
## TypeVideo 1.243e+00 5.057e-01 2.457 0.014361 *
## as.factor(categorylabel)Inspiration 7.430e-01 1.155e-01 6.433 3.10e-10 ***
## as.factor(categorylabel)Product 5.727e-01 1.315e-01 4.355 1.63e-05 ***
## as.factor(month)Q2 4.865e-01 2.888e-01 1.684 0.092782 .
## as.factor(month)Q3 7.921e-01 4.260e-01 1.859 0.063637 .
## as.factor(month)Q4 6.848e-01 4.765e-01 1.437 0.151413
## as.factor(weekday)Weekend -3.575e-01 9.330e-02 -3.832 0.000144 ***
## as.factor(timeofday)Evening -4.911e-01 3.976e-01 -1.235 0.217406
## as.factor(timeofday)Late Night 1.871e-01 1.301e-01 1.438 0.151121
## as.factor(timeofday)Morning 3.454e-02 1.360e-01 0.254 0.799626
## as.factor(Paid)1 2.153e-01 1.049e-01 2.052 0.040677 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.004 on 468 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2019, Adjusted R-squared: 0.1781
## F-statistic: 8.458 on 14 and 468 DF, p-value: 2.24e-16outliers
inf2 <- 4/(nrow(fbook)) # to find influential points
out <- which(cooks.distance(lm.fbook)>inf2)
out## 4 18 42 56 115 120 128 129 168 183 206 213 232 235 275 284 320 376 386 398
## 4 18 41 55 111 116 124 125 164 179 202 209 228 231 271 280 316 372 382 394
## 417 418 421 423 424 425 426 427 453 467 472 476
## 412 413 416 418 419 420 421 422 447 461 466 470lm.fbook2 <- lm(log(Total.Interactions) ~ Type + categorylabel + month + weekday + timeofday + Paid + Page.total.likes, data=fbook[-out,])
inf2 <- 4/(nrow(fbook)) # to find influential points
out <- which(cooks.distance(lm.fbook2)>inf2)
summary(lm.fbook2)##
## Call:
## lm(formula = log(Total.Interactions) ~ Type + categorylabel +
## month + weekday + timeofday + Paid + Page.total.likes, data = fbook[-out,
## ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.7091 -0.5485 -0.0077 0.4954 2.4542
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.730e+00 8.561e-01 5.525 5.67e-08 ***
## TypePhoto 4.228e-01 2.138e-01 1.978 0.048606 *
## TypeStatus 7.086e-01 2.569e-01 2.758 0.006055 **
## TypeVideo 1.139e+00 5.296e-01 2.150 0.032086 *
## categorylabelInspiration 6.725e-01 9.833e-02 6.839 2.70e-11 ***
## categorylabelProduct 4.763e-01 1.116e-01 4.269 2.41e-05 ***
## monthQ2 7.273e-02 2.543e-01 0.286 0.774984
## monthQ3 4.043e-01 3.716e-01 1.088 0.277275
## monthQ4 2.563e-01 4.162e-01 0.616 0.538316
## weekdayWeekend -2.909e-01 8.025e-02 -3.625 0.000323 ***
## timeofdayEvening -5.263e-01 6.005e-01 -0.876 0.381252
## timeofdayLate Night 4.886e-02 1.132e-01 0.432 0.666116
## timeofdayMorning -1.499e-01 1.186e-01 -1.263 0.207180
## Paid 2.218e-01 9.103e-02 2.437 0.015214 *
## Page.total.likes -6.402e-06 8.901e-06 -0.719 0.472383
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8341 on 436 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2059, Adjusted R-squared: 0.1804
## F-statistic: 8.074 on 14 and 436 DF, p-value: 2.09e-15print(inf2)## [1] 0.008264463#get_regression_table(lm.fbook2, print = TRUE)Type Photo has a 38% decrease in Lifetime Post Total Reach compared to Type Link. Type Photo has a negative relationship with Lifetime Post Total Reach
exp(-.4638)## [1] 0.6288893par(mfrow=c(2,2))
plot(lm.fbook2, which=c(1:4))
stepwise <- ols_step_both_p(lm.fbook2, pent = 0.05, prem = 0.05, details = FALSE)
stepwise##
## Stepwise Selection Summary
## --------------------------------------------------------------------------------------------
## Added/ Adj.
## Step Variable Removed R-Square R-Square C(p) AIC RMSE
## --------------------------------------------------------------------------------------------
## 1 categorylabel addition 0.119 0.115 244.4150 1350.1487 1.0311
## 2 weekday addition 0.148 0.143 222.8980 1336.3937 1.0148
## 3 Paid addition 0.161 0.153 216.1500 1329.8578 1.0097
## --------------------------------------------------------------------------------------------Final Model
Removing variables based on stepwise selection
inf2 <- 4/(nrow(fbook)) # to find influential points
out <- which(cooks.distance(lm.fbook)>inf2)
lm.fbook3 <- lm(log(Total.Interactions) ~ Type + categorylabel + weekday + Paid, data=fbook[-out,])
summary(lm.fbook3)##
## Call:
## lm(formula = log(Total.Interactions) ~ Type + categorylabel +
## weekday + Paid, data = fbook[-out, ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.82028 -0.49711 -0.01994 0.48626 2.54407
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.08294 0.20755 19.672 < 2e-16 ***
## TypePhoto 0.40825 0.21144 1.931 0.054145 .
## TypeStatus 0.66387 0.25451 2.608 0.009404 **
## TypeVideo 1.05258 0.52663 1.999 0.046253 *
## categorylabelInspiration 0.69942 0.09491 7.369 8.49e-13 ***
## categorylabelProduct 0.54829 0.10732 5.109 4.83e-07 ***
## weekdayWeekend -0.28463 0.08016 -3.551 0.000425 ***
## Paid 0.25120 0.09036 2.780 0.005669 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8374 on 443 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.1867, Adjusted R-squared: 0.1739
## F-statistic: 14.53 on 7 and 443 DF, p-value: < 2.2e-16par(mfrow=c(2,2))
plot(lm.fbook3, which=c(1:4))
exp(0.40376)## [1] 1.497445exp(0.46364)## [1] 1.589851exp(1.24574)## [1] 3.475506exp(0.86421)## [1] 2.373131exp(0.71571)## [1] 2.045639exp(-0.34866)## [1] 0.705633exp(0.23838)## [1] 1.269191inf2 <- 4/(nrow(fbook)) # to find influential points
out <- which(cooks.distance(lm.fbook)>inf2)
lm.fbook4 <- lm(log(Total.Interactions) ~ Type*categorylabel*Paid*weekday, data=fbook[-out,])
summary(lm.fbook4)##
## Call:
## lm(formula = log(Total.Interactions) ~ Type * categorylabel *
## Paid * weekday, data = fbook[-out, ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.66368 -0.50280 -0.01959 0.49162 2.50155
##
## Coefficients: (21 not defined because of singularities)
## Estimate Std. Error
## (Intercept) 4.31046 0.31842
## TypePhoto 0.22327 0.33880
## TypeStatus 0.13571 0.67548
## TypeVideo 0.42574 0.90063
## categorylabelInspiration 0.25735 0.96949
## categorylabelProduct -0.35390 0.97783
## Paid -0.27156 0.58136
## weekdayWeekend -0.43782 0.52804
## TypePhoto:categorylabelInspiration 0.41435 0.95558
## TypeStatus:categorylabelInspiration 0.36369 1.21335
## TypeVideo:categorylabelInspiration NA NA
## TypePhoto:categorylabelProduct 0.80809 0.96154
## TypeStatus:categorylabelProduct 1.02719 1.17284
## TypeVideo:categorylabelProduct NA NA
## TypePhoto:Paid 0.60101 0.61064
## TypeStatus:Paid 1.36666 1.18431
## TypeVideo:Paid 1.12175 1.18431
## categorylabelInspiration:Paid -0.21197 0.28382
## categorylabelProduct:Paid -0.59511 1.12743
## TypePhoto:weekdayWeekend -0.04592 0.55159
## TypeStatus:weekdayWeekend 0.03269 0.67385
## TypeVideo:weekdayWeekend NA NA
## categorylabelInspiration:weekdayWeekend 0.31267 0.22963
## categorylabelProduct:weekdayWeekend 0.37309 0.26262
## Paid:weekdayWeekend -0.04572 1.10687
## TypePhoto:categorylabelInspiration:Paid NA NA
## TypeStatus:categorylabelInspiration:Paid NA NA
## TypeVideo:categorylabelInspiration:Paid NA NA
## TypePhoto:categorylabelProduct:Paid 0.57134 1.17422
## TypeStatus:categorylabelProduct:Paid NA NA
## TypeVideo:categorylabelProduct:Paid NA NA
## TypePhoto:categorylabelInspiration:weekdayWeekend NA NA
## TypeStatus:categorylabelInspiration:weekdayWeekend NA NA
## TypeVideo:categorylabelInspiration:weekdayWeekend NA NA
## TypePhoto:categorylabelProduct:weekdayWeekend NA NA
## TypeStatus:categorylabelProduct:weekdayWeekend NA NA
## TypeVideo:categorylabelProduct:weekdayWeekend NA NA
## TypePhoto:Paid:weekdayWeekend 0.32005 1.15182
## TypeStatus:Paid:weekdayWeekend 1.14969 1.41811
## TypeVideo:Paid:weekdayWeekend NA NA
## categorylabelInspiration:Paid:weekdayWeekend -0.45388 0.45038
## categorylabelProduct:Paid:weekdayWeekend -0.81863 0.54869
## TypePhoto:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypeStatus:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypeVideo:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypePhoto:categorylabelProduct:Paid:weekdayWeekend NA NA
## TypeStatus:categorylabelProduct:Paid:weekdayWeekend NA NA
## TypeVideo:categorylabelProduct:Paid:weekdayWeekend NA NA
## t value Pr(>|t|)
## (Intercept) 13.537 <2e-16 ***
## TypePhoto 0.659 0.510
## TypeStatus 0.201 0.841
## TypeVideo 0.473 0.637
## categorylabelInspiration 0.265 0.791
## categorylabelProduct -0.362 0.718
## Paid -0.467 0.641
## weekdayWeekend -0.829 0.407
## TypePhoto:categorylabelInspiration 0.434 0.665
## TypeStatus:categorylabelInspiration 0.300 0.765
## TypeVideo:categorylabelInspiration NA NA
## TypePhoto:categorylabelProduct 0.840 0.401
## TypeStatus:categorylabelProduct 0.876 0.382
## TypeVideo:categorylabelProduct NA NA
## TypePhoto:Paid 0.984 0.326
## TypeStatus:Paid 1.154 0.249
## TypeVideo:Paid 0.947 0.344
## categorylabelInspiration:Paid -0.747 0.456
## categorylabelProduct:Paid -0.528 0.598
## TypePhoto:weekdayWeekend -0.083 0.934
## TypeStatus:weekdayWeekend 0.049 0.961
## TypeVideo:weekdayWeekend NA NA
## categorylabelInspiration:weekdayWeekend 1.362 0.174
## categorylabelProduct:weekdayWeekend 1.421 0.156
## Paid:weekdayWeekend -0.041 0.967
## TypePhoto:categorylabelInspiration:Paid NA NA
## TypeStatus:categorylabelInspiration:Paid NA NA
## TypeVideo:categorylabelInspiration:Paid NA NA
## TypePhoto:categorylabelProduct:Paid 0.487 0.627
## TypeStatus:categorylabelProduct:Paid NA NA
## TypeVideo:categorylabelProduct:Paid NA NA
## TypePhoto:categorylabelInspiration:weekdayWeekend NA NA
## TypeStatus:categorylabelInspiration:weekdayWeekend NA NA
## TypeVideo:categorylabelInspiration:weekdayWeekend NA NA
## TypePhoto:categorylabelProduct:weekdayWeekend NA NA
## TypeStatus:categorylabelProduct:weekdayWeekend NA NA
## TypeVideo:categorylabelProduct:weekdayWeekend NA NA
## TypePhoto:Paid:weekdayWeekend 0.278 0.781
## TypeStatus:Paid:weekdayWeekend 0.811 0.418
## TypeVideo:Paid:weekdayWeekend NA NA
## categorylabelInspiration:Paid:weekdayWeekend -1.008 0.314
## categorylabelProduct:Paid:weekdayWeekend -1.492 0.136
## TypePhoto:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypeStatus:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypeVideo:categorylabelInspiration:Paid:weekdayWeekend NA NA
## TypePhoto:categorylabelProduct:Paid:weekdayWeekend NA NA
## TypeStatus:categorylabelProduct:Paid:weekdayWeekend NA NA
## TypeVideo:categorylabelProduct:Paid:weekdayWeekend NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8425 on 424 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2122, Adjusted R-squared: 0.1639
## F-statistic: 4.392 on 26 and 424 DF, p-value: 2.86e-11