A. Quiz Answer

Question 1

A researcher gathered monthly household expenditure data from 12 participants. They aimed to calculate both the ordinary mean and the 10% trimmed mean of the dataset.

a) Create an R function trimmed_mean(x, alpha) that calculates the trimmed mean of a dataset.

#1. Defines a new function called trimmed_mean
trimmed_mean <- function(x, alpha = 0.1) {

#2. Compute n, k, and sort the data
  n <- length(x)
  k <- floor(n * alpha)
  sorted_x <- sort(x)
  
#3. Removes the first k values (lowest) and the last k values (highest)
  trimmed_x <- sorted_x [(k+1) : (n-k)]
  
#4. Calculates the mean of the remaining values
  mean(trimmed_x)
}

b) Determine the trimmed_mean for the collected data.

# Collected Data
x <- c(850, 920, 1100, 1250, 1300, 1400, 1500, 1550, 1600, 1750, 2100, 8500)
# Ordinary mean (alpha = 0)
trimmed_mean(x, 0)

When we run trimmed_mean(x, 0), the function applies no trimming, so it simply returns the ordinary mean. The line sum(x) / length(x) does the same calculation manually by adding all the values and dividing by the number of observations.

# 10% Trimmed mean (alpha = 0.10)
sum(x) / length(x)

Running trimmed_mean(x, 0.10) trims 10% from each end of the data. With 12 values, that means removing one smallest (850) and one largest (8500). The mean of the remaining 10 values is then calculated, which reduces the effect of the outlier and gives a more representative average.

Question 2

The Surabaya City Government surveyed 31 districts, recording average monthly income, monthly expenditure, and household size. Each district was weighted by its population size, so larger districts have more influence on the results. The goal is to calculate the weighted mean vector, the weighted covariance matrix, and the weighted standard deviation vector, then apply these calculations to the dataset and show the results.

a) Load the data.

#1 loads the dataset from the CSV file.

#2 takes the three variables (income, expenditure, household size) and stores them as a numeric matrix.
data <- read.csv("data_quiz.csv")
X <- as.matrix(data[, c("Income", "Expenditure", "HH_Size")])

#3 extracts the population weights for each district and stores them as a vector.
w <- data$Weight

b) Apply the function to calculate weighted statistics from the data.

result <- weighted_multi_desc(X, w)

# Display the weighted mean vector with
result$mean



# Display the weighted covariance matrix with
result$cov



# Display weighted standard deviation vector
result$sd

B. Data Visualization

Question 1

a) Histogram

By examining the histogram, we can see that most expenditure values cluster between 850 and 2100, whereas the value of 8500 lies far outside this range, marking it as an outlier.

# Define the data first
x <- c(850, 920, 1100, 1250, 1300, 1400, 1500, 1550, 1600, 1750, 2100, 8500)

# Then plot the histogram
hist(x,
     breaks = 15,   # number of bins
     col = "pink",
     border = "white",
     main = "Histogram of Expenditure",
     xlab = "Expenditure",
     freq = TRUE
)

b) Boxplot

A boxplot is particularly useful here because it highlights 8500 as a clear outlier.

boxplot(x,
        col = "pink",
        border = "red",
        main = "Boxplot of Expenditure",
        ylab = "Expenditure"
)

Question 2

a) Scatter Plot

Scatter plot visualization reveals a positive correlation between income and expenditure, showing that districts with higher income generally report higher expenditure.

# Income vs Expenditure
plot(data$Income, data$Expenditure,
     col = "blue",
     pch = 19,
     main = "Scatter Plot: Income vs Expenditure",
     xlab = "Income",
     ylab = "Expenditure")
Error in data$Income : $ operator is invalid for atomic vectors

b) Bubble Lines

The bubble plot incorporates population weights, illustrating that certain districts have a greater impact on the overall statistics. Larger bubbles correspond to districts with larger populations, emphasizing the importance of weighted statistics over simple averages.

    col = "pink",
     pch = 21,
     bg = "red",
     cex = w / max(w) * 3,   # scale bubble size by weight
     main = "Bubble Plot: Income vs Expenditure (Weighted)",
     xlab = "Income",
     ylab = "Expenditure")
LS0tDQp0aXRsZTogIioqRGF0YSBWaXN1YWxpemF0aW9uIGFuZCBBbnN3ZXJzIG9mIFF1aXogMSoqIg0KYXV0aG9yOiAiUmFmZXlmYSBBbHlhIE11a2hiaXRhIC0gNTAwMzI1MTAwMSINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCiMgQS4gUXVpeiBBbnN3ZXINCiMjIyAqKlF1ZXN0aW9uIDEqKg0KQSByZXNlYXJjaGVyIGdhdGhlcmVkIG1vbnRobHkgaG91c2Vob2xkIGV4cGVuZGl0dXJlIGRhdGEgZnJvbSAxMiBwYXJ0aWNpcGFudHMuIFRoZXkgYWltZWQgdG8gY2FsY3VsYXRlIGJvdGggdGhlIG9yZGluYXJ5IG1lYW4gYW5kIHRoZSAxMCUgdHJpbW1lZCBtZWFuIG9mIHRoZSBkYXRhc2V0Lg0KDQojIyMjIGEpIENyZWF0ZSBhbiBSIGZ1bmN0aW9uIHRyaW1tZWRfbWVhbih4LCBhbHBoYSkgdGhhdCBjYWxjdWxhdGVzIHRoZSB0cmltbWVkIG1lYW4gb2YgYSBkYXRhc2V0Lg0KYGBge3J9DQojMS4gRGVmaW5lcyBhIG5ldyBmdW5jdGlvbiBjYWxsZWQgdHJpbW1lZF9tZWFuDQp0cmltbWVkX21lYW4gPC0gZnVuY3Rpb24oeCwgYWxwaGEgPSAwLjEpIHsNCg0KIzIuIENvbXB1dGUgbiwgaywgYW5kIHNvcnQgdGhlIGRhdGENCiAgbiA8LSBsZW5ndGgoeCkNCiAgayA8LSBmbG9vcihuICogYWxwaGEpDQogIHNvcnRlZF94IDwtIHNvcnQoeCkNCiAgDQojMy4gUmVtb3ZlcyB0aGUgZmlyc3QgayB2YWx1ZXMgKGxvd2VzdCkgYW5kIHRoZSBsYXN0IGsgdmFsdWVzIChoaWdoZXN0KQ0KICB0cmltbWVkX3ggPC0gc29ydGVkX3ggWyhrKzEpIDogKG4tayldDQogIA0KIzQuIENhbGN1bGF0ZXMgdGhlIG1lYW4gb2YgdGhlIHJlbWFpbmluZyB2YWx1ZXMNCiAgbWVhbih0cmltbWVkX3gpDQp9DQpgYGANCg0KIyMjIyBiKSBEZXRlcm1pbmUgdGhlIHRyaW1tZWRfbWVhbiBmb3IgdGhlIGNvbGxlY3RlZCBkYXRhLg0KYGBge3J9DQojIENvbGxlY3RlZCBEYXRhDQp4IDwtIGMoODUwLCA5MjAsIDExMDAsIDEyNTAsIDEzMDAsIDE0MDAsIDE1MDAsIDE1NTAsIDE2MDAsIDE3NTAsIDIxMDAsIDg1MDApDQpgYGANCmBgYHtyfQ0KIyBPcmRpbmFyeSBtZWFuIChhbHBoYSA9IDApDQp0cmltbWVkX21lYW4oeCwgMCkNCmBgYA0KV2hlbiB3ZSBydW4gdHJpbW1lZF9tZWFuKHgsIDApLCB0aGUgZnVuY3Rpb24gYXBwbGllcyBubyB0cmltbWluZywgc28gaXQgc2ltcGx5IHJldHVybnMgdGhlIG9yZGluYXJ5IG1lYW4uIFRoZSBsaW5lIHN1bSh4KSAvIGxlbmd0aCh4KSBkb2VzIHRoZSBzYW1lIGNhbGN1bGF0aW9uIG1hbnVhbGx5IGJ5IGFkZGluZyBhbGwgdGhlIHZhbHVlcyBhbmQgZGl2aWRpbmcgYnkgdGhlIG51bWJlciBvZiBvYnNlcnZhdGlvbnMuDQpgYGB7cn0NCiMgMTAlIFRyaW1tZWQgbWVhbiAoYWxwaGEgPSAwLjEwKQ0Kc3VtKHgpIC8gbGVuZ3RoKHgpDQpgYGANClJ1bm5pbmcgdHJpbW1lZF9tZWFuKHgsIDAuMTApIHRyaW1zIDEwJSBmcm9tIGVhY2ggZW5kIG9mIHRoZSBkYXRhLiBXaXRoIDEyIHZhbHVlcywgdGhhdCBtZWFucyByZW1vdmluZyBvbmUgc21hbGxlc3QgKDg1MCkgYW5kIG9uZSBsYXJnZXN0ICg4NTAwKS4gVGhlIG1lYW4gb2YgdGhlIHJlbWFpbmluZyAxMCB2YWx1ZXMgaXMgdGhlbiBjYWxjdWxhdGVkLCB3aGljaCByZWR1Y2VzIHRoZSBlZmZlY3Qgb2YgdGhlIG91dGxpZXIgYW5kIGdpdmVzIGEgbW9yZSByZXByZXNlbnRhdGl2ZSBhdmVyYWdlLg0KDQojIyMgKipRdWVzdGlvbiAyKioNClRoZSBTdXJhYmF5YSBDaXR5IEdvdmVybm1lbnQgc3VydmV5ZWQgMzEgZGlzdHJpY3RzLCByZWNvcmRpbmcgYXZlcmFnZSBtb250aGx5IGluY29tZSwgbW9udGhseSBleHBlbmRpdHVyZSwgYW5kIGhvdXNlaG9sZCBzaXplLiBFYWNoIGRpc3RyaWN0IHdhcyB3ZWlnaHRlZCBieSBpdHMgcG9wdWxhdGlvbiBzaXplLCBzbyBsYXJnZXIgZGlzdHJpY3RzIGhhdmUgbW9yZSBpbmZsdWVuY2Ugb24gdGhlIHJlc3VsdHMuIFRoZSBnb2FsIGlzIHRvIGNhbGN1bGF0ZSB0aGUgd2VpZ2h0ZWQgbWVhbiB2ZWN0b3IsIHRoZSB3ZWlnaHRlZCBjb3ZhcmlhbmNlIG1hdHJpeCwgYW5kIHRoZSB3ZWlnaHRlZCBzdGFuZGFyZCBkZXZpYXRpb24gdmVjdG9yLCB0aGVuIGFwcGx5IHRoZXNlIGNhbGN1bGF0aW9ucyB0byB0aGUgZGF0YXNldCBhbmQgc2hvdyB0aGUgcmVzdWx0cy4NCg0KIyMjIyBhKSBMb2FkIHRoZSBkYXRhLg0KYGBge3J9DQojMSBsb2FkcyB0aGUgZGF0YXNldCBmcm9tIHRoZSBDU1YgZmlsZS4NCg0KIzIgdGFrZXMgdGhlIHRocmVlIHZhcmlhYmxlcyAoaW5jb21lLCBleHBlbmRpdHVyZSwgaG91c2Vob2xkIHNpemUpIGFuZCBzdG9yZXMgdGhlbSBhcyBhIG51bWVyaWMgbWF0cml4Lg0KZGF0YSA8LSByZWFkLmNzdigiZGF0YV9xdWl6LmNzdiIpDQpYIDwtIGFzLm1hdHJpeChkYXRhWywgYygiSW5jb21lIiwgIkV4cGVuZGl0dXJlIiwgIkhIX1NpemUiKV0pDQoNCiMzIGV4dHJhY3RzIHRoZSBwb3B1bGF0aW9uIHdlaWdodHMgZm9yIGVhY2ggZGlzdHJpY3QgYW5kIHN0b3JlcyB0aGVtIGFzIGEgdmVjdG9yLg0KdyA8LSBkYXRhJFdlaWdodA0KYGBgDQoNCiMjIyMgYikgQXBwbHkgdGhlIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSB3ZWlnaHRlZCBzdGF0aXN0aWNzIGZyb20gdGhlIGRhdGEuDQpgYGB7cn0NCnJlc3VsdCA8LSB3ZWlnaHRlZF9tdWx0aV9kZXNjKFgsIHcpDQoNCiMgRGlzcGxheSB0aGUgd2VpZ2h0ZWQgbWVhbiB2ZWN0b3Igd2l0aA0KcmVzdWx0JG1lYW4NCg0KDQoNCiMgRGlzcGxheSB0aGUgd2VpZ2h0ZWQgY292YXJpYW5jZSBtYXRyaXggd2l0aA0KcmVzdWx0JGNvdg0KDQoNCg0KIyBEaXNwbGF5IHdlaWdodGVkIHN0YW5kYXJkIGRldmlhdGlvbiB2ZWN0b3INCnJlc3VsdCRzZA0KYGBgDQoNCiMgQi4gRGF0YSBWaXN1YWxpemF0aW9uDQoNCiMjIyAqKlF1ZXN0aW9uIDEqKg0KIyMjIyBhKSBIaXN0b2dyYW0NCkJ5IGV4YW1pbmluZyB0aGUgaGlzdG9ncmFtLCB3ZSBjYW4gc2VlIHRoYXQgbW9zdCBleHBlbmRpdHVyZSB2YWx1ZXMgY2x1c3RlciBiZXR3ZWVuIDg1MCBhbmQgMjEwMCwgd2hlcmVhcyB0aGUgdmFsdWUgb2YgODUwMCBsaWVzIGZhciBvdXRzaWRlIHRoaXMgcmFuZ2UsIG1hcmtpbmcgaXQgYXMgYW4gb3V0bGllci4NCmBgYHtyfQ0KIyBEZWZpbmUgdGhlIGRhdGEgZmlyc3QNCnggPC0gYyg4NTAsIDkyMCwgMTEwMCwgMTI1MCwgMTMwMCwgMTQwMCwgMTUwMCwgMTU1MCwgMTYwMCwgMTc1MCwgMjEwMCwgODUwMCkNCg0KIyBUaGVuIHBsb3QgdGhlIGhpc3RvZ3JhbQ0KaGlzdCh4LA0KICAgICBicmVha3MgPSAxNSwgICAjIG51bWJlciBvZiBiaW5zDQogICAgIGNvbCA9ICJwaW5rIiwNCiAgICAgYm9yZGVyID0gIndoaXRlIiwNCiAgICAgbWFpbiA9ICJIaXN0b2dyYW0gb2YgRXhwZW5kaXR1cmUiLA0KICAgICB4bGFiID0gIkV4cGVuZGl0dXJlIiwNCiAgICAgZnJlcSA9IFRSVUUNCikNCmBgYA0KIyMjIGIpIEJveHBsb3QNCkEgYm94cGxvdCBpcyBwYXJ0aWN1bGFybHkgdXNlZnVsIGhlcmUgYmVjYXVzZSBpdCBoaWdobGlnaHRzIDg1MDAgYXMgYSBjbGVhciBvdXRsaWVyLg0KYGBge3J9DQpib3hwbG90KHgsDQogICAgICAgIGNvbCA9ICJwaW5rIiwNCiAgICAgICAgYm9yZGVyID0gInJlZCIsDQogICAgICAgIG1haW4gPSAiQm94cGxvdCBvZiBFeHBlbmRpdHVyZSIsDQogICAgICAgIHlsYWIgPSAiRXhwZW5kaXR1cmUiDQopDQpgYGANCg0KDQojIyMgKipRdWVzdGlvbiAyKioNCiMjIyMgYSkgU2NhdHRlciBQbG90DQpTY2F0dGVyIHBsb3QgdmlzdWFsaXphdGlvbiByZXZlYWxzIGEgcG9zaXRpdmUgY29ycmVsYXRpb24gYmV0d2VlbiBpbmNvbWUgYW5kIGV4cGVuZGl0dXJlLCBzaG93aW5nIHRoYXQgZGlzdHJpY3RzIHdpdGggaGlnaGVyIGluY29tZSBnZW5lcmFsbHkgcmVwb3J0IGhpZ2hlciBleHBlbmRpdHVyZS4NCmBgYHtyfQ0KIyBJbmNvbWUgdnMgRXhwZW5kaXR1cmUNCnBsb3QoZGF0YSRJbmNvbWUsIGRhdGEkRXhwZW5kaXR1cmUsDQogICAgIGNvbCA9ICJzdGVlbGJsdWUiLA0KICAgICBwY2ggPSAxOSwNCiAgICAgbWFpbiA9ICJTY2F0dGVyIFBsb3Q6IEluY29tZSB2cyBFeHBlbmRpdHVyZSIsDQogICAgIHhsYWIgPSAiSW5jb21lIiwNCiAgICAgeWxhYiA9ICJFeHBlbmRpdHVyZSIpDQoNCiMgSG91c2Vob2xkIFNpemUgdnMgRXhwZW5kaXR1cmUNCnBsb3QoZGF0YSRISF9TaXplLCBkYXRhJEV4cGVuZGl0dXJlLA0KICAgICBjb2wgPSAicGluayIsDQogICAgIHBjaCA9IDE5LA0KICAgICBtYWluID0gIlNjYXR0ZXIgUGxvdDogSG91c2Vob2xkIFNpemUgdnMgRXhwZW5kaXR1cmUiLA0KICAgICB4bGFiID0gIkhvdXNlaG9sZCBTaXplIiwNCiAgICAgeWxhYiA9ICJFeHBlbmRpdHVyZSIpDQoNCiMgSW5jb21lIHZzIEhvdXNlaG9sZCBTaXplDQpwbG90KGRhdGEkSW5jb21lLCBkYXRhJEhIX1NpemUsDQogICAgIGNvbCA9ICJkYXJrcmVkIiwNCiAgICAgcGNoID0gMTksDQogICAgIG1haW4gPSAiU2NhdHRlciBQbG90OiBJbmNvbWUgdnMgSG91c2Vob2xkIFNpemUiLA0KICAgICB4bGFiID0gIkluY29tZSIsDQogICAgIHlsYWIgPSAiSG91c2Vob2xkIFNpemUiKQ0KDQojIHBvcHVsYXRpb24gd2VpZ2h0DQpwbG90KGRhdGEkSW5jb21lLCBkYXRhJEV4cGVuZGl0dXJlLA0KICAgICBjb2wgPSAibGlnaHRibHVlIiwNCiAgICAgcGNoID0gMTksDQogICAgIGNleCA9IHcgLyBtYXgodykgKiAyLCAgICMgc2NhbGUgcG9pbnQgc2l6ZSBieSB3ZWlnaHQNCiAgICAgbWFpbiA9ICJXZWlnaHRlZCBTY2F0dGVyIFBsb3Q6IEluY29tZSB2cyBFeHBlbmRpdHVyZSIsDQogICAgIHhsYWIgPSAiSW5jb21lIiwNCiAgICAgeWxhYiA9ICJFeHBlbmRpdHVyZSIpDQpgYGANCg0KIyMjIyBiKSBCdWJibGUgTGluZXMNClRoZSBidWJibGUgcGxvdCBpbmNvcnBvcmF0ZXMgcG9wdWxhdGlvbiB3ZWlnaHRzLCBpbGx1c3RyYXRpbmcgdGhhdCBjZXJ0YWluIGRpc3RyaWN0cyBoYXZlIGEgZ3JlYXRlciBpbXBhY3Qgb24gdGhlIG92ZXJhbGwgc3RhdGlzdGljcy4gTGFyZ2VyIGJ1YmJsZXMgY29ycmVzcG9uZCB0byBkaXN0cmljdHMgd2l0aCBsYXJnZXIgcG9wdWxhdGlvbnMsIGVtcGhhc2l6aW5nIHRoZSBpbXBvcnRhbmNlIG9mIHdlaWdodGVkIHN0YXRpc3RpY3Mgb3ZlciBzaW1wbGUgYXZlcmFnZXMuDQpgYGB7cn0NCiAgICBjb2wgPSAicGluayIsDQogICAgIHBjaCA9IDIxLA0KICAgICBiZyA9ICJyZWQiLA0KICAgICBjZXggPSB3IC8gbWF4KHcpICogMywgICAjIHNjYWxlIGJ1YmJsZSBzaXplIGJ5IHdlaWdodA0KICAgICBtYWluID0gIkJ1YmJsZSBQbG90OiBJbmNvbWUgdnMgRXhwZW5kaXR1cmUgKFdlaWdodGVkKSIsDQogICAgIHhsYWIgPSAiSW5jb21lIiwNCiAgICAgeWxhYiA9ICJFeHBlbmRpdHVyZSIpDQpgYGANCg0KDQoNCg0KDQo=