Tugas Simulasi Monte Carlo

---

Pendahuluan

Tugas ini merupakan modifikasi dari simulasi Monte Carlo yang telah dipelajari. Simulasi Monte Carlo memanfaatkan pengambilan sampel acak berulang untuk mendekati nilai parameter tertentu — dalam kasus ini, nilai ekspektasi permintaan.

Pada materi sebelumnya, simulasi telah dijalankan untuk 5, 20, 100, dan 1.000 hari. Pada tugas ini, jumlah simulasi diubah menjadi 1.000, 5.000, dan 20.000, lalu hasilnya dibandingkan dengan ekspektasi teoritis.

---

Data Awal & Ekspektasi Teoritis

tabel_permintaan <- data.frame(
  permintaan = c(50, 60, 70, 80, 90),
  frekuensi  = c(10, 20, 40, 20, 10)
)

total_frekuensi                 <- sum(tabel_permintaan$frekuensi)
tabel_permintaan$probabilitas   <- tabel_permintaan$frekuensi / total_frekuensi
tabel_permintaan$prob_kumulatif <- cumsum(tabel_permintaan$probabilitas)
tabel_permintaan$batas_bawah    <- c(1, head(tabel_permintaan$prob_kumulatif, -1) * 100 + 1)
tabel_permintaan$batas_atas     <- tabel_permintaan$prob_kumulatif * 100

print(tabel_permintaan)

##   permintaan frekuensi probabilitas prob_kumulatif batas_bawah batas_atas
## 1         50        10          0.1            0.1           1         10
## 2         60        20          0.2            0.3          11         30
## 3         70        40          0.4            0.7          31         70
## 4         80        20          0.2            0.9          71         90
## 5         90        10          0.1            1.0          91        100

ekspektasi_teoritis <- sum(tabel_permintaan$permintaan * tabel_permintaan$probabilitas)
cat("Ekspektasi Teoritis (Manual):", ekspektasi_teoritis)

## Ekspektasi Teoritis (Manual): 70

Nilai ekspektasi teoritis diperoleh dari rumus \(E[X] = \sum x_i \cdot P(x_i)\), menghasilkan nilai 70.

---

Fungsi Simulasi

permintaan_simulasi <- function(n, tabel) {
  bilangan_acak <- sample(1:100, n, replace = TRUE)
  
  get_demand <- function(x) {
    index <- which(x >= tabel$batas_bawah & x <= tabel$batas_atas)
    if (length(index) == 0) return(NA)
    return(tabel$permintaan[index])
  }
  
  prediksi <- sapply(bilangan_acak, get_demand)
  result   <- data.frame(
    bilangan_acak       = bilangan_acak,
    prediksi_permintaan = prediksi
  )
  result <- na.omit(result)
  return(result)
}

---

Menjalankan Simulasi

Simulasi 1.000

set.seed(1000)
sim_1000 <- permintaan_simulasi(1000, tabel_permintaan)
cat("Rata-rata permintaan (1.000 simulasi):", mean(sim_1000$prediksi_permintaan))

## Rata-rata permintaan (1.000 simulasi): 70.12097

Simulasi 5.000

set.seed(5000)
sim_5000 <- permintaan_simulasi(5000, tabel_permintaan)
cat("Rata-rata permintaan (5.000 simulasi):", mean(sim_5000$prediksi_permintaan))

## Rata-rata permintaan (5.000 simulasi): 70.08871

Simulasi 20.000

set.seed(20000)
sim_20000 <- permintaan_simulasi(20000, tabel_permintaan)
cat("Rata-rata permintaan (20.000 simulasi):", mean(sim_20000$prediksi_permintaan))

## Rata-rata permintaan (20.000 simulasi): 69.89096

---

Tabel Perbandingan

perbandingan <- data.frame(
  Metode = c("Ekspektasi Teoritis", "Simulasi 1.000", "Simulasi 5.000", "Simulasi 20.000"),
  Rata_Rata = c(
    ekspektasi_teoritis,
    round(mean(sim_1000$prediksi_permintaan),  4),
    round(mean(sim_5000$prediksi_permintaan),  4),
    round(mean(sim_20000$prediksi_permintaan), 4)
  ),
  Selisih_dari_Teoritis = c(
    0,
    round(abs(mean(sim_1000$prediksi_permintaan)  - ekspektasi_teoritis), 4),
    round(abs(mean(sim_5000$prediksi_permintaan)  - ekspektasi_teoritis), 4),
    round(abs(mean(sim_20000$prediksi_permintaan) - ekspektasi_teoritis), 4)
  )
)

knitr::kable(perbandingan,
             col.names = c("Metode", "Rata-Rata Permintaan", "Selisih dari Teoritis"),
             align = "lcc")

Metode	Rata-Rata Permintaan	Selisih dari Teoritis
Ekspektasi Teoritis	70.0000	0.0000
Simulasi 1.000	70.1210	0.1210
Simulasi 5.000	70.0887	0.0887
Simulasi 20.000	69.8910	0.1090

---

Visualisasi

par(mfrow = c(1, 3))

hist(sim_1000$prediksi_permintaan,
     main = "Simulasi 1.000", xlab = "Permintaan",
     col = "lightblue", border = "white", breaks = 5)
abline(v = ekspektasi_teoritis, col = "red", lwd = 2, lty = 2)

hist(sim_5000$prediksi_permintaan,
     main = "Simulasi 5.000", xlab = "Permintaan",
     col = "lightgreen", border = "white", breaks = 5)
abline(v = ekspektasi_teoritis, col = "red", lwd = 2, lty = 2)

hist(sim_20000$prediksi_permintaan,
     main = "Simulasi 20.000", xlab = "Permintaan",
     col = "lightyellow", border = "white", breaks = 5)
abline(v = ekspektasi_teoritis, col = "red", lwd = 2, lty = 2)

par(mfrow = c(1, 1))

Garis merah putus-putus menunjukkan nilai ekspektasi teoritis (70).

---

Analisis & Kesimpulan

Berdasarkan hasil simulasi di atas, dapat dianalisis sebagai berikut:

Aspek	Penjelasan
Selisih mengecil	Semakin besar jumlah simulasi, selisih antara hasil simulasi dan nilai teoritis (70) semakin kecil
Distribusi histogram	Histogram semakin “stabil” dan proporsional seiring bertambahnya jumlah simulasi
Law of Large Numbers	Fenomena ini sesuai dengan Hukum Bilangan Besar: rata-rata sampel akan konvergen ke nilai ekspektasi populasi seiring bertambahnya \(n\)

Mengapa lebih banyak simulasi menghasilkan estimasi lebih stabil?

Ketika jumlah simulasi diperbesar, setiap nilai permintaan (50, 60, 70, 80, 90) memiliki kesempatan muncul dengan frekuensi yang mendekati probabilitas teoritisnya masing-masing. Variasi acak yang muncul dari sampel kecil “rata” seiring bertambahnya ulangan, sehingga rata-rata simulasi semakin mendekati \(E[X] = 70\).