Soal 1. Distribusi Sampling Rata-rata (20 poin)

1a. Populasi, ringkasan statistik, dan histogram

set.seed(2025)
pop <- data.frame(
  exam_score = round(rnorm(5000, mean = 72, sd = 10)),
  pass       = rbinom(5000, 1, 0.7)
)

# 6 baris pertama
head(pop)
# Ringkasan statistik exam_score
ringkasan <- data.frame(
  mean = mean(pop$exam_score),
  sd   = sd(pop$exam_score),
  min  = min(pop$exam_score),
  maks = max(pop$exam_score)
)
round(ringkasan, 3)
# Histogram
hist(pop$exam_score, breaks = 30, col = "steelblue", border = "white",
     main = "Histogram Nilai Ujian (Populasi, N = 5000)",
     xlab = "exam_score")
abline(v = mean(pop$exam_score), col = "red", lwd = 2)

Interpretasi. Populasi memiliki rata-rata 71.82 dan simpangan baku 10.1 dengan rentang 40 sampai 111. Histogram berbentuk lonceng dan simetris di sekitar rata-rata, sesuai dengan data yang dibangkitkan dari \(N(72, 10^2)\).

1b. Distribusi sampling rata-rata untuk n = 30

set.seed(123)
n <- 30
rata_sampel <- replicate(1000, mean(sample(pop$exam_score, size = n, replace = TRUE)))

# sd populasi (rumus populasi) dan standard error teoretis
sd_pop <- sqrt(mean((pop$exam_score - mean(pop$exam_score))^2))
se_teoretis <- sd_pop / sqrt(n)
se_empiris  <- sd(rata_sampel)

hist(rata_sampel, breaks = 30, col = "orange", border = "white",
     main = "Distribusi Sampling Rata-rata (n = 30, 1000 sampel)",
     xlab = "Rata-rata sampel", freq = FALSE)
curve(dnorm(x, mean(pop$exam_score), se_teoretis), add = TRUE,
      col = "blue", lwd = 2)

data.frame(
  mean_rata_sampel = mean(rata_sampel),
  sd_empiris       = se_empiris,
  SE_teoretis      = se_teoretis,
  selisih          = abs(se_empiris - se_teoretis)
)

Interpretasi. Rata-rata dari 1.000 rata-rata sampel (71.833) sangat dekat dengan rata-rata populasi (71.819). Simpangan baku empiris sebesar 1.8498 hampir sama dengan standard error teoretis \(\sigma/\sqrt{n}\) = 1.8439, sehingga hasil simulasi sesuai dengan teori. Kurva biru (normal teoretis) menempel baik pada histogram.

1c. Pengaruh ukuran sampel (n = 5, 30, 100)

ukuran <- c(5, 30, 100)
hasil <- list()
par(mfrow = c(1, 3))
for (n in ukuran) {
  set.seed(123)
  m <- replicate(1000, mean(sample(pop$exam_score, size = n, replace = TRUE)))
  hasil[[as.character(n)]] <- m
  hist(m, breaks = 30, col = "seagreen", border = "white",
       main = paste("n =", n), xlab = "Rata-rata sampel",
       xlim = c(60, 84))
}

par(mfrow = c(1, 1))

tabel <- data.frame(
  n           = ukuran,
  mean_empiris = sapply(hasil, mean),
  sd_empiris   = sapply(hasil, sd),
  SE_teoretis  = sd_pop / sqrt(ukuran)
)
rownames(tabel) <- NULL
round(tabel, 4)

Interpretasi. Semua distribusi sampling berpusat di sekitar rata-rata populasi (tidak bias) pada setiap ukuran sampel. Semakin besar \(n\), sebaran rata-rata sampel semakin sempit: simpangan baku turun dari 4.52 (n = 5) menjadi 1.85 (n = 30) dan 1.02 (n = 100), mengikuti \(\sigma/\sqrt{n}\). Bentuk distribusi juga makin mendekati normal dan makin runcing di sekitar rata-rata. Karena populasi sudah mendekati normal, bentuknya sudah cukup normal bahkan pada n kecil; untuk populasi non-normal, efek ini sesuai dengan Teorema Limit Pusat.

Soal 2. Uji Normalitas Data Tunggal dan Dua Variabel (20 poin)

penjualan <- c(45, 52, 47, 50, 49, 53, 54, 48, 51, 50,
               55, 46, 49, 47, 52, 50, 48, 53, 54, 49)

berat <- c(55, 60, 62, 58, 64, 70, 68, 72, 59, 61,
           63, 65, 66, 67, 71, 69, 60, 58, 62, 64,
           73, 75, 77, 68, 70, 72, 74, 69, 63, 65)

tinggi <- c(160, 162, 164, 158, 166, 172, 170, 175, 161, 163,
            165, 167, 169, 171, 173, 174, 160, 159, 164, 166,
            176, 178, 180, 172, 174, 176, 177, 171, 165, 167)

2a. Data penjualan

par(mfrow = c(1, 2))
hist(penjualan, breaks = 8, col = "skyblue", border = "white",
     main = "Histogram Penjualan", xlab = "Penjualan")
qqnorm(penjualan, main = "Q-Q Plot Penjualan", pch = 19)
qqline(penjualan, col = "red", lwd = 2)

par(mfrow = c(1, 1))

# Shapiro-Wilk
sw <- shapiro.test(penjualan)
sw
## 
##  Shapiro-Wilk normality test
## 
## data:  penjualan
## W = 0.96996, p-value = 0.754
# Kolmogorov-Smirnov pada data terstandarisasi
z <- as.numeric(scale(penjualan))
ks <- suppressWarnings(ks.test(z, "pnorm", mean = 0, sd = 1))
ks
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  z
## D = 0.11402, p-value = 0.9573
## alternative hypothesis: two-sided

Hipotesis (kedua uji):

  • \(H_0\): data penjualan berdistribusi normal
  • \(H_1\): data penjualan tidak berdistribusi normal
  • Taraf signifikansi \(\alpha = 0{,}05\)
Uji Statistik p-value Keputusan
Shapiro-Wilk W = 0.97 0,754 H0 gagal ditolak
Kolmogorov-Smirnov D = 0.114 0,9573 H0 gagal ditolak

Kesimpulan. Kedua uji memberikan p-value lebih besar dari 0,05 sehingga H0 gagal ditolak: data penjualan dapat dianggap berdistribusi normal pada taraf signifikansi 5%. Hal ini konsisten dengan Q-Q plot yang titiknya mengikuti garis lurus. (Catatan: uji K-S dengan data terstandarisasi memakai mean dan sd dari sampel sehingga cenderung konservatif, dan terdapat nilai kembar sehingga p-value bersifat aproksimasi.)

2b. Normalitas berat dan tinggi dengan sapply()

data_bt <- list(berat = berat, tinggi = tinggi)

# Uji Shapiro-Wilk sekaligus
hasil_sw <- sapply(data_bt, function(x) {
  u <- shapiro.test(x)
  c(W = unname(u$statistic), p_value = u$p.value)
})
round(t(hasil_sw), 4)
##             W p_value
## berat  0.9826  0.8889
## tinggi 0.9648  0.4071
# Uji Kolmogorov-Smirnov (data terstandarisasi) sekaligus
hasil_ks <- sapply(data_bt, function(x) {
  u <- suppressWarnings(ks.test(as.numeric(scale(x)), "pnorm"))
  c(D = unname(u$statistic), p_value = u$p.value)
})
round(t(hasil_ks), 4)
##             D p_value
## berat  0.0716  0.9979
## tinggi 0.0951  0.9488
# Q-Q plot keduanya
par(mfrow = c(1, 2))
for (nm in names(data_bt)) {
  qqnorm(data_bt[[nm]], main = paste("Q-Q Plot", nm), pch = 19)
  qqline(data_bt[[nm]], col = "red", lwd = 2)
}

par(mfrow = c(1, 1))

Hipotesis: \(H_0\): variabel berdistribusi normal; \(H_1\): variabel tidak berdistribusi normal (\(\alpha = 0{,}05\)).

Kesimpulan. Pada uji Shapiro-Wilk, berat memiliki p-value 0,8889 (H0 gagal ditolak) dan tinggi memiliki p-value 0,4071 (H0 gagal ditolak).

2c. Variabel yang lebih mendekati normal

skew <- function(x) mean((x - mean(x))^3) / (mean((x - mean(x))^2))^1.5
perbandingan <- data.frame(
  variabel = names(data_bt),
  W        = hasil_sw["W", ],
  p_value  = hasil_sw["p_value", ],
  skewness = sapply(data_bt, skew)
)
rownames(perbandingan) <- NULL
perbandingan$W <- round(perbandingan$W, 4)
perbandingan$p_value <- round(perbandingan$p_value, 4)
perbandingan$skewness <- round(perbandingan$skewness, 3)
perbandingan
lebih_normal <- names(which.max(hasil_sw["W", ]))

Jawaban. Variabel yang lebih mendekati distribusi normal adalah berat, karena nilai statistik W Shapiro-Wilk-nya lebih besar (mendekati 1), p-value-nya lebih besar, dan titik-titik pada Q-Q plot-nya lebih rapat mengikuti garis referensi. Semakin besar W dan p-value serta semakin kecil kemiringan (skewness), semakin kecil penyimpangan data dari distribusi normal.

Soal 3. Uji Kesamaan Rata-rata Data Berpasangan (30 poin)

bp <- data.frame(
  id = 1:30,
  before = c(140,150,135,142,128,155,138,147,131,144,
             129,152,141,137,148,133,149,136,130,145,
             139,143,134,151,127,146,132,140,138,135),
  after  = c(132,145,130,138,125,148,135,140,128,136,
             125,146,135,132,142,130,144,133,127,140,
             134,138,130,145,124,139,128,137,134,131)
)

3a. Selisih dan statistik deskriptif

bp$selisih <- bp$before - bp$after
head(bp)
deskriptif <- data.frame(
  variabel = c("before", "after", "selisih"),
  rata_rata = c(mean(bp$before), mean(bp$after), mean(bp$selisih)),
  simpangan_baku = c(sd(bp$before), sd(bp$after), sd(bp$selisih))
)
deskriptif[, 2:3] <- round(deskriptif[, 2:3], 3)
deskriptif

3b. Boxplot dan histogram selisih

par(mfrow = c(1, 2))
boxplot(bp$before, bp$after, names = c("Before", "After"),
        col = c("tomato", "lightgreen"),
        main = "Tekanan Darah Sistolik", ylab = "mmHg")
hist(bp$selisih, breaks = 10, col = "plum", border = "white",
     main = "Histogram Selisih (before - after)", xlab = "Selisih (mmHg)")
abline(v = mean(bp$selisih), col = "red", lwd = 2)

par(mfrow = c(1, 1))

Interpretasi. Boxplot menunjukkan median tekanan darah setelah intervensi lebih rendah daripada sebelum intervensi. Histogram selisih terpusat pada nilai positif (rata-rata 4.8 mmHg), artinya sebagian besar pasien mengalami penurunan tekanan darah.

3c. Uji normalitas selisih

Hipotesis: \(H_0\): selisih berdistribusi normal; \(H_1\): selisih tidak berdistribusi normal.

sw_d <- shapiro.test(bp$selisih)
sw_d
## 
##  Shapiro-Wilk normality test
## 
## data:  bp$selisih
## W = 0.89942, p-value = 0.008129
qqnorm(bp$selisih, main = "Q-Q Plot Selisih", pch = 19)
qqline(bp$selisih, col = "red", lwd = 2)

normal_d <- sw_d$p.value >= alpha

Kesimpulan. Uji Shapiro-Wilk menghasilkan W = 0.8994 dan p-value = 0,0081, sehingga H0 ditolak. Selisih tidak berdistribusi normal, sehingga uji yang paling sesuai adalah uji Wilcoxon signed-rank (nonparametrik); uji t berpasangan hanya dipakai sebagai pembanding.

3d. Uji t berpasangan dan uji Wilcoxon signed-rank

Hipotesis (dua arah):

  • \(H_0\): \(\mu_D = 0\) (rata-rata tekanan darah sebelum dan sesudah intervensi sama)
  • \(H_1\): \(\mu_D \neq 0\) (rata-rata tekanan darah sebelum dan sesudah intervensi berbeda)
  • Taraf signifikansi \(\alpha = 0{,}05\), dengan \(D\) = before - after
# Uji t berpasangan
tt <- t.test(bp$before, bp$after, paired = TRUE, conf.level = 0.95)
tt
## 
##  Paired t-test
## 
## data:  bp$before and bp$after
## t = 16.826, df = 29, p-value < 2.2e-16
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  4.216556 5.383444
## sample estimates:
## mean difference 
##             4.8
# Uji Wilcoxon signed-rank (exact = FALSE karena ada nilai selisih kembar)
wt <- wilcox.test(bp$before, bp$after, paired = TRUE, exact = FALSE,
                  conf.int = TRUE)
wt
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  bp$before and bp$after
## V = 465, p-value = 1.619e-06
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
##  4.000001 5.499942
## sample estimates:
## (pseudo)median 
##       4.500075
Uji Statistik p-value Selang kepercayaan 95% Keputusan
t berpasangan t = 16.826 (db = 29) < 0,0001 [4.217; 5.383] H0 ditolak
Wilcoxon signed-rank V = 465 < 0,0001 - H0 ditolak

Kesimpulan. Kedua uji menghasilkan p-value kurang dari 0,05 sehingga H0 ditolak: terdapat perbedaan signifikan rata-rata tekanan darah sistolik sebelum dan sesudah intervensi. Selang kepercayaan 95% untuk rata-rata selisih adalah 4.22 sampai 5.38 mmHg, yang tidak memuat nol sehingga konsisten dengan keputusan uji t.

3e. Cohen’s d berpasangan

d_cohen <- mean(bp$selisih) / sd(bp$selisih)
d_cohen
## [1] 3.072017
besar_efek <- function(d) {
  d <- abs(d)
  if (d < 0.2) "dapat diabaikan"
  else if (d < 0.5) "kecil"
  else if (d < 0.8) "sedang"
  else "besar"
}
besar_efek(d_cohen)
## [1] "besar"

Cohen’s d berpasangan dihitung sebagai \(d = \bar{D} / s_D\) = 3.072. Menurut kriteria Cohen (0,2 kecil; 0,5 sedang; 0,8 besar), ukuran efek tergolong besar. Artinya penurunan tekanan darah rata-rata sebesar 3.07 simpangan baku selisih.

3f. Kesimpulan akhir

Intervensi edukasi gaya hidup selama 6 minggu pada 30 pasien menurunkan rata-rata tekanan darah sistolik dari 139.83 mmHg menjadi 135.03 mmHg, yaitu turun rata-rata 4.8 mmHg (SD selisih = 1.56). Uji Shapiro-Wilk pada selisih menghasilkan p-value 0,0081 sehingga asumsi normalitas tidak terpenuhi dan uji Wilcoxon signed-rank dipilih sebagai uji utama. Hasil uji t berpasangan (t = 16.83, p < 0,0001) dan uji Wilcoxon (p < 0,0001) sama-sama menunjukkan perbedaan yang signifikan pada taraf 5%, dengan ukuran efek Cohen’s d = 3.07 (besar). Dengan demikian, program edukasi gaya hidup berasosiasi dengan penurunan tekanan darah sistolik yang bermakna secara statistik dan secara praktis; namun karena desainnya sebelum-sesudah tanpa kelompok kontrol, penyebab penurunan tidak dapat disimpulkan sepenuhnya berasal dari intervensi.