Soal 1: Distribusi Sampling Rata-Rata

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

a) 6 baris pertama, ringkasan statistik, dan histogram

head(pop, 6)

##   exam_score pass
## 1         78    0
## 2         72    1
## 3         80    0
## 4         85    0
## 5         76    1
## 6         70    0

mean_pop <- mean(pop$exam_score)
sd_pop   <- sd(pop$exam_score)
min_pop  <- min(pop$exam_score)
max_pop  <- max(pop$exam_score)

cat("Mean pop :", mean_pop, "\n")

## Mean pop : 71.8192

cat("SD pop   :", sd_pop, "\n")

## SD pop   : 10.1005

cat("Min pop  :", min_pop, "\n")

## Min pop  : 40

cat("Maks pop :", max_pop, "\n")

## Maks pop : 111

hist(pop$exam_score, 
     main = "Histogram Exam Score (Populasi)", 
     xlab = "Exam Score", 
     col = "lightblue", 
     border = "pink", 
     breaks = 30)

b) Simulasi Distribusi Sampling (n = 30, B = 1000)

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

hist(sample_means_30, 
     main = "Distribusi Sampling Rata-rata (n = 30)", 
     xlab = expression(bar(X)), 
     col = "lightgreen", 
     border = "pink", 
     breaks = 25)

## Perbandingan SD Empiris vs SE Teoretis
sd_empiris_30 <- sd(sample_means_30)
se_teoretis_30 <- sd_pop / sqrt(n)

cat("SD Empiris (n=30) :", sd_empiris_30, "\n")

## SD Empiris (n=30) : 1.849776

cat("SE Teoretis (n=30):", se_teoretis_30, "\n")

## SE Teoretis (n=30): 1.844091

c) Perbandingan n = 5, n = 30, n = 100

set.seed(123)
sample_means_5   <- replicate(B, mean(sample(pop$exam_score, size = 5, replace = TRUE)))
sample_means_100 <- replicate(B, mean(sample(pop$exam_score, size = 100, replace = TRUE)))

# Tampilkan 3 histogram dalam satu baris
par(mfrow = c(1, 3))

hist(sample_means_5, 
     main = "Distribusi Sampling (n = 5)", 
     xlab = expression(bar(X)), 
     col = "coral", border = "white", xlim = c(55, 85))

hist(sample_means_30, 
     main = "Distribusi Sampling (n = 30)", 
     xlab = expression(bar(X)), 
     col = "aquamarine3", border = "white", xlim = c(55, 85))

hist(sample_means_100, 
     main = "Distribusi Sampling (n = 100)", 
     xlab = expression(bar(X)), 
     col = "skyblue4", border = "white", xlim = c(55, 85))

par(mfrow = c(1, 1))

Hasil dan Interpretasi

Rata-rata populasi = 71,82; simpangan baku = 10,10; nilai minimum = 40 dan maksimum = 111. Histogram populasi berbentuk simetris seperti lonceng, sesuai sifat distribusi normal.
SD empiris rata-rata sampel (n = 30) sebesar 1,85 sangat dekat dengan SE teoretis sebesar 1,84 (selisih hanya 0,006). Ini menjadi bukti teorema sampling bahwa variabilitas rata-rata sampel konvergen ke SE teoretis.
Semakin besar ukuran sampel (n), sebaran distribusi sampling rata-rata menjadi semakin sempit. SD empirisnya 4,52 (n = 5), 1,85 (n = 30), dan 1,02 (n = 100), hampir sama dengan SE teoretisnya yaitu 4,52; 1,84; dan 1,01. Distribusinya juga semakin mendekati bentuk normal dan berpusat di sekitar 71,8 (rata-rata populasi), sesuai Central Limit Theorem.

2. Uji Normalitas Data Tunggal dan Dua Variabel

#Input data
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)

a) Visualisasi & Uji Normalitas Data Penjualan

par(mfrow = c(1, 2))
hist(penjualan, main = "Histogram Penjualan", xlab = "Penjualan", col = "lightyellow", border = "gray")
qqnorm(penjualan, main = "Q-Q Plot Penjualan")
qqline(penjualan, col = "pink", lwd = 2)

par(mfrow = c(1, 1))

Uji Shapiro-Wilk

shapiro_penjualan <- shapiro.test(penjualan)
print(shapiro_penjualan)

## 
##  Shapiro-Wilk normality test
## 
## data:  penjualan
## W = 0.96996, p-value = 0.754

Uji Kolmogorov-Smirnov (data distandarisasi ke Z-score)

z_penjualan <- scale(penjualan)
ks_penjualan <- ks.test(z_penjualan, "pnorm")

## Warning in ks.test.default(z_penjualan, "pnorm"): ties should not be present
## for the one-sample Kolmogorov-Smirnov test

print(ks_penjualan)

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  z_penjualan
## D = 0.11402, p-value = 0.9573
## alternative hypothesis: two-sided

b) Uji Normalitas Berat dan Tinggi (sapply) & Q-Q Plot

df_bt <- data.frame(berat = berat, tinggi = tinggi)

# Uji Shapiro-Wilk menggunakan sapply
uji_norm_bt <- sapply(df_bt, function(x) {
  res <- shapiro.test(x)
  c(W = res$statistic, p_value = res$p.value)
})
print(uji_norm_bt)

##             berat    tinggi
## W.W     0.9825681 0.9647532
## p_value 0.8889398 0.4071377

# Q-Q Plot keduanya
par(mfrow = c(1, 2))
qqnorm(berat, main = "Q-Q Plot Berat Badan")
qqline(berat, col = "skyblue4", lwd = 2)

qqnorm(tinggi, main = "Q-Q Plot Tinggi Badan")
qqline(tinggi, col = "aquamarine4", lwd = 2)

par(mfrow = c(1, 1))

Intepretasi

Hipotesis: H_0 : Data penjualan berdistribusi normal H_1 : Data penjualan tidak berdistribusi normal

Hasil uji Shapiro-Wilk: W = 0,970 dan p-value = 0,754. Hasil uji Kolmogorov-Smirnov (data distandarisasi): D = 0,114 dan p-value = 0,957. Karena kedua p-value > 0,05, maka gagal tolak H_0, sehingga data penjualan berdistribusi normal. (Pada uji K-S muncul peringatan ties karena ada nilai data yang kembar, tetapi kesimpulannya sama dengan uji Shapiro-Wilk.)

Uji Shapiro-Wilk (H_0: data berdistribusi normal):

Berat: W = 0,983 dan p-value = 0,889
Tinggi: W = 0,965 dan p-value = 0,407

Kedua p-value > 0,05, maka gagal tolak H_0, sehingga berat dan tinggi sama-sama berdistribusi normal.

Variabel yang lebih mendekati normal: Variabel berat memiliki nilai statistik uji W yang lebih tinggi (0,983 > 0,965) dan nilai p-value yang lebih besar (0,889 > 0,407) dibandingkan variabel tinggi. Selain itu, titik-titik pada Q-Q plot berat badan terletak lebih merata dan menempel di sepanjang garis referensi. Oleh karena itu, variabel berat lebih mendekati distribusi normal, meskipun keduanya sama-sama memenuhi asumsi normalitas.

3. Uji Kesamaan Rata-rata Data Berpasangan

# input data
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)
)

a) Hitung selisih dan ringkasan statistik

bp$diff <- bp$before - bp$after

ringkasan <- data.frame(
  Kondisi = c("Before", "After", "Selisih (Diff)"),
  Mean = c(mean(bp$before), mean(bp$after), mean(bp$diff)),
  SD = c(sd(bp$before), sd(bp$after), sd(bp$diff))
)
print(ringkasan)

##          Kondisi     Mean       SD
## 1         Before 139.8333 7.706170
## 2          After 135.0333 6.713257
## 3 Selisih (Diff)   4.8000 1.562491

b) Boxplot Before vs After dan Histogram Selisih

par(mfrow = c(1, 2))
boxplot(bp$before, bp$after, 
        names = c("Before", "After"), 
        col = c("pink", "lightcyan"),
        main = "Boxplot Tekanan Darah", 
        ylab = "Tekanan Darah (mmHg)")

hist(bp$diff, 
     main = "Histogram Selisih (Before - After)", 
     xlab = "Selisih Penurunan (mmHg)", 
     col = "lavender", border = "purple4", breaks = 8)

par(mfrow = c(1, 1))

##c) Uji Normalitas Selisih

shapiro_diff <- shapiro.test(bp$diff)
print(shapiro_diff)

## 
##  Shapiro-Wilk normality test
## 
## data:  bp$diff
## W = 0.89942, p-value = 0.008129

d) Uji-t Berpasangan dan Uji Wilcoxon Signed-Rank

# Uji-t berpasangan
t_test_res <- t.test(bp$before, bp$after, paired = TRUE)
print(t_test_res)

## 
##  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
wilcox_res <- wilcox.test(bp$before, bp$after, paired = TRUE, exact = FALSE)
print(wilcox_res)

## 
##  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

e) Menghitung Cohen’s d berpasangan

cohen_d <- mean(bp$diff) / sd(bp$diff)
cat("Cohen's d:", cohen_d, "\n")

## Cohen's d: 3.072017

Hasil dan Interpretasi

Rata-rata dan simpangan baku:

Before: Mean = 139,83 mmHg, SD = 7,71
After: Mean = 135,03 mmHg, SD = 6,71
Selisih: Mean = 4,80 mmHg, SD = 1,562

Rata-rata tekanan darah sistolik turun sebesar 4,8 mmHg setelah intervensi.

Pada boxplot, kotak dan median “After” berada lebih rendah daripada “Before”, yang menunjukkan tekanan darah menurun setelah intervensi. Histogram selisih berkisar sekitar 3-8 mmHg dan agak miring ke kanan (tidak simetris).
Hipotesis: H_0 : Selisih berdistribusi normal H_1 : Selisih tidak berdistribusi normal Hasil uji Shapiro-Wilk: W = 0,899 dan p-value = 0,008. Karena p-value < 0,05, maka tolak H_0, sehingga selisih tidak berdistribusi normal. Uji yang paling sesuai adalah uji Wilcoxon signed-rank (non-parametrik). Uji-t berpasangan tetap dilaporkan sebagai pembanding.
Hipotesis: H_0 : mu_d = 0) (tidak ada perbedaan rata-rata tekanan darah sebelum dan sesudah intervensi) H_1 : mu_d != 0) (ada perbedaan)

Uji-t berpasangan: t = 16,83; df = 29; p-value < 0,001; selang kepercayaan 95% untuk selisih rata-rata = [4,22; 5,38] mmHg (tidak memuat 0).
Uji Wilcoxon signed-rank: V = 465; p-value = 0,001.. Kedua p-value < 0,05, maka tolak H_0. Terdapat penurunan tekanan darah sistolik yang signifikan setelah intervensi.

Cohen’s d berpasangan = 3,07. Nilai ini jauh di atas 0,8, sehingga termasuk efek besar.
Kesimpulan akhir: Intervensi edukasi gaya hidup selama 6 minggu menurunkan tekanan darah sistolik pasien secara signifikan, dengan rata-rata penurunan 4,8 mmHg (selang kepercayaan 95%: 4,22-5,38 mmHg). Karena selisih tidak berdistribusi normal (Shapiro-Wilk p = 0,008), uji Wilcoxon signed-rank (p = 0,001.) dijadikan dasar utama dan memberi kesimpulan yang sama dengan uji-t berpasangan (p < 0,001.). Ukuran efeknya besar (Cohen’s d = 3,07), sehingga penurunan ini bermakna secara statistik maupun praktis.

UTS Komputasi Statistika

Ar Rahmah Khullatul L

2026-10-12

Soal 1: Distribusi Sampling Rata-Rata

a) 6 baris pertama, ringkasan statistik, dan histogram

b) Simulasi Distribusi Sampling (n = 30, B = 1000)

c) Perbandingan n = 5, n = 30, n = 100

Hasil dan Interpretasi

2. Uji Normalitas Data Tunggal dan Dua Variabel

a) Visualisasi & Uji Normalitas Data Penjualan

Uji Shapiro-Wilk

Uji Kolmogorov-Smirnov (data distandarisasi ke Z-score)

b) Uji Normalitas Berat dan Tinggi (sapply) & Q-Q Plot

Intepretasi

3. Uji Kesamaan Rata-rata Data Berpasangan

a) Hitung selisih dan ringkasan statistik

b) Boxplot Before vs After dan Histogram Selisih

d) Uji-t Berpasangan dan Uji Wilcoxon Signed-Rank

e) Menghitung Cohen’s d berpasangan

Hasil dan Interpretasi