Nomor 1
x <- as.numeric(x)
x <- c(12, 45, 52, 58, 61, 63, 67, 70, 72, 75, 78, 82, 88, 95, 310)
winsorized_mean <- function(x, alpha) {
x_sort <- sort(x)
n <- length(x)
k <- floor(n * alpha)
if (k >0){
x_sort[1:k] <- x_sort[k+1]
x_sort[(n-k + 1):n] <- x_sort[n-k]
}
tot <- 0
for (i in 1:n){
tot <- tot + x_sort[i]
}
mean_w <- tot/n
return(mean_w)
}
hasil_nol <- winsorized_mean(x,0)
hasil_nol
hasil_noldua <- winsorized_mean(x,0.2)
hasil_noldua

#Interpretasi:
#Berdasarkan grafik boxplot di atas, terlihat bahwa sebaran data output produksi harian dari 15 mesin memiliki sebaran yang tidak simetris dan memiliki outlier yang sangat kontras.
#Terdapat satu titik di bagian atas yang nilainya jauh melampaui kelompok data lainnya yaitu nilai 310, serta satu titik di bagian bawah yaitu nilai 12. Keberadaan outlier ini, terutama nilai 310 yang dicurigai akibat kerusakan mesin, akan menarik nilai ordinary mean menjadi tidak sesuai dengan keadaan sebenarnya.

#Interpretasi:
#Pada Boxplot pertama menunjukkan sebaran data asli yang memiliki pencilan ekstrem di angka 310. Keberadaan pencilan ini menyebabkan nilai Ordinary Mean menjadi tidak sesuai dengan keadaan sebenarnya karena nilainya terdistorsi (tertarik ke atas) oleh satu data yang rusak tersebut.

#Pada boxplot ke duaa, Setelah dilakukan Winsorizing sebesar 20%, data ekstrem (310 dan 12) telah digantikan dengan nilai non-ekstrem terdekat. Hasilnya, boxplot kedua menunjukkan sebaran data yang lebih rapat dan stabil tanpa gangguan outlier. Nilai Winsorized Mean yang dihasilkan jauh lebih rendah daripada rata-rata biasa, yang membuktikan bahwa metode ini lebih tahan dalam mencerminkan pusat data produksi yang sebenarnya
Nomor 2
df <- read.csv("C:/Users/Kikan Ayla/Downloads/data_quiz1.csv")
df
X <- as.matrix(df[, c("x1", "x2", "x3")])
w <- df$w
weighted_corr <- function(X, w) {
X <- as.matrix(X)
n <- nrow(X)
p <- ncol(X)
W_matriks <- diag(w)
n_w <- 0
for (i in 1:length(w)) { n_w <- n_w + w[i] }
satu_vektor <- matrix(1, nrow = n, ncol = 1)
x_bar_w <- (1/n_w) * (t(X) %*% W_matriks %*% satu_vektor)
D <- X - (satu_vektor %*% t(x_bar_w))
S_w <- (1/n_w) * t(D) %*% W_matriks %*% D
s_w <- rep(0, p)
for (j in 1:p) { s_w[j] <- sqrt(S_w[j, j]) }
V_inv <- diag(1 / s_w)
R_w <- V_inv %*% S_w %*% V_inv
return(list(
W_Matrix = W_matriks,
Mean_W = x_bar_w,
Cov_W = S_w,
SD_W = s_w,
Corr_W = R_w
))
}
hasil <- weighted_corr(X,w)
print(hasil$Mean_W)
[,1]
x1 73.88530
x2 65.39059
x3 17.00938
print(hasil$Cov_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
print(hasil$SD_W)
[1] 6.177671 6.411527 4.598649
print(hasil$Corr_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

#Interpretasi
#Berdasarkan heatmap korelasi yang sudah dibuat, dapat terlihat hubungN linear yang sangat kuat antar tiga variabel kualitas lingkungan di Jawa Timur. Mulai dari yang pertama, hubungan positif sangat kuat ($0.99$) yang terjadi antara Indeks Kualitas Air (x2) dan Rasio RTH (x3). Hal ini mengindikasikan bahwa kabupaten/kota dengan proporsi Ruang Terbuka Hijau yang luas cenderung memiliki kualitas air yang jauh lebih baik. Kemudian kedua, ada hubunga negatif yang sangat kuat, dapat terlihat di kotak warna merah ada dua. Hal itu mengartikan bahwa daerah dengan indeks kualitas air atau RTH yang tinggi justru memiliki angka indeks kualitas udara yang rendah pada dataset ini.
LS0tDQp0aXRsZTogIjUwMDMyNTExODIga3VpcyBBdXJlbGx5YUthbmlhQXp6YWhyYSINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQpOb21vciAxDQpgYGB7cn0NCnggPC0gYXMubnVtZXJpYyh4KQ0KeCA8LSBjKDEyLCA0NSwgNTIsIDU4LCA2MSwgNjMsIDY3LCA3MCwgNzIsIDc1LCA3OCwgODIsIDg4LCA5NSwgMzEwKQ0KYGBgDQoNCmBgYHtyfQ0Kd2luc29yaXplZF9tZWFuIDwtIGZ1bmN0aW9uKHgsIGFscGhhKSB7DQogIHhfc29ydCA8LSBzb3J0KHgpDQogIG4gPC0gbGVuZ3RoKHgpDQogIGsgPC0gZmxvb3IobiAqIGFscGhhKQ0KICANCiAgaWYgKGsgPjApew0KICAgIHhfc29ydFsxOmtdIDwtIHhfc29ydFtrKzFdDQogICAgDQogICAgeF9zb3J0WyhuLWsgKyAxKTpuXSA8LSB4X3NvcnRbbi1rXQ0KICB9DQogIHRvdCA8LSAwDQogIGZvciAoaSBpbiAxOm4pew0KICAgIHRvdCA8LSB0b3QgKyB4X3NvcnRbaV0NCiAgfQ0KICBtZWFuX3cgPC0gdG90L24NCiAgcmV0dXJuKG1lYW5fdykNCn0NCmBgYA0KDQpgYGB7cn0NCmhhc2lsX25vbCA8LSB3aW5zb3JpemVkX21lYW4oeCwwKQ0KaGFzaWxfbm9sDQpgYGANCg0KYGBge3J9DQpoYXNpbF9ub2xkdWEgPC0gd2luc29yaXplZF9tZWFuKHgsMC4yKQ0KaGFzaWxfbm9sZHVhDQpgYGANCg0KYGBge3J9DQpib3hwbG90KHgpDQpgYGANCmBgYHtyfQ0KI0ludGVycHJldGFzaToNCiNCZXJkYXNhcmthbiBncmFmaWsgYm94cGxvdCBkaSBhdGFzLCB0ZXJsaWhhdCBiYWh3YSBzZWJhcmFuIGRhdGEgb3V0cHV0IHByb2R1a3NpIGhhcmlhbiBkYXJpIDE1IG1lc2luIG1lbWlsaWtpIHNlYmFyYW4geWFuZyB0aWRhayBzaW1ldHJpcyBkYW4gbWVtaWxpa2kgb3V0bGllciB5YW5nIHNhbmdhdCBrb250cmFzLg0KDQojVGVyZGFwYXQgc2F0dSB0aXRpayBkaSBiYWdpYW4gYXRhcyB5YW5nIG5pbGFpbnlhIGphdWggbWVsYW1wYXVpIGtlbG9tcG9rIGRhdGEgbGFpbm55YSB5YWl0dSBuaWxhaSAzMTAsIHNlcnRhIHNhdHUgdGl0aWsgZGkgYmFnaWFuIGJhd2FoIHlhaXR1IG5pbGFpIDEyLiBLZWJlcmFkYWFuIG91dGxpZXIgaW5pLCB0ZXJ1dGFtYSBuaWxhaSAzMTAgeWFuZyBkaWN1cmlnYWkgYWtpYmF0IGtlcnVzYWthbiBtZXNpbiwgYWthbiBtZW5hcmlrIG5pbGFpIG9yZGluYXJ5IG1lYW4gbWVuamFkaSB0aWRhayBzZXN1YWkgZGVuZ2FuIGtlYWRhYW4gc2ViZW5hcm55YS4NCmBgYA0KDQpgYGB7cn0NCmJveHBsb3QoaGFzaWxfbm9sKQ0KYGBgDQpgYGB7cn0NCiNJbnRlcnByZXRhc2k6DQojUGFkYSBCb3hwbG90IHBlcnRhbWEgbWVudW5qdWtrYW4gc2ViYXJhbiBkYXRhIGFzbGkgeWFuZyBtZW1pbGlraSBwZW5jaWxhbiBla3N0cmVtIGRpIGFuZ2thIDMxMC4gS2ViZXJhZGFhbiBwZW5jaWxhbiBpbmkgbWVueWViYWJrYW4gbmlsYWkgT3JkaW5hcnkgTWVhbiBtZW5qYWRpIHRpZGFrIHNlc3VhaSBkZW5nYW4ga2VhZGFhbiBzZWJlbmFybnlhIGthcmVuYSBuaWxhaW55YSB0ZXJkaXN0b3JzaSAodGVydGFyaWsga2UgYXRhcykgb2xlaCBzYXR1IGRhdGEgeWFuZyBydXNhayB0ZXJzZWJ1dC4NCmBgYA0KDQpgYGB7cn0NCmJveHBsb3QoaGFzaWxfbm9sZHVhKQ0KYGBgDQpgYGB7cn0NCiNQYWRhIGJveHBsb3Qga2UgZHVhYSwgU2V0ZWxhaCBkaWxha3VrYW4gV2luc29yaXppbmcgc2ViZXNhciAyMCUsIGRhdGEgZWtzdHJlbSAoMzEwIGRhbiAxMikgdGVsYWggZGlnYW50aWthbiBkZW5nYW4gbmlsYWkgbm9uLWVrc3RyZW0gdGVyZGVrYXQuIEhhc2lsbnlhLCBib3hwbG90IGtlZHVhIG1lbnVuanVra2FuIHNlYmFyYW4gZGF0YSB5YW5nIGxlYmloIHJhcGF0IGRhbiBzdGFiaWwgdGFucGEgZ2FuZ2d1YW4gb3V0bGllci4gTmlsYWkgV2luc29yaXplZCBNZWFuIHlhbmcgZGloYXNpbGthbiBqYXVoIGxlYmloIHJlbmRhaCBkYXJpcGFkYSByYXRhLXJhdGEgYmlhc2EsIHlhbmcgbWVtYnVrdGlrYW4gYmFod2EgbWV0b2RlIGluaSBsZWJpaCB0YWhhbiBkYWxhbSBtZW5jZXJtaW5rYW4gcHVzYXQgZGF0YSBwcm9kdWtzaSB5YW5nIHNlYmVuYXJueWENCmBgYA0KDQpOb21vciAyDQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJDOi9Vc2Vycy9LaWthbiBBeWxhL0Rvd25sb2Fkcy9kYXRhX3F1aXoxLmNzdiIpDQpkZg0KWCA8LSBhcy5tYXRyaXgoZGZbLCBjKCJ4MSIsICJ4MiIsICJ4MyIpXSkNCncgPC0gZGYkdw0KYGBgDQoNCmBgYHtyfQ0Kd2VpZ2h0ZWRfY29yciA8LSBmdW5jdGlvbihYLCB3KSB7DQogIFggPC0gYXMubWF0cml4KFgpDQogIG4gPC0gbnJvdyhYKSANCiAgcCA8LSBuY29sKFgpDQogIA0KICBXX21hdHJpa3MgPC0gZGlhZyh3KQ0KICANCiAgDQogIG5fdyA8LSAwDQogIGZvciAoaSBpbiAxOmxlbmd0aCh3KSkgeyBuX3cgPC0gbl93ICsgd1tpXSB9DQogIA0KICANCiAgc2F0dV92ZWt0b3IgPC0gbWF0cml4KDEsIG5yb3cgPSBuLCBuY29sID0gMSkNCiAgDQogIHhfYmFyX3cgPC0gKDEvbl93KSAqICh0KFgpICUqJSBXX21hdHJpa3MgJSolIHNhdHVfdmVrdG9yKQ0KICANCiAgRCA8LSBYIC0gKHNhdHVfdmVrdG9yICUqJSB0KHhfYmFyX3cpKQ0KICANCiAgU193IDwtICgxL25fdykgKiB0KEQpICUqJSBXX21hdHJpa3MgJSolIEQNCiAgDQogIHNfdyA8LSByZXAoMCwgcCkNCiAgZm9yIChqIGluIDE6cCkgeyBzX3dbal0gPC0gc3FydChTX3dbaiwgal0pIH0NCiAgDQogIFZfaW52IDwtIGRpYWcoMSAvIHNfdykNCiAgUl93IDwtIFZfaW52ICUqJSBTX3cgJSolIFZfaW52DQogIA0KICByZXR1cm4obGlzdCgNCiAgICBXX01hdHJpeCA9IFdfbWF0cmlrcywNCiAgICBNZWFuX1cgPSB4X2Jhcl93LA0KICAgIENvdl9XID0gU193LA0KICAgIFNEX1cgPSBzX3csDQogICAgQ29ycl9XID0gUl93DQogICkpDQp9DQpgYGANCg0KYGBge3J9DQpoYXNpbCA8LSB3ZWlnaHRlZF9jb3JyKFgsdykNCmBgYA0KDQpgYGB7cn0NCnByaW50KGhhc2lsJE1lYW5fVykNCmBgYA0KDQpgYGB7cn0NCnByaW50KGhhc2lsJENvdl9XKQ0KYGBgDQoNCmBgYHtyfQ0KcHJpbnQoaGFzaWwkU0RfVykNCmBgYA0KDQpgYGB7cn0NCnByaW50KGhhc2lsJENvcnJfVykNCmBgYA0KYGBge3J9DQppbnN0YWxsLnBhY2thZ2VzKCJjb3JycGxvdCIpDQpsaWJyYXJ5KGNvcnJwbG90KQ0KUncgPC0gKGhhc2lsJENvcnJfVykNCmNvbG5hbWVzKFJ3KSA8LSByb3duYW1lcyhSdykgPC0gYygiVWRhcmEgKHgxKSIsICJBaXIgKHgyKSIsICJSVEggKHgzKSIpDQoNCmNvcnJwbG90KFJ3LCANCiAgICAgICAgIG1ldGhvZCA9ICJjb2xvciIsIA0KICAgICAgICAgdHlwZSA9ICJ1cHBlciIsIA0KICAgICAgICAgYWRkQ29lZi5jb2wgPSAiYmxhY2siLA0KICAgICAgICAgdGl0bGUgPSAiVmlzdWFsaXNhc2kgTWF0cmlrcyBLb3JlbGFzaSBUZXJpbWJhbmciLA0KICAgICAgICAgbWFyID0gYygwLDAsMiwwKSkNCmBgYA0KYGBge3J9DQojSW50ZXJwcmV0YXNpDQojQmVyZGFzYXJrYW4gaGVhdG1hcCBrb3JlbGFzaSB5YW5nIHN1ZGFoIGRpYnVhdCwgZGFwYXQgdGVybGloYXQgaHVidW5nTiBsaW5lYXIgeWFuZyBzYW5nYXQga3VhdCBhbnRhciB0aWdhIHZhcmlhYmVsIGt1YWxpdGFzIGxpbmdrdW5nYW4gZGkgSmF3YSBUaW11ci4gTXVsYWkgZGFyaSB5YW5nIHBlcnRhbWEsIGh1YnVuZ2FuIHBvc2l0aWYgc2FuZ2F0IGt1YXQgKCQwLjk5JCkgeWFuZyB0ZXJqYWRpIGFudGFyYSBJbmRla3MgS3VhbGl0YXMgQWlyICh4MikgZGFuIFJhc2lvIFJUSCAoeDMpLiBIYWwgaW5pIG1lbmdpbmRpa2FzaWthbiBiYWh3YSBrYWJ1cGF0ZW4va290YSBkZW5nYW4gcHJvcG9yc2kgUnVhbmcgVGVyYnVrYSBIaWphdSB5YW5nIGx1YXMgY2VuZGVydW5nIG1lbWlsaWtpIGt1YWxpdGFzIGFpciB5YW5nIGphdWggbGViaWggYmFpay4gS2VtdWRpYW4ga2VkdWEsIGFkYSBodWJ1bmdhIG5lZ2F0aWYgeWFuZyBzYW5nYXQga3VhdCwgZGFwYXQgdGVybGloYXQgZGkga290YWsgd2FybmEgbWVyYWggYWRhIGR1YS4gSGFsIGl0dSBtZW5nYXJ0aWthbiBiYWh3YSBkYWVyYWggZGVuZ2FuIGluZGVrcyBrdWFsaXRhcyBhaXIgYXRhdSBSVEggeWFuZyB0aW5nZ2kganVzdHJ1IG1lbWlsaWtpIGFuZ2thIGluZGVrcyBrdWFsaXRhcyB1ZGFyYSB5YW5nIHJlbmRhaCBwYWRhIGRhdGFzZXQgaW5pLiANCmBgYA0K