UAS Metstat 2
library(readxl)## Warning: package 'readxl' was built under R version 4.1.2library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.1.2## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.7
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.0.1 v forcats 0.5.1## Warning: package 'tidyr' was built under R version 4.1.2## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(dplyr)
library(rsample)## Warning: package 'rsample' was built under R version 4.1.2library(plotly) # no 3## Warning: package 'plotly' was built under R version 4.1.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(ISwR) # no 1## Warning: package 'ISwR' was built under R version 4.1.3library(broom)
library(DT)SOAL 1 - Gunakan gugus data rmr dari package ISwR untuk melihat hubungan antara Y laju metabolism tubuh (metabolism.rate) dan X berat badan (body.weight)
library(ISwR)
Data <- plot(metabolic.rate~body.weight, data=rmr)
Buatlah diagram pencar yang memperlihatkan hubungan kedua peubah.
cor(rmr)## body.weight metabolic.rate
## body.weight 1.0000000 0.7442379
## metabolic.rate 0.7442379 1.0000000library(ggplot2)
ggplot(rmr, aes(x=body.weight, y=metabolic.rate)) +
geom_point()+
geom_smooth(method=lm,se=F)## `geom_smooth()` using formula 'y ~ x'
library(ggpubr)## Warning: package 'ggpubr' was built under R version 4.1.2ggscatter(rmr, x = "body.weight", y = "metabolic.rate",
add = "reg.line", conf.int = TRUE,
cor.coef = TRUE, cor.method = "pearson",
xlab = "Miles/(US) gallon", ylab = "Weight (1000 lbs)")## `geom_smooth()` using formula 'y ~ x'
Apakah tampak terdapat hubungan linier antara X dan Y berdasarkan a? Hitung korelasi darikedua variabel tersebut.
library(tidyverse)
library(broom)
theme_set(theme_classic())
model <- model <- lm(data=rmr, metabolic.rate~body.weight)
model##
## Call:
## lm(formula = metabolic.rate ~ body.weight, data = rmr)
##
## Coefficients:
## (Intercept) body.weight
## 811.23 7.06cor.test( rmr$metabolic.rate,rmr$body.weight, method = "pearson")##
## Pearson's product-moment correlation
##
## data: rmr$metabolic.rate and rmr$body.weight
## t = 7.2213, df = 42, p-value = 7.025e-09
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.5742343 0.8527119
## sample estimates:
## cor
## 0.7442379Jawaban Terdapat hubungan linier antara x dan y, berkorelasi karna p value < 0.05. korelasi juga berhubungan. Korelasi nya juga sangat kuat karena mendekati 1, nilai korelasi nya adalah 0.7442379.
Apabila ingin diketahui fungsi Y = f(X) yang menghubungkan X dengan Y sebagai fungsi linier. Persamaan seperti apa yang dihasilkan? Interpretasikan model yang terbentuk.
library(lmtest)## Warning: package 'lmtest' was built under R version 4.1.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 4.1.2##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericmodell <- lm( rmr$metabolic.rate~rmr$body.weight)
summary(modell)##
## Call:
## lm(formula = rmr$metabolic.rate ~ rmr$body.weight)
##
## Residuals:
## Min 1Q Median 3Q Max
## -245.74 -113.99 -32.05 104.96 484.81
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 811.2267 76.9755 10.539 2.29e-13 ***
## rmr$body.weight 7.0595 0.9776 7.221 7.03e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 157.9 on 42 degrees of freedom
## Multiple R-squared: 0.5539, Adjusted R-squared: 0.5433
## F-statistic: 52.15 on 1 and 42 DF, p-value: 7.025e-09Y= 811.23 + 7.06 X1
Interpretasi = Dimana Nilai konstanta (a) memiliki nilai positif sebesar 811.23. Tanda positif artinya menunjukkan pengaruh yang searah antara variabel independen dan variabel dependen. Nilai koefisien untuk variabel b1 memiliki nilai positif sebesar 7.06 . Hal ini menunjukkan jika x1 mengalami kenaikan 1%, maka Y akan naik sebesar 7.06 dengan asumsi variabel independen lainnya dianggap konstan. Tanda positif artinya menunjukkan pengaruh yang searah antara variabel independen dan variabel dependen.
Berdasarkan persamaan c), tentukan prediksi nilai Y berat badan X = (60, 65, 70, dan 75)
predict.lm(model,data.frame(body.weight=c(60, 65, 70, 75)))## 1 2 3 4
## 1234.798 1270.096 1305.394 1340.691SOAL 2 - Sebuah model diperlukan oleh bagian akuntansi untuk mencari tahu waktu yang diperlukan untukmemroses suatu dokumen penagihan. Data dikumpulkan selama 32 hari, dan banyak dokumen penagihan (invoice) dan waktu penyelesaian (time) disajikan sebagai berikut.
Invoices <- c(103,173, 149 ,193 ,169 ,29 ,188 ,19 ,201 ,58 ,110 ,83 ,60, 25, 60, 190 , 233 ,289, 45, 70, 241, 163 ,120, 201 ,135 ,80,77, 222 ,181 ,30 ,61, 120 )
Time <- c(1.5, 2.0 ,2.1, 2.5 ,2.5, 0.5 ,2.3 ,0.3 ,2.7 ,1.0, 1.5, 1.2, 0.8, 0.4, 1.8, 2.9 , 3.4, 4.1, 1.2, 1.8 ,3.8, 2.8 ,2.5 ,3.3, 2.0, 1.7 ,1.7 ,3.1, 2.8, 1.0 ,1.9, 2.6)
y <- data.frame(Invoices,Time)
datatable(y)a. Tentukan mana yang menjadi variable independent dan variabel dependent
dependent atau y adalah Time. independent atau x adalah Invoices
b. Dengan mengasumsikan hubungan linier dari kedua variabel tersebut, tentukan koefisien b0
dan b1 untuk garis linier tersebut.
oke <- lm(Time~Invoices, data=y)
oke##
## Call:
## lm(formula = Time ~ Invoices, data = y)
##
## Coefficients:
## (Intercept) Invoices
## 0.48715 0.01229Persamaan Y : 0.48715 + 0.01229 X1
Jawaban : koefisien b0 nya adalah 0.48715 dan koef b1 nya adalah 0.01229 .
c. Interpretasikan nilai titik potong b0, dan nilai kemiringan b1 pada persoalan ini.
Interpretasi = Dimana Nilai titik potong b0 memiliki nilai positif sebesar 0.48715. Tanda positif artinya menunjukkan pengaruh yang searah . Nilai koefisien untuk variabel b1 memiliki nilai positif sebesar 0.01229 . Hal ini menunjukkan jika x1 mengalami kenaikan 1%, maka Y akan naik sebesar 0.01229 dengan asumsi variabel independen lainnya dianggap konstan. Tanda positif artinya menunjukkan pengaruh yang searah antara variabel independen dan variabel dependen.
d. Tentukan koefisien determinasi r2, dan interpretasikan nilai tersebut.
summary(oke)$r.squared## [1] 0.8622931Maka: Koef determinas 0.8622 atau 86.22. Berarti bahwa Invoices menjelaskan Y sebesar 86.22% sisanya dipengaruhi oleh faktor lain
e. Gambarkan plot antara residu dengan variabel dependent, jelaskan makna dari gambar
tersebut
m1 <- lm(data=y, Invoices~Time)
y$residualinvoice <- residuals(m1)
ggplot(y, aes(x= fitted.values(m1), y= residualinvoice)) +
geom_point(color= "orange") + geom_smooth(method = "lm", se=F)## `geom_smooth()` using formula 'y ~ x'
f. Gambarkan plot antara residu dengan variabel independent, interpretasikan hasilnya.
m2 <- lm(data=y, Time~Invoices)
y$residualtime <- residuals(m2)
ggplot(y, aes(x= fitted.values(m2), y=residualtime )) +
geom_point(color= "green") + geom_smooth(method = "lm", se=F)## `geom_smooth()` using formula 'y ~ x'
g. Berdasarkan plot e dan f, jelaskan apakah model yang terbentuk sudah memadai?
Untuk model yang memadai bisa dilihat lebih memadai yang model soal f, karena nilai atas dan bawahnya terlihat lebih seimbang. sedangkan model e terlihat lebih under fitting, kareana nilai atas lebih baanyak dibanding nilai bawahnya.
SOAL 3 - Gugus data kfm dari packages ISwR merupakan data bayi usia sekitar 2 bulan. Penelitan bertujuan
untuk meneliti faktor apa saja yang berpengaruh terhadap asupan asi. Berikut adalah metadata gugus data tersebut no nomor urut. dl.milk a asupan asi (dl/24jam) sex jenis kelamin, dengan faktor level boy dan girl. weight berat badan bayi (kg). ml.suppl suplemen susu tambahan (ml/24jam). mat.weight berat ibu (kg). mat.height tinggi ibu (cm).
data(kfm)
data8 <- kfm
data8## no dl.milk sex weight ml.suppl mat.weight mat.height
## 1 1 8.42 boy 5.002 250 65 173
## 2 4 8.44 boy 5.128 0 48 158
## 3 5 8.41 boy 5.445 40 62 160
## 4 10 9.65 boy 5.106 60 55 162
## 5 12 6.44 boy 5.196 240 58 170
## 6 16 6.29 boy 5.526 0 56 153
## 7 22 9.79 boy 5.928 30 78 175
## 8 28 8.43 boy 5.263 0 57 170
## 9 31 8.05 boy 6.578 230 57 168
## 10 32 6.48 boy 5.588 555 58 173
## 11 36 7.64 boy 4.613 0 58 171
## 12 39 8.73 boy 5.882 60 54 163
## 13 54 7.71 boy 5.618 315 68 179
## 14 55 8.39 boy 6.032 370 56 175
## 15 72 9.32 boy 6.030 130 62 168
## 16 78 6.78 boy 4.727 0 59 172
## 17 79 9.63 boy 5.345 55 68 172
## 18 80 5.97 boy 5.359 10 60 159
## 19 81 8.39 boy 5.320 20 59 174
## 20 82 10.43 boy 6.501 105 76 185
## 21 83 5.62 boy 4.666 80 52 159
## 22 84 6.84 boy 4.969 80 54 165
## 23 90 10.35 boy 6.105 0 78 174
## 24 91 4.91 boy 4.360 0 49 162
## 25 98 7.70 boy 5.667 0 63 165
## 26 6 10.03 girl 6.100 0 58 167
## 27 14 7.42 girl 5.421 45 67 175
## 28 25 5.00 girl 4.744 30 73 164
## 29 26 8.67 girl 5.800 30 80 175
## 30 27 6.90 girl 5.822 0 59 174
## 31 34 6.89 girl 5.081 20 53 162
## 32 37 7.22 girl 5.336 590 58 160
## 33 38 7.01 girl 5.637 100 63 170
## 34 40 8.06 girl 5.546 70 61 170
## 35 41 4.44 girl 4.386 150 58 167
## 36 43 8.57 girl 5.568 30 70 172
## 37 46 5.17 girl 5.169 0 65 160
## 38 47 7.74 girl 4.825 210 58 176
## 39 56 7.93 girl 5.156 20 74 165
## 40 57 5.03 girl 4.120 100 55 162
## 41 63 7.68 girl 4.725 100 50 160
## 42 65 6.91 girl 5.636 30 49 161
## 43 66 8.23 girl 5.377 110 55 167
## 44 68 7.36 girl 5.195 80 59 171
## 45 74 6.46 girl 5.385 70 51 165
## 46 85 7.24 girl 4.635 15 48 167
## 47 88 9.03 girl 5.730 100 62 172
## 48 100 4.63 girl 5.360 145 48 157
## 49 104 6.97 girl 4.890 30 67 165
## 50 105 5.82 girl 4.339 95 47 163a. Tentukan model dengan melibatkan seluruh peubah bebas, interpretasikan hasilnya
model3 = lm(data = kfm, dl.milk ~ sex + weight + ml.suppl + mat.weight +mat.height)
girl =subset(kfm, sex== "girl")
model_girl = lm(data = kfm, dl.milk ~ weight + ml.suppl + mat.weight +mat.height)
boys =subset(kfm, sex== "boy")
model_boy = lm(data = kfm, dl.milk ~ weight + ml.suppl + mat.weight +mat.height)
summary(model3)##
## Call:
## lm(formula = dl.milk ~ sex + weight + ml.suppl + mat.weight +
## mat.height, data = kfm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.74201 -0.81173 -0.00926 0.78326 2.52646
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -11.681839 4.361561 -2.678 0.010363 *
## sexgirl -0.499532 0.312672 -1.598 0.117284
## weight 1.349124 0.322450 4.184 0.000135 ***
## ml.suppl -0.002233 0.001241 -1.799 0.078829 .
## mat.weight 0.006212 0.023708 0.262 0.794535
## mat.height 0.072278 0.030169 2.396 0.020906 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.075 on 44 degrees of freedom
## Multiple R-squared: 0.5459, Adjusted R-squared: 0.4943
## F-statistic: 10.58 on 5 and 44 DF, p-value: 1.03e-06summary(model_girl)##
## Call:
## lm(formula = dl.milk ~ weight + ml.suppl + mat.weight + mat.height,
## data = kfm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.03235 -0.73499 -0.01353 0.67262 2.80315
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -12.795892 4.379092 -2.922 0.00542 **
## weight 1.450420 0.321562 4.511 4.6e-05 ***
## ml.suppl -0.002186 0.001262 -1.732 0.09011 .
## mat.weight 0.003966 0.024071 0.165 0.86987
## mat.height 0.074999 0.030636 2.448 0.01833 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.093 on 45 degrees of freedom
## Multiple R-squared: 0.5195, Adjusted R-squared: 0.4768
## F-statistic: 12.16 on 4 and 45 DF, p-value: 8.731e-07summary(model_boy)##
## Call:
## lm(formula = dl.milk ~ weight + ml.suppl + mat.weight + mat.height,
## data = kfm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.03235 -0.73499 -0.01353 0.67262 2.80315
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -12.795892 4.379092 -2.922 0.00542 **
## weight 1.450420 0.321562 4.511 4.6e-05 ***
## ml.suppl -0.002186 0.001262 -1.732 0.09011 .
## mat.weight 0.003966 0.024071 0.165 0.86987
## mat.height 0.074999 0.030636 2.448 0.01833 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.093 on 45 degrees of freedom
## Multiple R-squared: 0.5195, Adjusted R-squared: 0.4768
## F-statistic: 12.16 on 4 and 45 DF, p-value: 8.731e-07model3 = lm(data = kfm, dl.milk ~ weight + ml.suppl + mat.weight +mat.height)
summary(model3)##
## Call:
## lm(formula = dl.milk ~ weight + ml.suppl + mat.weight + mat.height,
## data = kfm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.03235 -0.73499 -0.01353 0.67262 2.80315
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -12.795892 4.379092 -2.922 0.00542 **
## weight 1.450420 0.321562 4.511 4.6e-05 ***
## ml.suppl -0.002186 0.001262 -1.732 0.09011 .
## mat.weight 0.003966 0.024071 0.165 0.86987
## mat.height 0.074999 0.030636 2.448 0.01833 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.093 on 45 degrees of freedom
## Multiple R-squared: 0.5195, Adjusted R-squared: 0.4768
## F-statistic: 12.16 on 4 and 45 DF, p-value: 8.731e-07Persamaan yang dihasilkan dari semua peubah bebas (-No dan Sex) adalah
Y = -12.795892 + 1.450420 weight -0.002186 ml.suppl + 0.003966 mat.weight + 0.074999 mat.height.
- Dimana Nilai konstanta (a) memiliki nilai negatif sebesar -12.795. Tanda negatif artinya menunjukkan pengaruh yang berlawanan arah antara variabel independen dan variabel dependen.
Nilai koefisien regresi untuk variabel b1 yaitu sebesar 1.45. Hal ini artinya jika variabel x1 mengalami kenaikan 1%, maka variabel Y akan mengalami kenaikan sebesar 1.45 . Dengan asumsi bahwa variabel lainnya dianggap konstan.
Nilai koefisien regresi untuk variabel b2 yaitu sebesar -0.0021. Nilai tersebut menunjukkan pengaruh negatif (berlawanan arah) antara variabel suppl dan milk. Hal ini artinya jika variabel suppl mengalami kenaikan sebesar 1%, maka sebaliknya variabel milk akan mengalami penurunan sebesar 0.0021. Dengan asumsi bahwa variabel lainnya tetap konstan.
Nilai koefisien regresi untuk variabel b3 yaitu sebesar 0.003. Hal ini artinya jika variabel x3 mengalami kenaikan 1%, maka variabel Y akan mengalami kenaikan sebesar 0.003 . Dengan asumsi bahwa variabel lainnya dianggap konstan.
Nilai koefisien regresi untuk variabel b4 yaitu sebesar 0.074 . Hal ini artinya jika variabel x4 mengalami kenaikan 1%, maka variabel Y akan mengalami kenaikan sebesar 0.074 . Dengan asumsi bahwa variabel lainnya dianggap konstan.
b. Tentukan model dengan hanya dibatasi 3 peubah bebas saja. Peubah bebas mana yang terbaik untuk masuk ke dalam model? Lakukan pemeriksaan asumsi model regresi.
model3.1 <- lm(data=kfm, dl.milk ~ weight + ml.suppl + mat.weight )
m3.1 <- summary(model3.1)$adj
model3.2 = lm(data = kfm, dl.milk~weight + ml.suppl + mat.height)
m3.2 <- summary(model3.2)$adj
model3.3 = lm(data = kfm, dl.milk~ml.suppl + mat.weight + mat.height)
m3.3 <- summary(model3.3)$adj
model3.4 = lm(data = kfm, dl.milk~weight + mat.weight + mat.height)
m3.4 <- summary(model3.4)$adj
dataadj = data.frame("model" = c(1:4),
"adjR2" = c(m3.1, m3.2, m3.3, m3.4))
which.max(dataadj$adjR2)## [1] 2summary(model3.2)##
## Call:
## lm(formula = dl.milk ~ weight + ml.suppl + mat.height, data = kfm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.06540 -0.74758 -0.02408 0.67488 2.79882
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -13.064926 4.020073 -3.250 0.00216 **
## weight 1.464781 0.306231 4.783 1.81e-05 ***
## ml.suppl -0.002237 0.001209 -1.850 0.07074 .
## mat.height 0.077600 0.025979 2.987 0.00451 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.082 on 46 degrees of freedom
## Multiple R-squared: 0.5192, Adjusted R-squared: 0.4879
## F-statistic: 16.56 on 3 and 46 DF, p-value: 1.953e-07Peubah bebas yang terbaik untuk masuk kedalam model adalah weight, ml.suppl, dan mat.height.
uji asumsi
#library(regclass)
#library(skedastic)
library(lmtest)
library(car)## Warning: package 'car' was built under R version 4.1.2## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## The following object is masked from 'package:purrr':
##
## somemodelasumsi <- lm(data=kfm, dl.milk~weight + ml.suppl + mat.height)
res = modelasumsi$residuals
shapiro.test(res) # p-value > a = 0,05 H0 diterima artinya normal (normalitas)##
## Shapiro-Wilk normality test
##
## data: res
## W = 0.98789, p-value = 0.8849bptest(modelasumsi) # p-value > a = 0,05 H0 diterima artinya data homogen (homogenitas)##
## studentized Breusch-Pagan test
##
## data: modelasumsi
## BP = 4.2974, df = 3, p-value = 0.2311vif(modelasumsi) # VIF < 5 artinya non-multikolinearitas/tidak terjadi multikolinearitas## weight ml.suppl mat.height
## 1.180701 1.038608 1.201161Dari hasil test data di atas, dapat dimpulkan kalau datanya normal. homogen, dan tidak terjadi multikolinearitas.
SOAL 4 - Data berikut adalah data banyak kecelakaan di arena NASCAR Sprint Cup Series dari tahun 2001 hingga 2009.
library(DT)
setwd(getwd())
library(readxl)
data5 = read_excel("datalatsoal.xlsx", sheet =2 )
data5$Year = as.numeric(data5$Year)
data5$Accidents = as.numeric(data5$Accidents)
datatable(data5)Year 2001 2002 2003 2004 2005 2006 2007 2008 2009 Accidents 200 186 235 204 253 237 240 211 195
a. Gambarkan diagram pencar (plot) data runtun waktu
library(forecast)## Warning: package 'forecast' was built under R version 4.1.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo##
## Attaching package: 'forecast'## The following object is masked from 'package:ggpubr':
##
## gghistogramtrai <- lm(data5$Accidents ~ data5$Year)
summary(trai)##
## Call:
## lm(formula = data5$Accidents ~ data5$Year)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.42 -12.26 -11.36 18.84 35.11
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3056.944 6430.923 -0.475 0.649
## data5$Year 1.633 3.207 0.509 0.626
##
## Residual standard error: 24.84 on 7 degrees of freedom
## Multiple R-squared: 0.03572, Adjusted R-squared: -0.102
## F-statistic: 0.2593 on 1 and 7 DF, p-value: 0.6262ggplot(data5, aes(x=Year, y=Accidents)) +
geom_point()+
geom_smooth(method=lm)+
scale_x_continuous(breaks=seq(2001, 2009, 1))## `geom_smooth()` using formula 'y ~ x'
plot(data5$Year,
data5$Accidents,
type = "l")
lines(data5$Year,
predict(trai),
col = 2,
lwd = 2)
abline(reg = lm(data5$Year~ data5$Accidents))
b. Dengan menggunakan pendekatan trend linier, tentukan persamaan garis yang terbentuk.
model5 <- lm(Accidents ~ Year, data = data5)
summary(model5)##
## Call:
## lm(formula = Accidents ~ Year, data = data5)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.42 -12.26 -11.36 18.84 35.11
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3056.944 6430.923 -0.475 0.649
## Year 1.633 3.207 0.509 0.626
##
## Residual standard error: 24.84 on 7 degrees of freedom
## Multiple R-squared: 0.03572, Adjusted R-squared: -0.102
## F-statistic: 0.2593 on 1 and 7 DF, p-value: 0.6262Y = -3056.9 + 1.633 X1
c. Lakukan pendekatan rata-rata 3 tahun untuk data tersebut.
data5$prediksi1<- NA
k=3
B=nrow(data5)-k
for (i in 1:B){
B=i+(k-1)
data5$prediksi1[i+k] <- mean(data5$Accidents[i:B])}
data5## # A tibble: 9 x 3
## Year Accidents prediksi1
## <dbl> <dbl> <dbl>
## 1 2001 200 NA
## 2 2002 186 NA
## 3 2003 235 NA
## 4 2004 204 207
## 5 2005 253 208.
## 6 2006 237 231.
## 7 2007 240 231.
## 8 2008 211 243.
## 9 2009 195 229.d. Gambarkan hasil b dan c ke dalam plot runtun waktu.
ggplot(data5, aes(x=Year, y=Accidents)) +
geom_line()+
geom_smooth(method=lm, se=F)+
scale_x_continuous(breaks=seq(2001, 2009, 1))+
geom_line(aes(y=prediksi1), color="red")## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 3 row(s) containing missing values (geom_path).
ggplot(data5, aes(x=Year, y=Accidents)) +
geom_line()+
geom_smooth(method=lm)+
scale_x_continuous(breaks=seq(2001, 2009, 1))## `geom_smooth()` using formula 'y ~ x'
ggplot(data5, aes(x=Year, y=prediksi1)) +
geom_line()+
scale_x_continuous(breaks=seq(2001, 2009, 1))## Warning: Removed 3 row(s) containing missing values (geom_path).
e. Periksa residu dari b dan c, tentukan mana yang lebih baik.
# residual b
# Year = data5$Year
data5$predictedL = fitted.values(model5)
data5$residualL = residuals(model5)
data5$residualLS= residuals(model5)^2
qplot(fitted.values(model5), residuals(model5)) + geom_smooth(method = "lm", se =F) # memiliki hubungan kalau garisnya horizontal di 0## `geom_smooth()` using formula 'y ~ x'
MSEb = mean(data5$residualLS)
MAEb = mean(abs(data5$residualL))
MAPEb= mean(abs(data5$residualL)/data5$Accidents)
# residual c
data5$residualM = (data5$Accidents - data5$prediksi1)
data5$residualMS = (data5$Accidents - data5$prediksi1)^2
data5## # A tibble: 9 x 8
## Year Accidents prediksi1 predictedL residualL residualLS residualM residualMS
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2001 200 NA 211. -11.4 129. NA NA
## 2 2002 186 NA 213. -27.0 728. NA NA
## 3 2003 235 NA 215. 20.4 415. NA NA
## 4 2004 204 207 216. -12.3 150. -3 9
## 5 2005 253 208. 218. 35.1 1233. 44.7 1995.
## 6 2006 237 231. 220. 17.5 305. 6.33 40.1
## 7 2007 240 231. 221. 18.8 355. 8.67 75.1
## 8 2008 211 243. 223. -11.8 139. -32.3 1045.
## 9 2009 195 229. 224. -29.4 866. -34.3 1179.a = k+1
b = nrow(data5)
MSEc = mean(data5$residualMS[a:b])
MAEc = mean(abs(data5$residualM[a:b]))
MAPEc= mean(abs(data5$residualM[a:b])/data5$Accidents[a:b])
MSEb ## [1] 480.0914MSEc ## [1] 723.9259MAEb ## [1] 20.40247MAEc ## [1] 21.55556MAPEb## [1] 0.09405197MAPEc## [1] 0.09723249Model yang paling baik adalah pada model B, karena nilai perhitungan residu nya memiliki nilai terkecil. karena residu merupakan error atau kesalaham.