Perpustakaan Daerah Kabupaten Serang mencatat jumlah pengunjung setiap bulan. Data yang dipakai adalah data bulanan Januari 2023 sampai Juni 2024 (18 pengamatan, satuan orang/bulan). Pemahaman pola data ini penting untuk perencanaan layanan, koleksi buku, dan staf.
ts (Soal 1)pengunjung <- c(210, 195, 220, 205, 230, 215, 240, 225, 250, 235, 245, 260, # 2023
255, 265, 270, 280, 275, 290) # Jan-Jun 2024
ts_data <- ts(pengunjung, start = c(2023, 1), frequency = 12)
ts_data
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2023 210 195 220 205 230 215 240 225 250 235 245 260
## 2024 255 265 270 280 275 290
Penjelasan output: objek ts_data
berfrekuensi 12 (bulanan) dan dimulai Januari 2023. Tabel yang muncul
berbentuk matriks tahun × bulan, sesuai tabel pada soal. Terdapat 18
pengamatan, dan nilai Juli–Desember 2024 memang belum tersedia.
summary(ts_data)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 195.0 221.2 242.5 242.5 263.8 290.0
Penjelasan output: rata-rata pengunjung sekitar 243 orang/bulan, dengan minimum 195 (Februari 2023) dan maksimum 290 (Juni 2024).
plot(ts_data, type = "o", pch = 16, col = "steelblue", lwd = 2,
main = "Jumlah Pengunjung Perpustakaan Daerah Kab. Serang",
xlab = "Waktu", ylab = "Pengunjung (orang/bulan)")
grid()
abline(lm(ts_data ~ time(ts_data)), col = "red", lty = 2)
legend("topleft", legend = c("Data asli", "Garis tren linear"),
col = c("steelblue", "red"), lty = c(1, 2), pch = c(16, NA), bty = "n")
model_tren <- lm(ts_data ~ time(ts_data))
coef(model_tren)
## (Intercept) time(ts_data)
## -119926.9298 59.3808
summary(model_tren)$r.squared
## [1] 0.9117226
Interpretasi (jawaban Soal 1): plot menunjukkan pergerakan naik dari waktu ke waktu meskipun bergerigi (naik-turun kecil dari bulan ke bulan). Garis tren linear memiliki kemiringan sekitar 4,95 orang per bulan (sekitar 59 orang per tahun), dan \(R^2\) yang tinggi menunjukkan bahwa sebagian besar variasi dijelaskan oleh waktu. Jadi data memiliki tren naik yang cukup jelas. Pola musiman yang tegas belum dapat disimpulkan karena data baru mencakup 1,5 tahun.
sma3 <- stats::filter(ts_data, filter = rep(1/3, 3), sides = 1) # rata-rata 3 bulan terakhir
tabel_sma <- data.frame(
Periode = format(seq(as.Date("2023-01-01"), by = "month", length.out = 18), "%b %Y"),
Aktual = as.numeric(ts_data),
SMA3 = round(as.numeric(sma3), 2)
)
tabel_sma
Penjelasan output: dua nilai pertama NA
karena SMA(3) baru bisa dihitung mulai bulan ke-3 (Maret 2023), yaitu
\((210+195+220)/3 = 208{,}33\). Nilai
terakhir (Juni 2024) adalah \((275+280+290)/3
= 281{,}67\).
plot(ts_data, type = "o", pch = 16, col = "steelblue", lwd = 2,
main = "Data Asli vs SMA(3)", xlab = "Waktu", ylab = "Pengunjung")
lines(sma3, type = "o", pch = 17, col = "red", lwd = 2)
grid()
legend("topleft", legend = c("Data asli", "SMA(3)"),
col = c("steelblue", "red"), lty = 1, pch = c(16, 17), bty = "n")
enam <- tail(tabel_sma, 6)
enam$Selisih <- enam$Aktual - enam$SMA3
enam
mean(abs(enam$Selisih))
## [1] 5
Interpretasi (jawaban Soal 2): pada enam bulan terakhir, nilai SMA(3) selalu berada di bawah atau sama dengan data asli (selisih 0 sampai sekitar 8 orang; rata-rata selisih mutlak sekitar 5 orang). Ini berarti SMA terlihat tertinggal (lag). Penyebabnya, SMA memberi bobot yang sama pada tiga bulan terakhir, termasuk bulan-bulan lama yang nilainya lebih rendah, sehingga ketika data terus naik SMA baru menyusul beberapa periode kemudian. Kelebihannya, kurva SMA lebih halus karena fluktuasi acak teredam.
m <- 3
M1 <- stats::filter(ts_data, rep(1/m, m), sides = 1) # M't (SMA pertama)
M2 <- stats::filter(M1, rep(1/m, m), sides = 1) # M''t (SMA dari M't)
at <- 2 * M1 - M2 # intersep
bt <- (2 / (m - 1)) * (M1 - M2) # kemiringan
tabel_dma <- data.frame(
Periode = tabel_sma$Periode,
Aktual = as.numeric(ts_data),
M1 = round(as.numeric(M1), 2),
M2 = round(as.numeric(M2), 2),
at = round(as.numeric(at), 2),
bt = round(as.numeric(bt), 2)
)
tabel_dma
Penjelasan output:
M1) mulai tersedia pada bulan ke-3 (Maret 2023).M2) mulai tersedia pada bulan ke-5 (Mei 2023), karena
membutuhkan tiga nilai \(M'_t\).
Contoh: \((208{,}33+206{,}67+218{,}33)/3 =
211{,}11\).plot(ts_data, type = "o", pch = 16, col = "steelblue", lwd = 2,
main = "Data Asli, SMA(3), dan Komponen DMA",
xlab = "Waktu", ylab = "Pengunjung", ylim = c(190, 300))
lines(M1, col = "red", lwd = 2, type = "o", pch = 17)
lines(M2, col = "darkgreen", lwd = 2, type = "o", pch = 15)
lines(at, col = "purple", lwd = 2, lty = 2)
grid()
legend("topleft", legend = c("Aktual", "M't", "M''t", "a_t"),
col = c("steelblue", "red", "darkgreen", "purple"),
lty = c(1, 1, 1, 2), bty = "n")
Penjelasan grafik: \(M''_t\) (hijau) berada paling bawah dan paling tertinggal karena merupakan rata-rata dari rata-rata. Nilai \(a_t\) (ungu) menggeser level ke atas untuk mengoreksi ketertinggalan itu, sehingga lebih dekat ke data asli daripada \(M'_t\).
h <- 1:2
a_akhir <- as.numeric(tail(at, 1))
b_akhir <- as.numeric(tail(bt, 1))
ramalan_dma <- a_akhir + b_akhir * h # F(t+h) = a_t + b_t * h
ramalan_sma <- rep(as.numeric(tail(M1, 1)), length(h)) # SMA: datar
hasil <- data.frame(
Bulan = c("Juli 2024", "Agustus 2024"),
h = h,
Ramalan_SMA = round(ramalan_sma, 2),
Ramalan_DMA = round(ramalan_dma, 2)
)
hasil$Selisih_DMA_SMA <- hasil$Ramalan_DMA - hasil$Ramalan_SMA
hasil
Penjelasan output:
fc_dma <- ts(c(as.numeric(tail(ts_data, 1)), ramalan_dma),
start = c(2024, 6), frequency = 12)
fc_sma <- ts(c(as.numeric(tail(ts_data, 1)), ramalan_sma),
start = c(2024, 6), frequency = 12)
plot(ts_data, type = "o", pch = 16, col = "steelblue", lwd = 2,
xlim = c(2023, 2024.9), ylim = c(190, 310),
main = "Ramalan Juli-Agustus 2024: DMA vs SMA",
xlab = "Waktu", ylab = "Pengunjung")
lines(fc_dma, type = "o", pch = 17, col = "red", lwd = 2, lty = 2)
lines(fc_sma, type = "o", pch = 15, col = "darkgreen", lwd = 2, lty = 2)
grid()
legend("topleft", legend = c("Data asli", "Ramalan DMA", "Ramalan SMA"),
col = c("steelblue", "red", "darkgreen"), lty = c(1, 2, 2),
pch = c(16, 17, 15), bty = "n")
Interpretasi (jawaban Soal 4):