— SOAL 1 —
# Data
x <- c(12,45,52,58,61,63,67,70,72,75,78,82,88,95,310)
# --- [a] Buatlah fungsi winsorized_mean(x, alpha) ---
winsorized_mean <- function(x, alpha){
x <- sort(x)
n <- length(x)
k <- floor(n*alpha)
y <- x
if(k > 0){
for(i in 1:k){
y[i] <- x[k+1]
}
for(i in (n-k+1):n){
y[i] <- x[n-k]
}
}
total <- 0
for(i in 1:n){
total <- total + y[i]
}
mean_w <- total/n
return(mean_w)
}
# --- [b] Hitung ordinary mean (alpha=0) dan Winsorized mean 20% (alpha=0.2) ---
# Ordinary mean
winsorized_mean(x,0)
## [1] 81.86667
# Winsorized mean 20%
winsorized_mean(x,0.2)
## [1] 69.73333
# Visualisasi Data
library(ggplot2)
data <- data.frame(x)
ggplot(data, aes(x = x)) +
geom_histogram(fill = "skyblue", alpha = 0.7, bins = 5) +
labs(
title = "Distribusi Data",
x = "Nilai",
y = "Frekuensi"
) +
theme_minimal()
# Berdasarkan histogram, sebagian besar data berada pada rentang menegah.
# Namun terdapat satu nilai yang jauh lebih besar dibandingkan data lainnya.
# Outlier ini menyebabkan distribusi data menjadi miring ke kanan (right-skewed)
# dan membuat nilai rata-rata menjadi lebih besar.
# Hal ini terlihat dari perbandingan:
# Ordinary mean ≈ 81.87
# Winsorized mean ≈ 69.73
— SOAL 2 —
# --- Baca data CSV ---
df <- read.csv("C:/Users/najib/Downloads/Quiz 1 Komstat/data_quiz1.csv")
X <- as.matrix(df[, c("x1", "x2", "x3")])
w <- df$w
# --- [a] Buatlah fungsi weighted_corr(X, w) ---
weighted_corr <- function(X, w){
n <- nrow(X)
p <- ncol(X)
W <- diag(w)
n_w <- 0
for(i in 1:n){
n_w <- n_w + w[i]
}
x_bar_w <- (t(X) %*% W %*% matrix(1,n,1))/n_w
D <- X - matrix(1,n,1) %*% t(x_bar_w)
S_w <- (t(D) %*% W %*% D)/n_w
s_w <- sqrt(diag(S_w))
R_w <- solve(diag(s_w)) %*% S_w %*% solve(diag(s_w))
return(list(
W = W,
x_bar_w = x_bar_w,
S_w = S_w,
s_w = s_w,
R_w = R_w
))
}
# --- [b] Aplikasikan fungsi pada data ---
# Panggil fungsi
hasil <- weighted_corr(X, w)
# Tampilkan vektor mean tertimbang
hasil$x_bar_w
## [,1]
## x1 73.88530
## x2 65.39059
## x3 17.00938
# Tampilkan matriks varians-kovarians tertimbang
hasil$S_w
## x1 x2 x3
## x1 38.16362 -37.75105 -27.15386
## x2 -37.75105 41.10767 29.16587
## x3 -27.15386 29.16587 21.14757
# Tampilkan vektor standar deviasi tertimbang
hasil$s_w
## x1 x2 x3
## 6.177671 6.411527 4.598649
# Tampilkan matriks korelasi tertimbang
hasil$R_w
## [,1] [,2] [,3]
## [1,] 1.0000000 -0.9531095 -0.9558207
## [2,] -0.9531095 1.0000000 0.9891979
## [3,] -0.9558207 0.9891979 1.0000000
# Visualisasi Data
library(reshape2)
result <- weighted_corr(X,w)
corr_mat <- result$R_w
melted_corrmat <- melt(corr_mat)
ggplot(melted_corrmat, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
geom_text(aes(label = round(value,2))) +
labs(
title = "Correlation Heatmap",
x = "Variabel",
y = "Variabel",
fill = "Korelasi"
) +
theme_minimal()
# Berdasarkan correlation heatmap, terlihat bahwa terdapat
# hubungan yang kuat antar variabel.
# Nilai korelasi sebesar 0.99 menunjukkan hubungan positif yang sangat kuat,
# sedangkan nilai sekitar -0.95 menunjukkan hubungan negatif yang kuat.
# Hal ini menunjukkan bahwa beberapa variabel memiliki hubungan linear
# yang signifikan.
# Karena menggunakan weighted correlation, hasil ini juga mempertimbangkan
# bobot masing-masing observasi sehingga lebih representatif.