R Notebook

# --- Baca data CSV ---
df <- read.csv("C:/Users/SHELLA YUASTARI/Downloads/Quiz 1 Komstat/data_quiz1.csv")

# Ambil variabel
X <- as.matrix(df[, c("x1", "x2", "x3")])
w <- df$w

# --- [a] Fungsi weighted correlation ---

weighted_corr <- function(X, w) {
  
  X <- as.matrix(X)
  n <- nrow(X)
  
  # Matriks bobot
  W <- diag(w)
  
  # Vektor satuan
  one_n <- matrix(1, nrow = n, ncol = 1)
  
  # Total bobot
  nw <- as.numeric(t(one_n) %*% w)
  
  # Mean tertimbang
  x_bar_w <- (1 / nw) * t(X) %*% W %*% one_n
  
  # Deviasi
  D <- X - (one_n %*% t(x_bar_w))
  
  # Matriks kovarians tertimbang
  S_w <- (1 / nw) * t(D) %*% W %*% D
  
  # Standar deviasi tertimbang
  s_w <- sqrt(diag(S_w))
  
  # Matriks korelasi tertimbang
  V_inv <- diag(1 / s_w)
  R_w <- V_inv %*% S_w %*% V_inv
  
  return(list(
    W = W,
    mean_w = x_bar_w,
    S_w = S_w,
    s_w = s_w,
    R_w = R_w
  ))
}

# --- [b] Aplikasikan fungsi pada data ---

hasil <- weighted_corr(X, w)

# --- Tampilkan hasil ---

cat("Matriks Bobot (W):\n")

Matriks Bobot (W):


print(hasil$W)

       [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9] [,10]
 [1,] 14.34  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [2,]  0.00 14.19  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [3,]  0.00  0.00 12.49  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [4,]  0.00  0.00  0.00 11.45  0.00  0.00  0.00  0.00  0.00  0.00
 [5,]  0.00  0.00  0.00  0.00 17.45  0.00  0.00  0.00  0.00  0.00
 [6,]  0.00  0.00  0.00  0.00  0.00 15.24  0.00  0.00  0.00  0.00
 [7,]  0.00  0.00  0.00  0.00  0.00  0.00 34.73  0.00  0.00  0.00
 [8,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00 17.97  0.00  0.00
 [9,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00 33.13  0.00
[10,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00 35.93
[11,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[12,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[13,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[14,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[15,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[16,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[17,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[18,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[19,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[20,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[21,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[22,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[23,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[24,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[25,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[26,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
      [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20]
 [1,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [2,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [3,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [4,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [5,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [6,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [7,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [8,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [9,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[10,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[11,] 15.55  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[12,]  0.00 16.54  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[13,]  0.00  0.00 17.25  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[14,]  0.00  0.00  0.00 14.93  0.00  0.00   0.0  0.00  0.00  0.00
[15,]  0.00  0.00  0.00  0.00  7.24  0.00   0.0  0.00  0.00  0.00
[16,]  0.00  0.00  0.00  0.00  0.00  9.85   0.0  0.00  0.00  0.00
[17,]  0.00  0.00  0.00  0.00  0.00  0.00  11.1  0.00  0.00  0.00
[18,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0 12.89  0.00  0.00
[19,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00 11.14  0.00
[20,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  7.06
[21,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[22,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[23,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[24,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[25,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[26,]  0.00  0.00  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
      [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30]
 [1,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [2,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [3,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [4,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [5,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [6,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [7,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [8,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
 [9,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[10,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[11,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[12,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[13,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[14,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[15,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[16,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[17,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[18,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[19,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[20,]  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[21,] 13.96  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[22,]  0.00 23.13  0.00  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[23,]  0.00  0.00 19.74  0.00  0.00  0.00  0.00  0.00  0.00  0.00
[24,]  0.00  0.00  0.00 17.53  0.00  0.00  0.00  0.00  0.00  0.00
[25,]  0.00  0.00  0.00  0.00 12.56  0.00  0.00  0.00  0.00  0.00
[26,]  0.00  0.00  0.00  0.00  0.00 13.01  0.00  0.00  0.00  0.00
      [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38]
 [1,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [2,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [3,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [4,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [5,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [6,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [7,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [8,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [9,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[10,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[11,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[12,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[13,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[14,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[15,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[16,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[17,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[18,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[19,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[20,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[21,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[22,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[23,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[24,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[25,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
[26,]  0.00  0.00  0.00  0.00   0.0  0.00  0.00  0.00
 [ reached 'max' / getOption("max.print") -- omitted 12 rows ]

cat("\nMean tertimbang:\n")


Mean tertimbang:

cat("\nMatriks Varians-Kovarians tertimbang (S_w):\n")


Matriks Varians-Kovarians tertimbang (S_w):

print(hasil$mean_w)

       [,1]
x1 73.88530
x2 65.39059
x3 17.00938

cat("\nStandar Deviasi tertimbang:\n")


Standar Deviasi tertimbang:

print(hasil$s_w)

      x1       x2       x3 
6.177671 6.411527 4.598649

cat("\nMatriks Korelasi tertimbang (R_w):\n")


Matriks Korelasi tertimbang (R_w):

print(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

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoNCmBgYHtyfQ0KIyAtLS0gQmFjYSBkYXRhIENTViAtLS0NCmRmIDwtIHJlYWQuY3N2KCJDOi9Vc2Vycy9TSEVMTEEgWVVBU1RBUkkvRG93bmxvYWRzL1F1aXogMSBLb21zdGF0L2RhdGFfcXVpejEuY3N2IikNCg0KIyBBbWJpbCB2YXJpYWJlbA0KWCA8LSBhcy5tYXRyaXgoZGZbLCBjKCJ4MSIsICJ4MiIsICJ4MyIpXSkNCncgPC0gZGYkdw0KDQojIC0tLSBbYV0gRnVuZ3NpIHdlaWdodGVkIGNvcnJlbGF0aW9uIC0tLQ0KDQp3ZWlnaHRlZF9jb3JyIDwtIGZ1bmN0aW9uKFgsIHcpIHsNCiAgDQogIFggPC0gYXMubWF0cml4KFgpDQogIG4gPC0gbnJvdyhYKQ0KICANCiAgIyBNYXRyaWtzIGJvYm90DQogIFcgPC0gZGlhZyh3KQ0KICANCiAgIyBWZWt0b3Igc2F0dWFuDQogIG9uZV9uIDwtIG1hdHJpeCgxLCBucm93ID0gbiwgbmNvbCA9IDEpDQogIA0KICAjIFRvdGFsIGJvYm90DQogIG53IDwtIGFzLm51bWVyaWModChvbmVfbikgJSolIHcpDQogIA0KICAjIE1lYW4gdGVydGltYmFuZw0KICB4X2Jhcl93IDwtICgxIC8gbncpICogdChYKSAlKiUgVyAlKiUgb25lX24NCiAgDQogICMgRGV2aWFzaQ0KICBEIDwtIFggLSAob25lX24gJSolIHQoeF9iYXJfdykpDQogIA0KICAjIE1hdHJpa3Mga292YXJpYW5zIHRlcnRpbWJhbmcNCiAgU193IDwtICgxIC8gbncpICogdChEKSAlKiUgVyAlKiUgRA0KICANCiAgIyBTdGFuZGFyIGRldmlhc2kgdGVydGltYmFuZw0KICBzX3cgPC0gc3FydChkaWFnKFNfdykpDQogIA0KICAjIE1hdHJpa3Mga29yZWxhc2kgdGVydGltYmFuZw0KICBWX2ludiA8LSBkaWFnKDEgLyBzX3cpDQogIFJfdyA8LSBWX2ludiAlKiUgU193ICUqJSBWX2ludg0KICANCiAgcmV0dXJuKGxpc3QoDQogICAgVyA9IFcsDQogICAgbWVhbl93ID0geF9iYXJfdywNCiAgICBTX3cgPSBTX3csDQogICAgc193ID0gc193LA0KICAgIFJfdyA9IFJfdw0KICApKQ0KfQ0KDQojIC0tLSBbYl0gQXBsaWthc2lrYW4gZnVuZ3NpIHBhZGEgZGF0YSAtLS0NCg0KaGFzaWwgPC0gd2VpZ2h0ZWRfY29ycihYLCB3KQ0KDQojIC0tLSBUYW1waWxrYW4gaGFzaWwgLS0tDQoNCmNhdCgiTWF0cmlrcyBCb2JvdCAoVyk6XG4iKQ0KDQpwcmludChoYXNpbCRXKQ0KDQpjYXQoIlxuTWVhbiB0ZXJ0aW1iYW5nOlxuIikNCg0KY2F0KCJcbk1hdHJpa3MgVmFyaWFucy1Lb3ZhcmlhbnMgdGVydGltYmFuZyAoU193KTpcbiIpDQoNCnByaW50KGhhc2lsJG1lYW5fdykNCg0KY2F0KCJcblN0YW5kYXIgRGV2aWFzaSB0ZXJ0aW1iYW5nOlxuIikNCg0KcHJpbnQoaGFzaWwkc193KQ0KDQpjYXQoIlxuTWF0cmlrcyBLb3JlbGFzaSB0ZXJ0aW1iYW5nIChSX3cpOlxuIikNCg0KcHJpbnQoaGFzaWwkUl93KQ0KDQpgYGANCg0KQWRkIGEgbmV3IGNodW5rIGJ5IGNsaWNraW5nIHRoZSAqSW5zZXJ0IENodW5rKiBidXR0b24gb24gdGhlIHRvb2xiYXIgb3IgYnkgcHJlc3NpbmcgKkN0cmwrQWx0K0kqLg0KDQpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4NCg0KVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLg0K