Latihan Pengantar Sains Data
Dewi Kunthi Siswati Suryo
2023-10-06
library(olsrr)## Warning: package 'olsrr' was built under R version 4.3.1##
## Attaching package: 'olsrr'## The following object is masked from 'package:datasets':
##
## riverslibrary(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:olsrr':
##
## cementlibrary(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(car)## Loading required package: carDatalibrary(glmnet)## Warning: package 'glmnet' was built under R version 4.3.1## Loading required package: Matrix## Loaded glmnet 4.1-8library(ggplot2)Input Data
data <- read.csv("C:/Users/Asus/Downloads/Marketing_Data (1).csv")
data## youtube facebook newspaper sales
## 1 84.72 19.20 48.96 12.60
## 2 351.48 33.96 51.84 25.68
## 3 135.48 20.88 46.32 14.28
## 4 116.64 1.80 36.00 11.52
## 5 318.72 24.00 0.36 20.88
## 6 114.84 1.68 8.88 11.40
## 7 348.84 4.92 10.20 15.36
## 8 320.28 52.56 6.00 30.48
## 9 89.64 59.28 54.84 17.64
## 10 51.72 32.04 42.12 12.12
## 11 273.60 45.24 38.40 25.80
## 12 243.00 26.76 37.92 19.92
## 13 212.40 40.08 46.44 20.52
## 14 352.32 33.24 2.16 24.84
## 15 248.28 10.08 31.68 15.48
## 16 30.12 30.84 51.96 10.20
## 17 210.12 27.00 37.80 17.88
## 18 107.64 11.88 42.84 12.72
## 19 287.88 49.80 22.20 27.84
## 20 272.64 18.96 59.88 17.76
## 21 80.28 14.04 44.16 11.64
## 22 239.76 3.72 41.52 13.68
## 23 120.48 11.52 4.32 12.84
## 24 259.68 50.04 47.52 27.12
## 25 219.12 55.44 70.44 25.44
## 26 315.24 34.56 19.08 24.24
## 27 238.68 59.28 72.00 28.44
## 28 8.76 33.72 49.68 6.60
## 29 163.44 23.04 19.92 15.84
## 30 252.96 59.52 45.24 28.56
## 31 252.84 35.40 11.16 22.08
## 32 64.20 2.40 25.68 9.72
## 33 313.56 51.24 65.64 29.04
## 34 287.16 18.60 32.76 18.84
## 35 123.24 35.52 10.08 16.80
## 36 157.32 51.36 34.68 21.60
## 37 82.80 11.16 1.08 11.16
## 38 37.80 29.52 2.64 11.40
## 39 167.16 17.40 12.24 16.08
## 40 284.88 33.00 13.20 22.68
## 41 260.16 52.68 32.64 26.76
## 42 238.92 36.72 46.44 21.96
## 43 131.76 17.16 38.04 14.88
## 44 32.16 39.60 23.16 10.56
## 45 155.28 6.84 37.56 13.20
## 46 256.08 29.52 15.72 20.40
## 47 20.28 52.44 107.28 10.44
## 48 33.00 1.92 24.84 8.28
## 49 144.60 34.20 17.04 17.04
## 50 6.48 35.88 11.28 6.36
## 51 139.20 9.24 27.72 13.20
## 52 91.68 32.04 26.76 14.16
## 53 287.76 4.92 44.28 14.76
## 54 90.36 24.36 39.00 13.56
## 55 82.08 53.40 42.72 16.32
## 56 256.20 51.60 40.56 26.04
## 57 231.84 22.08 78.84 18.24
## 58 91.56 33.00 19.20 14.40
## 59 132.84 48.72 75.84 19.20
## 60 105.96 30.60 88.08 15.48
## 61 131.76 57.36 61.68 20.04
## 62 161.16 5.88 11.16 13.44
## 63 34.32 1.80 39.60 8.76
## 64 261.24 40.20 70.80 23.28
## 65 301.08 43.80 86.76 26.64
## 66 128.88 16.80 13.08 13.80
## 67 195.96 37.92 63.48 20.28
## 68 237.12 4.20 7.08 14.04
## 69 221.88 25.20 26.40 18.60
## 70 347.64 50.76 61.44 30.48
## 71 162.24 50.04 55.08 20.64
## 72 266.88 5.16 59.76 14.04
## 73 355.68 43.56 121.08 28.56
## 74 336.24 12.12 25.68 17.76
## 75 225.48 20.64 21.48 17.64
## 76 285.84 41.16 6.36 24.84
## 77 165.48 55.68 70.80 23.04
## 78 30.00 13.20 35.64 8.64
## 79 108.48 0.36 27.84 10.44
## 80 15.72 0.48 30.72 6.36
## 81 306.48 32.28 6.60 23.76
## 82 270.96 9.84 67.80 16.08
## 83 290.04 45.60 27.84 26.16
## 84 210.84 18.48 2.88 16.92
## 85 251.52 24.72 12.84 19.08
## 86 93.84 56.16 41.40 17.52
## 87 90.12 42.00 63.24 15.12
## 88 167.04 17.16 30.72 14.64
## 89 91.68 0.96 17.76 11.28
## 90 150.84 44.28 95.04 19.08
## 91 23.28 19.20 26.76 7.92
## 92 169.56 32.16 55.44 18.60
## 93 22.56 26.04 60.48 8.40
## 94 268.80 2.88 18.72 13.92
## 95 147.72 41.52 14.88 18.24
## 96 275.40 38.76 89.04 23.64
## 97 104.64 14.16 31.08 12.72
## 98 9.36 46.68 60.72 7.92
## 99 96.24 0.00 11.04 10.56
## 100 264.36 58.80 3.84 29.64
## 101 71.52 14.40 51.72 11.64
## 102 0.84 47.52 10.44 1.92
## 103 318.24 3.48 51.60 15.24
## 104 10.08 32.64 2.52 6.84
## 105 263.76 40.20 54.12 23.52
## 106 44.28 46.32 78.72 12.96
## 107 57.96 56.40 10.20 13.92
## 108 30.72 46.80 11.16 11.40
## 109 328.44 34.68 71.64 24.96
## 110 51.60 31.08 24.60 11.52
## 111 221.88 52.68 2.04 24.84
## 112 88.08 20.40 15.48 13.08
## 113 232.44 42.48 90.72 23.04
## 114 264.60 39.84 45.48 24.12
## 115 125.52 6.84 41.28 12.48
## 116 115.44 17.76 46.68 13.68
## 117 168.36 2.28 10.80 12.36
## 118 288.12 8.76 10.44 15.84
## 119 291.84 58.80 53.16 30.48
## 120 45.60 48.36 14.28 13.08
## 121 53.64 30.96 24.72 12.12
## 122 336.84 16.68 44.40 19.32
## 123 145.20 10.08 58.44 13.92
## 124 237.12 27.96 17.04 19.92
## 125 205.56 47.64 45.24 22.80
## 126 225.36 25.32 11.40 18.72
## 127 4.92 13.92 6.84 3.84
## 128 112.68 52.20 60.60 18.36
## 129 179.76 1.56 29.16 12.12
## 130 14.04 44.28 54.24 8.76
## 131 158.04 22.08 41.52 15.48
## 132 207.00 21.72 36.84 17.28
## 133 102.84 42.96 59.16 15.96
## 134 226.08 21.72 30.72 17.88
## 135 196.20 44.16 8.88 21.60
## 136 140.64 17.64 6.48 14.28
## 137 281.40 4.08 101.76 14.28
## 138 21.48 45.12 25.92 9.60
## 139 248.16 6.24 23.28 14.64
## 140 258.48 28.32 69.12 20.52
## 141 341.16 12.72 7.68 18.00
## 142 60.00 13.92 22.08 10.08
## 143 197.40 25.08 56.88 17.40
## 144 23.52 24.12 20.40 9.12
## 145 202.08 8.52 15.36 14.04
## 146 266.88 4.08 15.72 13.80
## 147 332.28 58.68 50.16 32.40
## 148 298.08 36.24 24.36 24.24
## 149 204.24 9.36 42.24 14.04
## 150 332.04 2.76 28.44 14.16
## 151 198.72 12.00 21.12 15.12
## 152 187.92 3.12 9.96 12.60
## 153 262.20 6.48 32.88 14.64
## 154 67.44 6.84 35.64 10.44
## 155 345.12 51.60 86.16 31.44
## 156 304.56 25.56 36.00 21.12
## 157 246.00 54.12 23.52 27.12
## 158 167.40 2.52 31.92 12.36
## 159 229.32 34.44 21.84 20.76
## 160 343.20 16.68 4.44 19.08
## 161 22.44 14.52 28.08 8.04
## 162 47.40 49.32 6.96 12.96
## 163 90.60 12.96 7.20 11.88
## 164 20.64 4.92 37.92 7.08
## 165 200.16 50.40 4.32 23.52
## 166 179.64 42.72 7.20 20.76
## 167 45.84 4.44 16.56 9.12
## 168 113.04 5.88 9.72 11.64
## 169 212.40 11.16 7.68 15.36
## 170 340.32 50.40 79.44 30.60
## 171 278.52 10.32 10.44 16.08#Eksplorasi Plot antara Y dengan X1
#Eksplorasi Plot antara Y dengan X1
plot(data$youtube,data$sales)
#Eksplorasi Plot antara Y dengan X2
plot(data$facebook,data$sales)
#Eksplorasi Plot antara Y dengan X3
plot(data$newspaper, data$sales)
Model Regresi Klasik
modelklasik <- lm(sales~youtube+facebook+newspaper,data=data)
s.modelklasik <- summary(modelklasik)
s.modelklasik##
## Call:
## lm(formula = sales ~ youtube + facebook + newspaper, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.6212 -0.9316 0.2776 1.4111 3.3701
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.505871 0.399647 8.772 1.96e-15 ***
## youtube 0.045235 0.001516 29.830 < 2e-16 ***
## facebook 0.188398 0.009016 20.895 < 2e-16 ***
## newspaper 0.004279 0.006501 0.658 0.511
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.01 on 167 degrees of freedom
## Multiple R-squared: 0.9005, Adjusted R-squared: 0.8987
## F-statistic: 503.7 on 3 and 167 DF, p-value: < 2.2e-16Model regresi klasik yang diperoleh adalah : \[ sales = 3.505871 + 0.045235youtube + 0.188398facebook + 0.004279newspaper \]
R Squared dan RSE Model Klasik
# R squared
R2.modelklasik <- s.modelklasik$r.squared
R2.modelklasik## [1] 0.9004752# RSE
rse.modelklasik <- s.modelklasik$sigma
rse.modelklasik## [1] 2.009917Rsq Model klasik didapatkan \(R^2 = 0.9004752\) dan nilai RSE \(RSE = 2.009917\)
Plot Pencilan dan Leverage
ols_plot_resid_lev(modelklasik)
Amatan Berpengaruh
plot(modelklasik,which=5)
ols_plot_diagnostics(modelklasik)
Uji Asumsi
# 1 Nilai harapan sisaan sama dengan nol
t.test(modelklasik$residuals,
mu = 0,
conf.level = 0.95)##
## One Sample t-test
##
## data: modelklasik$residuals
## t = -4.1604e-16, df = 170, p-value = 1
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## -0.3007217 0.3007217
## sample estimates:
## mean of x
## -6.337954e-17# 2 Sisaan saling bebas
dwtest(modelklasik)##
## Durbin-Watson test
##
## data: modelklasik
## DW = 2.0646, p-value = 0.6656
## alternative hypothesis: true autocorrelation is greater than 0#3 Ragam sisaan homogen
bptest(modelklasik)##
## studentized Breusch-Pagan test
##
## data: modelklasik
## BP = 5.0942, df = 3, p-value = 0.165Asumsi Normalitas Sisaan
shapiro.test(modelklasik$residuals)##
## Shapiro-Wilk normality test
##
## data: modelklasik$residuals
## W = 0.91394, p-value = 1.734e-08Multikolinieritas
vif(modelklasik)## youtube facebook newspaper
## 1.015706 1.097761 1.103072Regresi Ridge
x <- data.matrix(data[,c('youtube','facebook','newspaper')])
y <- data$sales
cv.r<-cv.glmnet(x,y,alpha=0)
best.lr<-cv.r$lambda.min
bestridge<-glmnet(x,y,alpha=0,lambda=best.lr)
coef(bestridge)## 4 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 4.318516808
## youtube 0.042053023
## facebook 0.174795288
## newspaper 0.007976879Didapatkan model regresi Ridge : \[ sales = 4.318516808 + 0.042053023youtube + 0.174795288facebook + 0.007976879newspaper\]
R Squared dan RSE Model Ridge
# Fungsi untuk cari rsquared
rsq<-function(bestmodel,bestlambda,x,y){
# y duga
y.duga <- predict(bestmodel, s = bestlambda, newx = x)
# JKG dan JKT
jkt <- sum((y - mean(y))^2)
jkg <- sum((y.duga- y)^2)
#Mencari R-Squared
rsq <- 1 - jkg/jkt
return(rsq)
}
# R2 ridge
R2.modelridge <- rsq(bestridge,best.lr,x,y)
R2.modelridge## [1] 0.8962598# RSE ridge
train_predictionsr <- predict(bestridge,newx = x)
# Hitung residu (selisih antara prediksi dan nilai sebenarnya)
residualsr <- y - train_predictionsr
# Hitung varian residu
dfr <- length(y) - length(bestridge$beta)
residual_variancer <- sum(residualsr^2) / dfr
# Hitung RSE
rse.modelridge <- sqrt(residual_variancer)
rse.modelridge## [1] 2.045925Didapatkan nilai R2 pada model ridge $ R^2 = 0.8962598$ dan RSE model ridge didapatkan nilai \(RSE =2.045925\)
Regresi Lasso
cv.l<-cv.glmnet(x,y,alpha=1)
best.ll<-cv.l$lambda.min
bestlasso<-glmnet(x,y,alpha=1,lambda=best.ll)
coef(bestlasso)## 4 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 3.709798958
## youtube 0.044758363
## facebook 0.186108913
## newspaper 0.002700051Model Regresi Lasso : \[ sales = 3.646431264 + 0.044906596youtube + 0.186820254facebook + 0.003190833newspaper\]
R Squared dan RSE Model Lasso
# R2 lasso
R2.modellasso <- rsq(bestlasso,best.ll,x,y)
R2.modellasso## [1] 0.9002912# RSE Lasso
train_predictionsLasso <- predict(bestlasso,newx = x)
# Hitung residu (selisih antara prediksi dan nilai sebenarnya)
residualsLasso <- y - train_predictionsLasso
# Hitung varian residu
dfLasso <- length(y) - length(bestlasso$beta)
residual_varianceLasso <- sum(residualsLasso^2) / dfLasso
# Hitung RSE
rse.modelLasso <- sqrt(residual_varianceLasso)
rse.modelLasso## [1] 2.005778Didapatkan nilai \[R^2\] pada Model Lasso \[R^2 = 0.9003878\] dan RSE Model Ridge didapatkan nilai \[RSE = 2.004806 \]
Perbandingan Model Regresi
perbandingan <- matrix(c(R2.modelklasik, R2.modelridge, R2.modellasso, rse.modelklasik, rse.modelridge, rse.modelLasso),ncol=2,byrow = F)
row.names(perbandingan)<- c("Model klasik","model ridge","model lasso")
colnames(perbandingan) <- c("R squared","RSE")
perbandingan## R squared RSE
## Model klasik 0.9004752 2.009917
## model ridge 0.8962598 2.045925
## model lasso 0.9002912 2.005778Perbandingan model dengan melihat nilai RSE yang memiliki ialah model Lasso dengan nilai \[ RSE = 2.004806 \]. Maka dari itu dapat dikatakan bahwa model terbaiknya adalah Model Lasso.
Model Terbaik (Model Lasso)
coef(bestlasso)## 4 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 3.709798958
## youtube 0.044758363
## facebook 0.186108913
## newspaper 0.002700051Model Regresi Lasso : \[ Sales = 3.646431264 + 0.044906596youtube + 0.186820254facebook + 0.003190833newspaper \]
Interpretasi Koefisien Model
Sales akan meningkat apabila youtube, facebook, dan newspaper meningkat juga.