Soal 1 – Winsorized Mean
x <- c(12,45,52,58,61,63,67,70,72,75,78,82,88,95,310)
winsorized_mean <- function(x, alpha){
n <- length(x)
k <- floor(n*alpha)
sortx <- sort(x)
y <- sort(x)
if(k > 0){
y[1:k] <- sortx[k+1]
y[(n-k+1):n] <- sortx[n-k]
}
ones <- rep(1,n)
w_mean <- (1/n) * as.numeric(t(y) %*% ones)
return(w_mean)
}
mean_o <- winsorized_mean(x,0)
mean_o
[1] 81.86667
winsor_20 <- winsorized_mean(x,0.2)
winsor_20
[1] 69.73333
library(ggplot2)
ggplot(df1, aes(x = x)) +
geom_density(fill = "lightpink", alpha = 0.5) +
geom_vline(aes(xintercept = mean_o, color = "Mean"), size = 1) +
geom_vline(aes(xintercept = winsor_20, color = "Winsor"), size = 1) +
theme_minimal()

Interpretasi Density Plot
Density plot menunjukkan bahwa distribusi data terdapat pada rentang
60–80 dan memiliki ekor panjang ke kanan akibat adanya outlier. Ordinary
Mean (merah) garisnya lebih ke kanan, sedangkan winsorized mean (biru)
lebih ke tengah. Artinya, Mean terpengaruh outlier sedangkan Winsorized
mean lebih mewakili pusat data.
library(ggplot2)
ggplot(df1, aes(y = x)) +
geom_boxplot(fill = "lightpink") +
theme_minimal()

Interpretasi Box Plot
Boxplot menunjukkan bahwa data sebagian besar berada di sekitar 60–80
dengan median di tengah. Terdapat outlier, terutama nilai 310 yang jauh
dari data lainnya, sehingga distribusi menjadi condong ke kanan dan
mempengaruhi nilai rata-rata.
Soal 2
df <- read.csv("C:/Users/Ismanda/Downloads/Quiz 1 Komstat/data_quiz1.csv")
X <- as.matrix(df[,c("x1","x2","x3")])
w <- df$w
weighted_corr <- function(X,w){
n <- nrow(X)
p <- ncol(X)
W <- diag(w)
n_w <- 0
for(i in 1:length(w)){
n_w <- n_w + w[i]
}
x_bar_w <- matrix(0,1,p)
for(j in 1:p){
total <- 0
for(i in 1:n){
total <- total + w[i]*X[i,j]
}
x_bar_w[1,j] <- total/n_w
}
D <- matrix(0,n,p)
for(i in 1:n){
for(j in 1:p){
D[i,j] <- X[i,j] - x_bar_w[1,j]
}
}
S_w <- (1/n_w)*t(D)%*%W%*%D
s_w <- sqrt(diag(S_w))
V <- diag(s_w)
R_w <- solve(V)%*%S_w%*%solve(V)
return(list(
W=W,
x_bar_w=x_bar_w,
S_w=S_w,
s_w=s_w,
R_w=R_w
))
}
hasil <- weighted_corr(X,w)
hasil$x_bar_w
[,1] [,2] [,3]
[1,] 73.8853 65.39059 17.00938
hasil$S_w
[,1] [,2] [,3]
[1,] 38.16362 -37.75105 -27.15386
[2,] -37.75105 41.10767 29.16587
[3,] -27.15386 29.16587 21.14757
hasil$s_w
[1] 6.177671 6.411527 4.598649
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
library(ggplot2)
ggplot(df, aes(x = x1, y = x2)) +
geom_point(aes(size = w), color = "blue", alpha = 0.7) +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Hubungan x1 dan x2 dengan Regression Line",
x = "Kualitas Udara (x1)",
y = "Kualitas Air (x2)",
size = "Bobot (w)") +
theme_minimal()

Interpretasi Scatter Plot
Scatter plot menunjukkan bahwa terdapat hubungan negatif antara
kualitas udara (x1) dan kualitas air (x2). Hal ini terlihat dari garis
regresi yang menurun, yang berarti semakin tinggi nilai x1, maka nilai
x2 cenderung menurun. Titik-titik data juga cukup mengikuti arah garis
regresi, sehingga menunjukkan bahwa hubungan antar variabel tergolong
cukup kuat. Selain itu, ukuran titik yang merepresentasikan bobot
wilayah (w) menunjukkan bahwa beberapa daerah dengan bobot besar juga
mengikuti pola yang sama.
Dapat disimpulkan bahwa terdapat hubungan negatif antara kualitas
udara dan kualitas air, di mana peningkatan salah satu variabel
cenderung diikuti penurunan variabel lainnya. Meskipun secara teoritis
diharapkan hubungan antara kualitas udara dan kualitas air bersifat
positif, hasil visualisasi menunjukkan hubungan negatif.
library(GGally)
ggpairs(df[,c("x1","x2","x3")],
title = "Pair Plot Variabel Lingkungan")

Interpretasi Pair Plot
Pair plot menunjukkan bahwa masing-masing variabel memiliki
distribusi yang cukup terpusat, dengan sebagian besar nilai berada di
sekitar nilai tengahnya. Hubungan antara x1 dan x2 terlihat negatif
(−0.969), yang berarti ketika nilai x1 meningkat, nilai x2 cenderung
menurun. Hal yang sama juga terjadi pada hubungan antara x1 dan x3
dengan korelasi −0.975, menunjukkan hubungan negatif. Sebaliknya, x2 dan
x3 memiliki hubungan positif (0.991), yang berarti kedua variabel
tersebut cenderung meningkat secara bersamaan. Secara keseluruhan, dapat
disimpulkan bahwa x1 bergerak berlawanan arah dengan x2 dan x3,
sedangkan x2 dan x3 bergerak searah.
LS0tDQp0aXRsZTogIlF1aXogMSBLb21wdXRhc2kgU3RhdGlzdGlrYSINCmF1dGhvcjogIklzbWFuZGEgRmVsaXNhIENsZWFyYW5jZSBBYmR1bGxhaCINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICBkZl9wcmludDogcGFnZWQNCiAgcGRmX2RvY3VtZW50OiBkZWZhdWx0DQogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQNCi0tLQ0KDQojIElkZW50aXRhcw0KDQpOYW1hIDogSXNtYW5kYSBGZWxpc2EgQ2xlYXJhbmNlIEFiZHVsbGFoICANCk5SUCA6IDUwMDMyNTExMTYgIA0KS2VsYXMgOiBEICANCg0KIyBTb2FsIDEg4oCTIFdpbnNvcml6ZWQgTWVhbg0KDQpgYGB7cn0NCnggPC0gYygxMiw0NSw1Miw1OCw2MSw2Myw2Nyw3MCw3Miw3NSw3OCw4Miw4OCw5NSwzMTApDQpgYGANCg0KYGBge3J9DQp3aW5zb3JpemVkX21lYW4gPC0gZnVuY3Rpb24oeCwgYWxwaGEpew0KICANCiAgbiA8LSBsZW5ndGgoeCkNCiAgayA8LSBmbG9vcihuKmFscGhhKQ0KICANCiAgc29ydHggPC0gc29ydCh4KQ0KICB5IDwtIHNvcnQoeCkNCiAgDQogIGlmKGsgPiAwKXsNCiAgICB5WzE6a10gPC0gc29ydHhbaysxXQ0KICAgIHlbKG4taysxKTpuXSA8LSBzb3J0eFtuLWtdDQogIH0NCiAgDQogIG9uZXMgPC0gcmVwKDEsbikNCiAgd19tZWFuIDwtICgxL24pICogYXMubnVtZXJpYyh0KHkpICUqJSBvbmVzKQ0KICANCiAgcmV0dXJuKHdfbWVhbikNCn0NCmBgYA0KDQpgYGB7cn0NCm1lYW5fbyA8LSB3aW5zb3JpemVkX21lYW4oeCwwKQ0KbWVhbl9vDQpgYGANCg0KYGBge3J9DQp3aW5zb3JfMjAgPC0gd2luc29yaXplZF9tZWFuKHgsMC4yKQ0Kd2luc29yXzIwDQpgYGANCg0KDQoNCg0KYGBge3J9DQpsaWJyYXJ5KGdncGxvdDIpDQoNCmdncGxvdChkZjEsIGFlcyh4ID0geCkpICsNCiAgZ2VvbV9kZW5zaXR5KGZpbGwgPSAibGlnaHRwaW5rIiwgYWxwaGEgPSAwLjUpICsNCiAgZ2VvbV92bGluZShhZXMoeGludGVyY2VwdCA9IG1lYW5fbywgY29sb3IgPSAiTWVhbiIpLCBzaXplID0gMSkgKw0KICBnZW9tX3ZsaW5lKGFlcyh4aW50ZXJjZXB0ID0gd2luc29yXzIwLCBjb2xvciA9ICJXaW5zb3IiKSwgc2l6ZSA9IDEpICsNCiAgdGhlbWVfbWluaW1hbCgpDQoNCmBgYA0KIyMgSW50ZXJwcmV0YXNpIERlbnNpdHkgUGxvdA0KDQpEZW5zaXR5IHBsb3QgbWVudW5qdWtrYW4gYmFod2EgZGlzdHJpYnVzaSBkYXRhIHRlcmRhcGF0IHBhZGEgcmVudGFuZyA2MOKAkzgwIGRhbiBtZW1pbGlraSBla29yIHBhbmphbmcga2Uga2FuYW4gYWtpYmF0IGFkYW55YSBvdXRsaWVyLiANCk9yZGluYXJ5IE1lYW4gKG1lcmFoKSBnYXJpc255YSBsZWJpaCBrZSBrYW5hbiwgc2VkYW5na2FuIHdpbnNvcml6ZWQgbWVhbiAoYmlydSkgbGViaWgga2UgdGVuZ2FoLiBBcnRpbnlhLCBNZWFuIHRlcnBlbmdhcnVoIG91dGxpZXIgc2VkYW5na2FuIFdpbnNvcml6ZWQgbWVhbiBsZWJpaCBtZXdha2lsaSBwdXNhdCBkYXRhLg0KDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCg0KZ2dwbG90KGRmMSwgYWVzKHkgPSB4KSkgKw0KICBnZW9tX2JveHBsb3QoZmlsbCA9ICJsaWdodHBpbmsiKSArDQogIHRoZW1lX21pbmltYWwoKQ0KYGBgICANCiMjIEludGVycHJldGFzaSBCb3ggUGxvdA0KDQpCb3hwbG90IG1lbnVuanVra2FuIGJhaHdhIGRhdGEgc2ViYWdpYW4gYmVzYXIgYmVyYWRhIGRpIHNla2l0YXIgNjDigJM4MCBkZW5nYW4gbWVkaWFuIGRpIHRlbmdhaC4gVGVyZGFwYXQgb3V0bGllciwgdGVydXRhbWEgbmlsYWkgMzEwIHlhbmcgamF1aCBkYXJpIGRhdGEgbGFpbm55YSwgc2VoaW5nZ2EgZGlzdHJpYnVzaSBtZW5qYWRpIGNvbmRvbmcga2Uga2FuYW4gZGFuIG1lbXBlbmdhcnVoaSBuaWxhaSByYXRhLXJhdGEuDQoNCg0KLS0tDQoNCiMgU29hbCAyDQoNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6L1VzZXJzL0lzbWFuZGEvRG93bmxvYWRzL1F1aXogMSBLb21zdGF0L2RhdGFfcXVpejEuY3N2IikNCg0KWCA8LSBhcy5tYXRyaXgoZGZbLGMoIngxIiwieDIiLCJ4MyIpXSkNCncgPC0gZGYkdw0KYGBgDQoNCmBgYHtyfQ0Kd2VpZ2h0ZWRfY29yciA8LSBmdW5jdGlvbihYLHcpew0KICANCiAgbiA8LSBucm93KFgpDQogIHAgPC0gbmNvbChYKQ0KICANCiAgVyA8LSBkaWFnKHcpDQogIA0KICBuX3cgPC0gMA0KICBmb3IoaSBpbiAxOmxlbmd0aCh3KSl7DQogICAgbl93IDwtIG5fdyArIHdbaV0NCiAgfQ0KICANCiAgeF9iYXJfdyA8LSBtYXRyaXgoMCwxLHApDQogIA0KICBmb3IoaiBpbiAxOnApew0KICAgIA0KICAgIHRvdGFsIDwtIDANCiAgICANCiAgICBmb3IoaSBpbiAxOm4pew0KICAgICAgdG90YWwgPC0gdG90YWwgKyB3W2ldKlhbaSxqXQ0KICAgIH0NCiAgICANCiAgICB4X2Jhcl93WzEsal0gPC0gdG90YWwvbl93DQogIH0NCiAgDQogIEQgPC0gbWF0cml4KDAsbixwKQ0KICANCiAgZm9yKGkgaW4gMTpuKXsNCiAgICBmb3IoaiBpbiAxOnApew0KICAgICAgRFtpLGpdIDwtIFhbaSxqXSAtIHhfYmFyX3dbMSxqXQ0KICAgIH0NCiAgfQ0KICANCiAgU193IDwtICgxL25fdykqdChEKSUqJVclKiVEDQogIA0KICBzX3cgPC0gc3FydChkaWFnKFNfdykpDQogIA0KICBWIDwtIGRpYWcoc193KQ0KICANCiAgUl93IDwtIHNvbHZlKFYpJSolU193JSolc29sdmUoVikNCiAgDQogIHJldHVybihsaXN0KA0KICAgIFc9VywNCiAgICB4X2Jhcl93PXhfYmFyX3csDQogICAgU193PVNfdywNCiAgICBzX3c9c193LA0KICAgIFJfdz1SX3cNCiAgKSkNCn0NCmBgYA0KDQpgYGB7cn0NCmhhc2lsIDwtIHdlaWdodGVkX2NvcnIoWCx3KQ0KDQpoYXNpbCR4X2Jhcl93DQpoYXNpbCRTX3cNCmhhc2lsJHNfdw0KaGFzaWwkUl93DQpgYGANCg0KDQoNCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQpnZ3Bsb3QoZGYsIGFlcyh4ID0geDEsIHkgPSB4MikpICsNCiAgZ2VvbV9wb2ludChhZXMoc2l6ZSA9IHcpLCBjb2xvciA9ICJibHVlIiwgYWxwaGEgPSAwLjcpICsNCiAgZ2VvbV9zbW9vdGgobWV0aG9kID0gImxtIiwgc2UgPSBGQUxTRSwgY29sb3IgPSAicmVkIikgKw0KICBsYWJzKHRpdGxlID0gIkh1YnVuZ2FuIHgxIGRhbiB4MiBkZW5nYW4gUmVncmVzc2lvbiBMaW5lIiwNCiAgICAgICB4ID0gIkt1YWxpdGFzIFVkYXJhICh4MSkiLA0KICAgICAgIHkgPSAiS3VhbGl0YXMgQWlyICh4MikiLA0KICAgICAgIHNpemUgPSAiQm9ib3QgKHcpIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCmBgYA0KIyMgSW50ZXJwcmV0YXNpIFNjYXR0ZXIgUGxvdA0KDQpTY2F0dGVyIHBsb3QgbWVudW5qdWtrYW4gYmFod2EgdGVyZGFwYXQgaHVidW5nYW4gbmVnYXRpZiAgYW50YXJhIGt1YWxpdGFzIHVkYXJhICh4MSkgZGFuIGt1YWxpdGFzIGFpciAoeDIpLiBIYWwgaW5pIHRlcmxpaGF0IGRhcmkgZ2FyaXMgcmVncmVzaSB5YW5nIG1lbnVydW4sIHlhbmcgYmVyYXJ0aSBzZW1ha2luIHRpbmdnaSBuaWxhaSB4MSwgbWFrYSBuaWxhaSB4MiBjZW5kZXJ1bmcgbWVudXJ1bi4gVGl0aWstdGl0aWsgZGF0YSBqdWdhIGN1a3VwIG1lbmdpa3V0aSBhcmFoIGdhcmlzIHJlZ3Jlc2ksIHNlaGluZ2dhIG1lbnVuanVra2FuIGJhaHdhIGh1YnVuZ2FuIGFudGFyIHZhcmlhYmVsIHRlcmdvbG9uZyBjdWt1cCBrdWF0LiBTZWxhaW4gaXR1LCB1a3VyYW4gdGl0aWsgeWFuZyBtZXJlcHJlc2VudGFzaWthbiBib2JvdCB3aWxheWFoICh3KSBtZW51bmp1a2thbiBiYWh3YSBiZWJlcmFwYSBkYWVyYWggZGVuZ2FuIGJvYm90IGJlc2FyIGp1Z2EgbWVuZ2lrdXRpIHBvbGEgeWFuZyBzYW1hLg0KDQpEYXBhdCBkaXNpbXB1bGthbiBiYWh3YSB0ZXJkYXBhdCBodWJ1bmdhbiBuZWdhdGlmIGFudGFyYSBrdWFsaXRhcyB1ZGFyYSBkYW4ga3VhbGl0YXMgYWlyLCBkaSBtYW5hIHBlbmluZ2thdGFuIHNhbGFoIHNhdHUgdmFyaWFiZWwgY2VuZGVydW5nIGRpaWt1dGkgcGVudXJ1bmFuIHZhcmlhYmVsIGxhaW5ueWEuIE1lc2tpcHVuIHNlY2FyYSB0ZW9yaXRpcyBkaWhhcmFwa2FuIGh1YnVuZ2FuIGFudGFyYSBrdWFsaXRhcyB1ZGFyYSBkYW4ga3VhbGl0YXMgYWlyIGJlcnNpZmF0IHBvc2l0aWYsIGhhc2lsIHZpc3VhbGlzYXNpIG1lbnVuanVra2FuIGh1YnVuZ2FuIG5lZ2F0aWYuDQoNCmBgYHtyfQ0KbGlicmFyeShHR2FsbHkpDQoNCmdncGFpcnMoZGZbLGMoIngxIiwieDIiLCJ4MyIpXSwNCiAgICAgICAgdGl0bGUgPSAiUGFpciBQbG90IFZhcmlhYmVsIExpbmdrdW5nYW4iKQ0KYGBgDQojIyBJbnRlcnByZXRhc2kgUGFpciBQbG90DQoNClBhaXIgcGxvdCBtZW51bmp1a2thbiBiYWh3YSBtYXNpbmctbWFzaW5nIHZhcmlhYmVsIG1lbWlsaWtpIGRpc3RyaWJ1c2kgeWFuZyBjdWt1cCB0ZXJwdXNhdCwgZGVuZ2FuIHNlYmFnaWFuIGJlc2FyIG5pbGFpIGJlcmFkYSBkaSBzZWtpdGFyIG5pbGFpIHRlbmdhaG55YS4gSHVidW5nYW4gYW50YXJhIHgxIGRhbiB4MiB0ZXJsaWhhdCAgbmVnYXRpZiAo4oiSMC45NjkpLCB5YW5nIGJlcmFydGkga2V0aWthIG5pbGFpIHgxIG1lbmluZ2thdCwgbmlsYWkgeDIgY2VuZGVydW5nIG1lbnVydW4uIEhhbCB5YW5nIHNhbWEganVnYSB0ZXJqYWRpIHBhZGEgaHVidW5nYW4gYW50YXJhIHgxIGRhbiB4MyBkZW5nYW4ga29yZWxhc2kg4oiSMC45NzUsIG1lbnVuanVra2FuIGh1YnVuZ2FuIG5lZ2F0aWYuIFNlYmFsaWtueWEsIHgyIGRhbiB4MyBtZW1pbGlraSBodWJ1bmdhbiBwb3NpdGlmICAoMC45OTEpLCB5YW5nIGJlcmFydGkga2VkdWEgdmFyaWFiZWwgdGVyc2VidXQgY2VuZGVydW5nIG1lbmluZ2thdCBzZWNhcmEgYmVyc2FtYWFuLiBTZWNhcmEga2VzZWx1cnVoYW4sIGRhcGF0IGRpc2ltcHVsa2FuIGJhaHdhIHgxIGJlcmdlcmFrIGJlcmxhd2FuYW4gYXJhaCBkZW5nYW4geDIgZGFuIHgzLCBzZWRhbmdrYW4geDIgZGFuIHgzIGJlcmdlcmFrIHNlYXJhaC4=