Tugas Anreg
2025-01-21
#Data Bangkitan
set.seed(2025)
n <- 44
p <- 3
x1 <- runif(n,5,34)
x2 <- rnorm(n,3,3)
x0 <- rep(1,n)
X <- data.frame(x0,x1,x2)
X## x0 x1 x2
## 1 1 26.245984 11.55834435
## 2 1 18.797082 5.01457590
## 3 1 19.912260 2.65245223
## 4 1 19.454535 -0.90405597
## 5 1 27.628251 0.24659923
## 6 1 19.623313 3.15214814
## 7 1 31.053609 1.85960141
## 8 1 8.707728 5.16787531
## 9 1 23.695490 -0.07727278
## 10 1 21.516401 8.45961166
## 11 1 17.624180 -0.81125254
## 12 1 32.617468 4.76644732
## 13 1 23.976368 1.09723993
## 14 1 5.691234 -0.79744623
## 15 1 18.575563 3.85124701
## 16 1 29.862952 -1.44528350
## 17 1 15.586748 5.73563896
## 18 1 15.601674 5.91440631
## 19 1 27.002521 6.81938091
## 20 1 8.119801 7.38680545
## 21 1 15.038771 1.16675152
## 22 1 28.625004 1.91834031
## 23 1 6.149126 -1.58745535
## 24 1 25.744191 6.39979130
## 25 1 14.769832 1.67778260
## 26 1 31.633666 3.38881438
## 27 1 27.557282 5.61369779
## 28 1 10.775524 4.51654414
## 29 1 29.847920 4.11267677
## 30 1 12.528776 -0.68402786
## 31 1 17.272998 2.51340687
## 32 1 9.164089 6.26421457
## 33 1 18.896967 4.07760410
## 34 1 20.821964 6.20157347
## 35 1 24.195277 4.88513628
## 36 1 8.307199 0.50526334
## 37 1 7.744648 0.92284367
## 38 1 10.124336 2.86563066
## 39 1 33.780474 4.78370664
## 40 1 31.254063 4.91730241
## 41 1 16.698439 4.43826564
## 42 1 31.983530 7.11918724
## 43 1 27.285347 -0.44305238
## 44 1 28.625850 -4.35209547#Persamaan acak dan Nilai Y
e <- rnorm(n,0,3)
y <- 5 + 3*x1 + 2*x2 + e
rand.comp <- data.frame(e,y)
rand.comp## e y
## 1 -2.707689476 104.14695
## 2 -1.192295000 70.22810
## 3 5.150592851 75.19228
## 4 -1.232259882 60.32323
## 5 -0.275350583 88.10260
## 6 -2.239508577 67.93473
## 7 -2.465085830 99.41494
## 8 -6.951058932 34.50787
## 9 -1.606003744 74.32592
## 10 2.992139648 89.46056
## 11 -1.635654262 54.61438
## 12 4.528947493 116.91425
## 13 -2.231515089 76.89207
## 14 -2.002316522 18.47649
## 15 -3.362679194 65.06650
## 16 4.410129202 96.10842
## 17 0.615769863 63.84729
## 18 -3.183725664 60.45011
## 19 -0.002924495 99.64340
## 20 -0.073341511 44.05967
## 21 3.912528585 56.36234
## 22 -2.976207336 91.73549
## 23 -3.145749951 17.12672
## 24 3.025916095 98.05807
## 25 1.879021682 54.54408
## 26 -2.714462703 103.96416
## 27 5.148200665 104.04744
## 28 0.270689096 46.63035
## 29 -1.276737001 101.49238
## 30 -3.158043405 38.06023
## 31 -5.511422267 56.33439
## 32 -4.489064368 40.53163
## 33 -2.466087546 67.38002
## 34 0.650148276 80.51919
## 35 2.071277755 89.42738
## 36 -0.764192480 30.16793
## 37 3.127073252 33.20671
## 38 0.711033507 41.81530
## 39 -3.981711683 111.92712
## 40 -0.229154969 108.36764
## 41 -3.784373109 60.18747
## 42 4.502024780 119.69099
## 43 1.008850011 86.97879
## 44 3.672600719 85.84596dt <- data.frame(y,x1,x2)
dt## y x1 x2
## 1 104.14695 26.245984 11.55834435
## 2 70.22810 18.797082 5.01457590
## 3 75.19228 19.912260 2.65245223
## 4 60.32323 19.454535 -0.90405597
## 5 88.10260 27.628251 0.24659923
## 6 67.93473 19.623313 3.15214814
## 7 99.41494 31.053609 1.85960141
## 8 34.50787 8.707728 5.16787531
## 9 74.32592 23.695490 -0.07727278
## 10 89.46056 21.516401 8.45961166
## 11 54.61438 17.624180 -0.81125254
## 12 116.91425 32.617468 4.76644732
## 13 76.89207 23.976368 1.09723993
## 14 18.47649 5.691234 -0.79744623
## 15 65.06650 18.575563 3.85124701
## 16 96.10842 29.862952 -1.44528350
## 17 63.84729 15.586748 5.73563896
## 18 60.45011 15.601674 5.91440631
## 19 99.64340 27.002521 6.81938091
## 20 44.05967 8.119801 7.38680545
## 21 56.36234 15.038771 1.16675152
## 22 91.73549 28.625004 1.91834031
## 23 17.12672 6.149126 -1.58745535
## 24 98.05807 25.744191 6.39979130
## 25 54.54408 14.769832 1.67778260
## 26 103.96416 31.633666 3.38881438
## 27 104.04744 27.557282 5.61369779
## 28 46.63035 10.775524 4.51654414
## 29 101.49238 29.847920 4.11267677
## 30 38.06023 12.528776 -0.68402786
## 31 56.33439 17.272998 2.51340687
## 32 40.53163 9.164089 6.26421457
## 33 67.38002 18.896967 4.07760410
## 34 80.51919 20.821964 6.20157347
## 35 89.42738 24.195277 4.88513628
## 36 30.16793 8.307199 0.50526334
## 37 33.20671 7.744648 0.92284367
## 38 41.81530 10.124336 2.86563066
## 39 111.92712 33.780474 4.78370664
## 40 108.36764 31.254063 4.91730241
## 41 60.18747 16.698439 4.43826564
## 42 119.69099 31.983530 7.11918724
## 43 86.97879 27.285347 -0.44305238
## 44 85.84596 28.625850 -4.35209547#Eksplorasi Data
par(mfrow=c(1,2))
plot(x1, y, pch=19)
plot(x2, y, pch=19)
#Model ##Matriks ###Persamaan Regresi
y <- as.matrix(y)
X <- as.matrix(cbind(x0,x1,x2))
b <- solve(t(X)%*%X)%*%t(X)%*%y;round(b,4)## [,1]
## x0 2.7127
## x1 3.1007
## x2 1.9430b0<-b[1];b0## [1] 2.712666b1<-b[2];b1## [1] 3.100749b2<-b[3];b2## [1] 1.943029###Koefisien determinasi dan penyesuaiannya
sigma_kuadrat <- (t(y)%*%y-t(b)%*%t(X)%*%y)/(n-p)
Res_se <- sqrt(sigma_kuadrat)
round(Res_se,3)## [,1]
## [1,] 3.018df <- n-p
df## [1] 41y_duga <- b0+b1*x1+b2*x2
Y <- data.frame(y,y_duga);Y## y y_duga
## 1 104.14695 106.55309
## 2 70.22810 70.74117
## 3 75.19228 69.60939
## 4 60.32323 61.27970
## 5 88.10260 88.86010
## 6 67.93473 69.68436
## 7 99.41494 102.61539
## 8 34.50787 39.75448
## 9 74.32592 76.03630
## 10 89.46056 85.86690
## 11 54.61438 55.78455
## 12 116.91425 113.11261
## 13 76.89207 79.18935
## 14 18.47649 18.81030
## 15 65.06650 67.79392
## 16 96.10842 92.50197
## 17 63.84729 62.18778
## 18 60.45011 62.58141
## 19 99.64340 99.69097
## 20 44.05967 42.24291
## 21 56.36234 51.61116
## 22 91.73549 95.19902
## 23 17.12672 18.69509
## 24 98.05807 94.97393
## 25 54.54408 51.77020
## 26 103.96416 107.38530
## 27 104.04744 99.06847
## 28 46.63035 44.90064
## 29 101.49238 103.25464
## 30 38.06023 40.23218
## 31 56.33439 61.15553
## 32 40.53163 43.29976
## 33 67.38002 69.23033
## 34 80.51919 79.32620
## 35 89.42738 87.22812
## 36 30.16793 29.45295
## 37 33.20671 28.51999
## 38 41.81530 39.67370
## 39 111.92712 116.75233
## 40 108.36764 109.17815
## 41 60.18747 63.11402
## 42 119.69099 115.71837
## 43 86.97879 86.45683
## 44 85.84596 83.01801R_squared <- (cor(y,y_duga))^2;round(R_squared,4)## [,1]
## [1,] 0.9885R_squared_adj <- 1-((1-R_squared)*(n-1)/(n-p));round(R_squared_adj,4)## [,1]
## [1,] 0.9879###Uji F dan Standar Error Parameter
KTReg <- sum((y_duga-mean(y))^2)/(p-1)
galat <- y-(b0+b1*x1+b2*x2)
KTG <- sum(galat^2)/(n-p)
Fhit <- KTReg/KTG;round(Fhit,0)## [1] 1758dbreg <- p-1;dbreg## [1] 2dbg <- n-p;dbg## [1] 41pf(Fhit, dbreg, dbg, lower.tail = F)## [1] 1.842518e-40se_b <- sqrt(sigma_kuadrat[1]*solve(t(X)%*%X))## Warning in sqrt(sigma_kuadrat[1] * solve(t(X) %*% X)): NaNs producedse_b0 <- se_b[1,1];round(se_b0,4)## [1] 1.261se_b1 <- se_b[2,2];round(se_b1,4)## [1] 0.0557se_b2 <- se_b[3,3];round(se_b2,4)## [1] 0.1448##Signifikansi Parameter (nilai-t)
t_b0 <- b0/se_b0;round(t_b0,2)## [1] 2.152*pt(-abs(t_b0 ),df <- n-p)## [1] 0.03740919t_b1 <- b1/se_b1;round(t_b1,2)## [1] 55.642*pt(-abs(t_b1 ),df <- n-p)## [1] 3.027117e-40t_b2 <- b2/se_b2;round(t_b2,2)## [1] 13.412*pt(-abs(t_b2 ),df <- n-p)## [1] 1.377525e-16###Selang Kepercayaan (1-α)*100%
t <- qt(.975, df <- n-p)
BB_b0 <- b0-t*se_b0
BA_b0 <- b0+t*se_b0
BB_b1 <- b1-t*se_b1
BA_b1 <- b1+t*se_b1
BB_b2 <- b2-t*se_b2
BA_b2 <- b2+t*se_b2
Batas.Bawah <- as.matrix(c(round(BB_b0,6),round(BB_b1,6),round(BB_b2,6)))
Batas.Atas <- as.matrix(c(round(BA_b0,6),round(BA_b1,6),round(BA_b2,6)))
Selang.Kepercayaan <- cbind(Batas.Bawah, Batas.Atas)
colnames(Selang.Kepercayaan ) <- c("Batas bawah Selang (2.5%)", "Batas atas Selang (97.5%)")
rownames(Selang.Kepercayaan ) <- c("Intersept", "b1", "b2")
Selang.Kepercayaan## Batas bawah Selang (2.5%) Batas atas Selang (97.5%)
## Intersept 0.165937 5.259395
## b1 2.988194 3.213305
## b2 1.650511 2.235546##Fungsi LM
reg <- lm(y~x1+x2, data= dt)
summary(reg)##
## Call:
## lm(formula = y ~ x1 + x2, data = dt)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.2466 -2.2033 -0.6353 2.3429 5.5829
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.71267 1.26104 2.151 0.0374 *
## x1 3.10075 0.05573 55.636 <2e-16 ***
## x2 1.94303 0.14484 13.415 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.018 on 41 degrees of freedom
## Multiple R-squared: 0.9885, Adjusted R-squared: 0.9879
## F-statistic: 1758 on 2 and 41 DF, p-value: < 2.2e-16anova(reg)## Analysis of Variance Table
##
## Response: y
## Df Sum Sq Mean Sq F value Pr(>F)
## x1 1 30379.5 30379.5 3335.82 < 2.2e-16 ***
## x2 1 1638.8 1638.8 179.95 < 2.2e-16 ***
## Residuals 41 373.4 9.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1confint(reg)## 2.5 % 97.5 %
## (Intercept) 0.1659369 5.259395
## x1 2.9881943 3.213305
## x2 1.6505114 2.235546##Perbandingan Hasil
koef<- as.matrix(reg$coefficients)
penduga <- cbind(b, koef)
colnames(penduga) <- c('matriks', 'fungsi lm')
rownames(penduga) <- c("intersep", "b1", "b2")
penduga## matriks fungsi lm
## intersep 2.712666 2.712666
## b1 3.100749 3.100749
## b2 1.943029 1.943029#Perbandingan 2 Model
a <- summary(reg)
rsquare1 <- a$r.squared
adj_r2 <- a$adj.r.squared
se1 <- a$sigma
#Model 2 (tanpa intersep)
reg2 <- lm(y~x1+x2-1, data=dt)
b <- summary(reg2)
rsquare2 <- b$r.squared
adj_r2_2 <- b$adj.r.squared
se2 <- b$sigma
#===Membandingkan kebaikan model===
model1 <- as.matrix(c(rsquare1, adj_r2, se1))
model2 <- as.matrix(c(rsquare2, adj_r2_2, se2))
tabel <- cbind(model1, model2)
colnames(tabel) <- c("Model 1", "Model 2")
rownames(tabel) <- c("R-Square", "Adj R-Square", "Standar Error Sisaan")
tabel## Model 1 Model 2
## R-Square 0.9884727 0.9984189
## Adj R-Square 0.9879104 0.9983436
## Standar Error Sisaan 3.0177901 3.1454082