Anreg 3 Test
Haidar Ramdhani
2024-02-06
library(readxl)## Warning: package 'readxl' was built under R version 4.3.2data <- read_xlsx("D:\\Campss\\Season 4\\Anreg\\P3\\Data Tugas Anreg.xlsx")## New names:
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`head(data)## # A tibble: 6 × 15
## Provinsi Indeks Pembangunan M…¹ PDRB per kapita (Rib…² `Angka Harapan Hidup`
## <chr> <dbl> <dbl> <dbl>
## 1 ACEH 72.8 39156. 68.1
## 2 SUMATERA … 72.7 63194. 67.4
## 3 SUMATERA … 73.3 50593. 67.7
## 4 RIAU 73.5 149914. 69.8
## 5 JAMBI 72.1 76096. 69.3
## 6 SUMATERA … 70.9 68338. 68.1
## # ℹ abbreviated names: ¹`Indeks Pembangunan Manusia`,
## # ²`PDRB per kapita (Ribu Rupiah)`
## # ℹ 11 more variables:
## # `Rata-Rata Lama Sekolah Penduduk Umur ≥ 15 Tahun Menurut Provinsi` <dbl>,
## # `Persentase Penduduk Miskin` <chr>, `PDRB per kapita (Juta Rupiah)` <dbl>,
## # ...8 <lgl>, ...9 <lgl>, ...10 <lgl>, ...11 <lgl>, ...12 <chr>, ...13 <chr>,
## # ...14 <chr>, ...15 <chr>data_005 <- data[,c(1:3, 7)]
Y <- data_005$`Indeks Pembangunan Manusia`
X1 <- data_005$`PDRB per kapita (Juta Rupiah)`
n <- nrow(data_005)
View(data_005)model <- lm(Y~X1, data_005)
summary(model)##
## Call:
## lm(formula = Y ~ X1, data = data_005)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.0117 -0.9399 0.3010 1.9364 9.7471
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 69.434560 0.949454 73.131 < 2e-16 ***
## X1 0.033111 0.009792 3.381 0.00192 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.4 on 32 degrees of freedom
## Multiple R-squared: 0.2632, Adjusted R-squared: 0.2402
## F-statistic: 11.43 on 1 and 32 DF, p-value: 0.001916ybar <- mean(Y)
{plot(X1,Y, pch = 16, col = "blue")
abline(model, col="red", lwd = 1.5)
abline(h=ybar, col="green", lwd = 1.5)
residuals <- resid(model)
for (i in 1:length(X1)) {
segments(X1[i], Y[i], X1[i], fitted(model)[i], col = "blue", lty = 2)
}
segments(X1, Y, X1, fitted(model), col = "black", lty = 2)}
titik <- 10
x_titik <- X1[titik]
y_titik <- Y[titik]
y_prediksi <- fitted(model)[titik]
# Colpal
color_palette <- colorRampPalette(colors = c("darkblue", "lightblue"))
# Base
plot(X1, Y, pch = 16, xlab = "PDRB per kapita (Juta Rupiah)", ylab = "Indeks Pembangunan Manusia", col = color_palette(length(Y)))
abline(model, col = "red", lwd = 1.5)
# xy strip
segments(x_titik, 0, x_titik, y_titik, col = "purple", lty = 2, lwd = 1.5)
segments(0, y_titik, x_titik, y_titik, col = "purple", lty = 2, lwd = 1.5)
# error line
segments(x_titik - 2, y_titik - 0.3, x_titik -2, y_prediksi + 0.3, col = "coral")
# error arrow
arrows(x_titik-2, y_titik-0.3, x_titik-2, y_prediksi+0.3, length = 0.04, col = "coral")
arrows(x_titik-2, y_prediksi+0.3, x_titik-2, y_titik-0.3, length = 0.04, col = "coral")
# error val
error <- abs(Y[titik] - fitted(model)[titik])
# error text
text(x_titik - 20, y_titik - 1.2, paste("Error:", round(error, 2)), col = "black", cex = 0.8)
b0 <- model$coefficients[[1]]
b1 <- model$coefficients[[2]]
b0;b1## [1] 69.43456## [1] 0.03311079\[ \hat{y} = \beta_1x + \beta_0 \\ \hat{y} = 0.03311079x + 69.43456 \]
y_duga <- 0
for (i in 1:length(Y)){
y_duga[i] <- b1*X1[i] + b0
}
y_duga## [1] 70.73105 71.52697 71.10975 74.39834 71.95417 71.69729 70.88288 70.92883
## [9] 71.54545 74.12579 79.31350 71.05826 70.83017 70.89291 71.63195 71.45399
## [17] 71.27369 70.38393 70.15367 70.96300 71.84983 71.42383 77.33813 75.74584
## [25] 71.38953 72.92925 71.60640 71.38029 70.75524 70.66199 70.37934 71.21397
## [33] 71.98905 71.40173\[ JKR = \sum_{i=1}^{n}(\hat{y}_i - \bar{y})^2 \\ JKT = \sum_{i=1}^{n}(y_i - \bar{y})^2 \\ JKG = \sum_{i=1}^{n}(y_i - \hat{y}_i)^2 \]
JKR <- 0
JKT <- 0
JKG <- 0
for (i in 1:length(Y)){
JKR <- JKR + (y_duga[i] - ybar)^2
JKT <- JKT + (Y[i] - ybar)^2
JKG <- JKG + (Y[i] - y_duga[i])^2
}
JK_num <- c(JKR, JKT, JKG)
JK <- c("JKR", "JKT", "JKG")
data.frame(JK, JK_num)## JK JK_num
## 1 JKR 132.1830
## 2 JKT 502.1231
## 3 JKG 369.9401\[ KTR = \frac{JKT}{1}; \ \ KTG = \frac{JKG}{n-2}\\ S_{xx} = \sum_{i=1}^{n}(x_i - \bar x)^2\\ S_e^2 =KTG; \ \ S^2_{\beta_1} = \frac{S_e^2}{S_{xx}}; \ \ S^2_{\beta_0} = \frac{S^2_e\sum_{i=1}^{n}x_i^2}{n\sum(x_i - \bar x)^2} \]
KTR <- JKT
KTG <- JKG/(n-2)
Se_sq <- KTG
xbar <- mean(X1)
Sxx <- 0
sum_x_sq <-0
for (i in 1:length(X1)){
Sxx <- Sxx + (X1[i] - xbar)^2
sum_x_sq <- sum_x_sq + (X1[i])^2
}
Sb1_sq <- Se_sq/Sxx
Sb0_sq <- (Se_sq*sum_x_sq)/(n*Sxx)
Sb1_sq;Sb0_sq## [1] 9.588369e-05## [1] 0.9014636\[ Uji \ Hipotesis \ \beta_1 \\ H_0 : \beta_1 = 0 \\ H_1 : \beta_1 \neq 0\\ \]
\[ t = \frac{b_1 - \beta_1}{S_{b_1}} \]
alpha <- 0.05
thit_b1 <- (b1 - 0)/sqrt(Sb1_sq)
ttab_b1 <- abs(qt(alpha/2,n-2))
thit_b1;ttab_b1## [1] 3.381405## [1] 2.036933print("t hitung > t tabel, maka tolak H0")## [1] "t hitung > t tabel, maka tolak H0"\[ Uji \ Hipotesis \ \beta_0 \\ H_0 : \beta_0 = 0 \\ H_1 : \beta_0 \neq 0\\ \] \[ t = \frac{b_0 - \beta_0}{S_{b_0}} \]
thit_b0 <- (b0 - 0)/sqrt(Sb0_sq)
ttab_b0 <- abs(qt(alpha/2,n-2))
thit_b0;ttab_b0## [1] 73.13101## [1] 2.036933print("t hitung > t tabel, maka tolak H0")## [1] "t hitung > t tabel, maka tolak H0"\[ b_0 \ {\pm} \ t_{n-2, \frac{a}{2}} \times S_{b_0}\\ b_1 \ {\pm} \ t_{n-2, \frac{a}{2}} \times S_{b_1} \]
low_b0 <- b0 - ttab_b0*sqrt(Sb0_sq)
up_b0 <- b0 + ttab_b0*sqrt(Sb0_sq)
low_b0;up_b0## [1] 67.50059## [1] 71.36854low_b1 <- b1 - ttab_b1*sqrt(Sb1_sq)
up_b1 <- b1 + ttab_b1*sqrt(Sb1_sq)
low_b1;up_b1## [1] 0.0131651## [1] 0.05305649Koefisien <- c("b0","b1")
`Batas Bawah` <- c(low_b0, low_b1)
`Batas Atas` <- c(up_b0, up_b1)
data.frame(Koefisien,`Batas Bawah`,`Batas Atas`)## Koefisien Batas.Bawah Batas.Atas
## 1 b0 67.5005851 71.36853577
## 2 b1 0.0131651 0.05305649