UTS Komputasi Statistika

Soal 1. Distribusi Sampling Rata-rata

1a. Membuat populasi, statistik deskriptif, dan histogram

set.seed(2025)

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

# Enam baris pertama
head(pop)

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

# Statistik deskriptif exam_score
statistik_populasi <- data.frame(
  Mean = mean(pop$exam_score),
  SD = sd(pop$exam_score),
  Min = min(pop$exam_score),
  Maks = max(pop$exam_score)
)
statistik_populasi

##      Mean      SD Min Maks
## 1 71.8192 10.1005  40  111

# SD populasi empiris: pembagi N, untuk menghitung SE teoretis
sd_pop <- sqrt(mean((pop$exam_score - mean(pop$exam_score))^2))

# Histogram nilai ujian
hist(
  pop$exam_score,
  main = "Histogram Nilai Ujian Mahasiswa",
  xlab = "Nilai ujian",
  ylab = "Frekuensi",
  col = "lightblue",
  border = "white"
)

Interpretasi: Tabel menampilkan rata-rata, simpangan baku, nilai minimum, dan maksimum nilai ujian pada populasi buatan berisi 5.000 mahasiswa. Histogram menunjukkan bentuk sebaran nilai ujian. Nilai pass dibangkitkan sesuai instruksi soal, tetapi analisis pada nomor ini berfokus pada exam_score.

1b. Simulasi 1.000 sampel dengan ukuran n = 30

set.seed(123)

B <- 1000
n <- 30

rata_sampel_30 <- replicate(
  B,
  mean(sample(pop$exam_score, size = n, replace = TRUE))
)

hist(
  rata_sampel_30,
  main = "Distribusi Sampling Rata-rata (n = 30)",
  xlab = "Rata-rata sampel",
  ylab = "Frekuensi",
  col = "lightgreen",
  border = "white"
)

# Bandingkan SD empiris dan standard error teoretis
sd_empiris <- sd(rata_sampel_30)
se_teoretis <- sd_pop / sqrt(n)

perbandingan_se <- data.frame(
  Ukuran_sampel = n,
  Jumlah_simulasi = B,
  Rata_rata_sampling = mean(rata_sampel_30),
  SD_empiris = sd_empiris,
  SD_populasi = sd_pop,
  SE_teoretis = se_teoretis
)

perbandingan_se

##   Ukuran_sampel Jumlah_simulasi Rata_rata_sampling SD_empiris SD_populasi
## 1            30            1000            71.8333   1.849776    10.09949
##   SE_teoretis
## 1    1.843906

Interpretasi: SD empiris dihitung dari 1.000 rata-rata sampel, sedangkan standard error teoretis dihitung dengan rumus sd_pop / sqrt(n). Keduanya diharapkan mendekati satu sama lain, tetapi tidak harus identik karena simulasi menggunakan sampel acak yang terbatas.

1c. Membandingkan n = 5, 30, dan 100

ukuran_sampel <- c(5, 30, 100)

set.seed(123)

hasil_sampling <- lapply(
  ukuran_sampel,
  function(n) {
    replicate(
      1000,
      mean(sample(pop$exam_score, size = n, replace = TRUE))
    )
  }
)

names(hasil_sampling) <- paste0("n = ", ukuran_sampel)

par(mfrow = c(1, 3))

for (i in seq_along(ukuran_sampel)) {
  hist(
    hasil_sampling[[i]],
    main = paste("Distribusi Sampling, n =", ukuran_sampel[i]),
    xlab = "Rata-rata sampel",
    ylab = "Frekuensi",
    col = "lightblue",
    border = "white"
  )
}

par(mfrow = c(1, 1))

perbandingan_ukuran_sampel <- data.frame(
  n = ukuran_sampel,
  Mean_sampling = sapply(hasil_sampling, mean),
  SD_empiris = sapply(hasil_sampling, sd),
  SE_teoretis = sd_pop / sqrt(ukuran_sampel)
)

perbandingan_ukuran_sampel

##           n Mean_sampling SD_empiris SE_teoretis
## n = 5     5      71.97200   4.521750    4.516630
## n = 30   30      71.79777   1.892637    1.843906
## n = 100 100      71.82888   1.029191    1.009949

Interpretasi: Ketika ukuran sampel meningkat, rata-rata sampel cenderung semakin terkonsentrasi di sekitar rata-rata populasi dan penyebarannya mengecil. Hal ini terlihat dari SD empiris dan standard error teoretis yang cenderung turun. Distribusi rata-rata sampel juga cenderung berbentuk lebih mendekati normal.

Kesimpulan Soal 1: Simulasi menunjukkan bahwa distribusi sampling rata-rata berpusat di sekitar rata-rata populasi. Semakin besar ukuran sampel, semakin kecil standard error sehingga estimasi rata-rata menjadi lebih stabil.

Soal 2. Uji Normalitas Data Tunggal dan Dua Variabel

Taraf signifikansi untuk semua pengujian adalah \(\alpha = 0{,}05\).

2a. Data penjualan: histogram, Q-Q plot, Shapiro-Wilk, dan Kolmogorov-Smirnov

Hipotesis Shapiro-Wilk:

• H0: Data penjualan berasal dari distribusi normal.
• H1: Data penjualan tidak berasal dari distribusi normal.

Hipotesis Kolmogorov-Smirnov pada data terstandarisasi:

• H0: Data terstandarisasi mengikuti distribusi normal standar.
• H1: Data terstandarisasi tidak mengikuti distribusi normal standar.

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

par(mfrow = c(1, 2))

hist(
  penjualan,
  main = "Histogram Data Penjualan",
  xlab = "Jumlah penjualan",
  ylab = "Frekuensi",
  col = "lightblue",
  border = "white"
)

qqnorm(penjualan, main = "Q-Q Plot Data Penjualan")
qqline(penjualan, col = "red", lwd = 2)

par(mfrow = c(1, 1))

hasil_shapiro <- shapiro.test(penjualan)

# Sesuai instruksi soal, lakukan KS pada data terstandarisasi.
# Data berulang (ties) dapat memunculkan peringatan pada uji KS.
hasil_ks <- ks.test(as.numeric(scale(penjualan)), "pnorm")

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

hasil_shapiro

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

hasil_ks

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  as.numeric(scale(penjualan))
## D = 0.11402, p-value = 0.9573
## alternative hypothesis: two-sided

tabel_penjualan <- data.frame(
  Uji = c("Shapiro-Wilk", "Kolmogorov-Smirnov"),
  Statistik = c(
    unname(hasil_shapiro$statistic),
    unname(hasil_ks$statistic)
  ),
  P_value = c(
    hasil_shapiro$p.value,
    hasil_ks$p.value
  )
)

tabel_penjualan$Keputusan <- ifelse(
  tabel_penjualan$P_value <= alpha,
  "Tolak H0",
  "Tidak menolak H0"
)

tabel_penjualan

##                  Uji Statistik   P_value        Keputusan
## 1       Shapiro-Wilk 0.9699599 0.7540280 Tidak menolak H0
## 2 Kolmogorov-Smirnov 0.1140191 0.9572511 Tidak menolak H0

Aturan keputusan: Jika p-value \(\leq 0{,}05\), H0 ditolak. Jika p-value \(> 0{,}05\), H0 tidak ditolak.

Interpretasi: Periksa p-value pada tabel. P-value Shapiro-Wilk yang lebih besar dari 0,05 berarti tidak terdapat bukti yang cukup untuk menyatakan data menyimpang dari normalitas. Untuk KS, R dapat menampilkan peringatan ties karena beberapa angka penjualan berulang; hasil KS tetap ditampilkan sesuai instruksi soal, tetapi perlu ditafsirkan secara hati-hati karena asumsi uji KS satu-sampel klasik tidak ideal untuk data dengan nilai berulang dan parameter normal yang diestimasi dari data.

2b. Uji normalitas berat dan tinggi menggunakan lapply(), serta Q-Q plot

Hipotesis untuk masing-masing variabel:

• H0: Variabel mengikuti distribusi normal.
• H1: Variabel tidak mengikuti distribusi normal.

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
)

data_dua <- list(
  Berat = berat,
  Tinggi = tinggi
)

# Terapkan Shapiro-Wilk pada kedua variabel sekaligus
hasil_dua <- lapply(data_dua, shapiro.test)
hasil_dua

## $Berat
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.98257, p-value = 0.8889
## 
## 
## $Tinggi
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.96475, p-value = 0.4071

tabel_dua <- data.frame(
  Variabel = names(data_dua),
  W = sapply(hasil_dua, function(x) unname(x$statistic)),
  P_value = sapply(hasil_dua, function(x) x$p.value)
)

tabel_dua$Keputusan <- ifelse(
  tabel_dua$P_value <= alpha,
  "Tolak H0",
  "Tidak menolak H0"
)

tabel_dua

##        Variabel         W   P_value        Keputusan
## Berat     Berat 0.9825681 0.8889398 Tidak menolak H0
## Tinggi   Tinggi 0.9647532 0.4071377 Tidak menolak H0

par(mfrow = c(1, 2))

qqnorm(berat, main = "Q-Q Plot Berat Badan")
qqline(berat, col = "red", lwd = 2)

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

par(mfrow = c(1, 1))

2c. Variabel yang lebih mendekati distribusi normal

W_dua <- sapply(hasil_dua, function(x) unname(x$statistic))
p_dua <- sapply(hasil_dua, function(x) x$p.value)

variabel_lebih_dekat <- names(which.max(W_dua))

cat(
  "Berdasarkan statistik W Shapiro-Wilk, variabel yang lebih mendekati normal adalah:",
  variabel_lebih_dekat, "\n"
)

## Berdasarkan statistik W Shapiro-Wilk, variabel yang lebih mendekati normal adalah: Berat

data.frame(
  Variabel = names(data_dua),
  Statistik_W = as.numeric(W_dua),
  P_value = as.numeric(p_dua)
)

##   Variabel Statistik_W   P_value
## 1    Berat   0.9825681 0.8889398
## 2   Tinggi   0.9647532 0.4071377

Interpretasi dan kesimpulan Soal 2: Nilai W yang lebih dekat ke 1 dan p-value yang lebih besar dapat menjadi indikasi relatif bahwa data lebih mendekati normal, dengan tetap mempertimbangkan Q-Q plot. Jika p-value suatu variabel lebih besar dari 0,05, H0 tidak ditolak; hal ini berarti tidak ada bukti yang cukup untuk menyatakan variabel tersebut tidak normal, bukan membuktikan bahwa distribusinya pasti normal.

Soal 3. Uji Kesamaan Rata-rata Data Berpasangan

Data berisi tekanan darah sistolik 30 pasien sebelum dan sesudah intervensi selama enam minggu. Selisih didefinisikan sebagai before − after, sehingga selisih positif menunjukkan penurunan tekanan darah setelah intervensi.

3a. Menghitung selisih, rata-rata, dan simpangan baku

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

bp$selisih <- bp$before - bp$after

head(bp)

##   id before after selisih
## 1  1    140   132       8
## 2  2    150   145       5
## 3  3    135   130       5
## 4  4    142   138       4
## 5  5    128   125       3
## 6  6    155   148       7

ringkasan_bp <- data.frame(
  Variabel = c("Before", "After", "Selisih (before - after)"),
  Mean = c(
    mean(bp$before),
    mean(bp$after),
    mean(bp$selisih)
  ),
  SD = c(
    sd(bp$before),
    sd(bp$after),
    sd(bp$selisih)
  )
)

ringkasan_bp

##                   Variabel     Mean       SD
## 1                   Before 139.8333 7.706170
## 2                    After 135.0333 6.713257
## 3 Selisih (before - after)   4.8000 1.562491

3b. Boxplot sebelum-sesudah dan histogram selisih

par(mfrow = c(1, 2))

boxplot(
  bp$before, bp$after,
  names = c("Sebelum", "Sesudah"),
  main = "Tekanan Darah Sebelum dan Sesudah",
  ylab = "Tekanan darah sistolik (mmHg)",
  col = c("lightblue", "lightgreen")
)

hist(
  bp$selisih,
  main = "Histogram Selisih Tekanan Darah",
  xlab = "Before - After (mmHg)",
  ylab = "Frekuensi",
  col = "lightblue",
  border = "white"
)

par(mfrow = c(1, 1))

3c. Uji normalitas pada selisih

Hipotesis:

• H0: Selisih tekanan darah sebelum dan sesudah berasal dari distribusi normal.
• H1: Selisih tekanan darah sebelum dan sesudah tidak berasal dari distribusi normal.

hasil_shapiro_selisih <- shapiro.test(bp$selisih)
hasil_shapiro_selisih

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

if (hasil_shapiro_selisih$p.value <= alpha) {
  cat("Keputusan: Tolak H0. Selisih tidak memenuhi asumsi normalitas pada alpha = 0,05.\n")
  cat("Uji Wilcoxon signed-rank menjadi pilihan nonparametrik yang sesuai untuk data berpasangan.\n")
} else {
  cat("Keputusan: Tidak menolak H0. Selisih tidak menunjukkan penyimpangan signifikan dari normalitas.\n")
  cat("Uji t berpasangan dapat digunakan jika asumsi lainnya juga terpenuhi.\n")
}

## Keputusan: Tolak H0. Selisih tidak memenuhi asumsi normalitas pada alpha = 0,05.
## Uji Wilcoxon signed-rank menjadi pilihan nonparametrik yang sesuai untuk data berpasangan.

Catatan: Untuk uji t berpasangan, asumsi normalitas yang diperiksa adalah distribusi selisih pasangan, bukan keharusan bahwa data before dan after masing-masing normal.

3d. Uji t berpasangan dan Wilcoxon signed-rank

Uji t berpasangan

Hipotesis:

• H0: Rata-rata selisih tekanan darah adalah 0 (\(\mu_d = 0\)).
• H1: Rata-rata selisih tekanan darah tidak sama dengan 0 (\(\mu_d \neq 0\)).

hasil_t <- t.test(
  bp$before,
  bp$after,
  paired = TRUE,
  alternative = "two.sided",
  conf.level = 0.95
)

hasil_t

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

ringkasan_t <- data.frame(
  Rata_rata_selisih = unname(hasil_t$estimate),
  Statistik_t = unname(hasil_t$statistic),
  df = unname(hasil_t$parameter),
  P_value = hasil_t$p.value,
  CI_95_bawah = hasil_t$conf.int[1],
  CI_95_atas = hasil_t$conf.int[2]
)

ringkasan_t

##   Rata_rata_selisih Statistik_t df      P_value CI_95_bawah CI_95_atas
## 1               4.8    16.82613 29 1.674497e-16    4.216556   5.383444

Uji Wilcoxon signed-rank

Hipotesis:

• H0: Pusat distribusi selisih pasangan adalah 0.
• H1: Pusat distribusi selisih pasangan tidak sama dengan 0.

# exact = FALSE digunakan agar penghitungan aproksimasi dapat dilakukan
# meskipun data selisih memiliki nilai yang sama (ties).
hasil_wilcoxon <- wilcox.test(
  bp$before,
  bp$after,
  paired = TRUE,
  alternative = "two.sided",
  exact = FALSE
)

hasil_wilcoxon

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

tabel_uji_pasangan <- data.frame(
  Uji = c("Paired t-test", "Wilcoxon signed-rank"),
  Statistik = c(
    unname(hasil_t$statistic),
    unname(hasil_wilcoxon$statistic)
  ),
  P_value = c(
    hasil_t$p.value,
    hasil_wilcoxon$p.value
  ),
  Keputusan = ifelse(
    c(hasil_t$p.value, hasil_wilcoxon$p.value) <= alpha,
    "Tolak H0",
    "Tidak menolak H0"
  )
)

tabel_uji_pasangan

##                    Uji Statistik      P_value Keputusan
## 1        Paired t-test  16.82613 1.674497e-16  Tolak H0
## 2 Wilcoxon signed-rank 465.00000 1.618574e-06  Tolak H0

Interpretasi: Pada kedua uji, bandingkan p-value dengan 0,05. Untuk paired t-test, selang kepercayaan 95% menunjukkan rentang nilai yang masuk akal bagi rata-rata selisih. Jika seluruh rentang berada di atas 0, hasil mendukung adanya penurunan rata-rata tekanan darah setelah intervensi. Karena uji normalitas selisih juga diperiksa, gunakan hasil Wilcoxon sebagai dasar utama jika asumsi normalitas selisih tidak terpenuhi.

3e. Cohen’s d berpasangan

Cohen’s \(d\) berpasangan dihitung sebagai rata-rata selisih dibagi simpangan baku selisih (sering disebut \(d_z\)).

cohens_d_z <- mean(bp$selisih) / sd(bp$selisih)

interpretasi_d <- if (abs(cohens_d_z) < 0.2) {
  "sangat kecil"
} else if (abs(cohens_d_z) < 0.5) {
  "kecil"
} else if (abs(cohens_d_z) < 0.8) {
  "sedang"
} else {
  "besar"
}

hasil_d <- data.frame(
  Mean_selisih = mean(bp$selisih),
  SD_selisih = sd(bp$selisih),
  Cohens_d_z = cohens_d_z,
  Interpretasi = interpretasi_d
)

hasil_d

##   Mean_selisih SD_selisih Cohens_d_z Interpretasi
## 1          4.8   1.562491   3.072017        besar

Interpretasi: Nilai Cohen’s \(d_z\) menunjukkan besarnya efek intervensi dalam satuan simpangan baku selisih. Nilai absolut sekitar 0,2 sering disebut kecil, 0,5 sedang, dan 0,8 atau lebih besar. Tanda positif pada definisi selisih before - after berarti tekanan darah cenderung lebih tinggi sebelum intervensi.

3f. Kesimpulan akhir

Berdasarkan data, rata-rata tekanan darah sebelum intervensi adalah 139.83 mmHg, sedangkan setelah intervensi 135.03 mmHg. Rata-rata selisih before - after sebesar 4.8 mmHg, yang menunjukkan penurunan rata-rata setelah intervensi. Uji Shapiro-Wilk pada selisih menghasilkan p-value 0.008129; karena p-value <= 0,05, keputusan normalitasnya adalah menolak H0. Uji Wilcoxon signed-rank menghasilkan p-value 1.619e-06, sedangkan paired t-test menghasilkan p-value < 2.2e-16 dengan CI 95% untuk rata-rata selisih sebesar [4.22, 5.38] mmHg. Cohen’s \(d_z\) sebesar 3.07 menunjukkan ukuran efek yang besar. Dengan memperhatikan hasil uji normalitas selisih, Wilcoxon signed-rank dijadikan dasar utama apabila normalitas tidak terpenuhi; hasil kedua pengujian perlu dilaporkan sesuai instruksi soal.