Identitas

Nama : Ismanda Felisa Clearance Abdullah
NRP : 5003251116
Kelas : D

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=