library(ggplot2)
library(forecast)
library(stats)
library(tseries)
library(knitr)
library(kableExtra)
library(plotly)
library(rmdformats)| Bulan_Angka | Tahun | Harga | Tanggal |
|---|---|---|---|
| 1 | 2023 | 5.20 | 2023-01-01 |
| 2 | 2023 | 5.15 | 2023-02-01 |
| 3 | 2023 | 5.30 | 2023-03-01 |
| 4 | 2023 | 5.40 | 2023-04-01 |
| 5 | 2023 | 5.25 | 2023-05-01 |
| 6 | 2023 | 5.35 | 2023-06-01 |
| 7 | 2023 | 5.45 | 2023-07-01 |
| 8 | 2023 | 5.50 | 2023-08-01 |
| 9 | 2023 | 5.40 | 2023-09-01 |
| 10 | 2023 | 5.55 | 2023-10-01 |
| 11 | 2023 | 5.60 | 2023-11-01 |
| 12 | 2023 | 5.70 | 2023-12-01 |
| 1 | 2024 | 5.65 | 2024-01-01 |
| 2 | 2024 | 5.70 | 2024-02-01 |
| 3 | 2024 | 5.80 | 2024-03-01 |
| 4 | 2024 | 5.90 | 2024-04-01 |
| 5 | 2024 | 5.75 | 2024-05-01 |
| 6 | 2024 | 5.85 | 2024-06-01 |
| 7 | 2024 | 5.95 | 2024-07-01 |
| 8 | 2024 | 6.00 | 2024-08-01 |
| 9 | 2024 | 5.90 | 2024-09-01 |
| 10 | 2024 | 6.05 | 2024-10-01 |
| 11 | 2024 | 6.15 | 2024-11-01 |
| 12 | 2024 | 6.30 | 2024-12-01 |
harga_ts <- ts(data_harga, start = c(2023, 1), frequency = 12)
pl <- ggplot(df_harga, aes(x = Tanggal, y = Harga)) +
# Garis harga
geom_line(color = "green", linewidth = 1) +
# Titik setiap bulan
geom_point(color = "yellow", size = 2.5) +
# Tandai outlier berdasarkan aturan IQR
geom_point(
data = df_harga %>%
filter(Harga < quantile(Harga, 0.25) - 1.5 * IQR(Harga) |
Harga > quantile(Harga, 0.75) + 1.5 * IQR(Harga)),
aes(x = Tanggal, y = Harga),
color = "purple",
size = 4,
shape = 8
) +
# Label nilai setiap titik
geom_text(
aes(label = Harga),
vjust = -1,
size = 2.8,
color = "black"
) +
# Garis rata-rata
geom_hline(
yintercept = mean(df_harga$Harga),
linetype = "dashed",
color = "#FFC107",
linewidth = 0.8
) +
# Sumbu X
scale_x_date(
date_breaks = "2 months",
date_labels = "%b\n%Y"
) +
labs(
title = "Harga Gabah Kering Panen",
subtitle = "Tahun 2023 - 2024",
x = "Bulan",
y = "Harga (Rp)"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(face = "bold", color = "#C62828"),
plot.subtitle = element_text(color = "#555555")
)
ggplotly(pl)Data time series tersebut memuat 12 bulan dari tahun 2023 dan 2024 harga gabah kering panen.
Pada grafik time series tersebut menunjukan adanya trend yang semakin meanaik, trand yang terjadi membuat data tidak stasioner terhadap rataan dan juga tidak stasioner terhadap ragam.
transfrm_harga <- log(data_harga)df_harga1 <- data.frame(
Bulan_Angka = rep(1:12, 2),
Tahun = rep(c(2023, 2024), each = 12),
Harga = transfrm_harga
) %>%
mutate(
Tanggal = as.Date(
paste(Tahun, Bulan_Angka, "01", sep = "-")
)
)
pl_tr <- ggplot(df_harga1, aes(x = Tanggal, y = Harga)) +
# Garis data
geom_line(color = "blue", linewidth = 1) +
# Titik setiap bulan
geom_point(color = "purple", size = 2.5) +
# Tandai outlier berdasarkan IQR
geom_point(
data = df_harga1 %>%
filter(
Harga < quantile(Harga, 0.25) - 1.5 * IQR(Harga) |
Harga > quantile(Harga, 0.75) + 1.5 * IQR(Harga)
),
aes(x = Tanggal, y = Harga),
color = "purple",
size = 4,
shape = 8
) +
# Label nilai setiap titik
geom_text(
aes(label = round(Harga, 4)),
vjust = -1,
size = 2.8,
color = "black"
) +
# Garis rata-rata
geom_hline(
yintercept = mean(df_harga1$Harga),
linetype = "dashed",
color = "#FFC107",
linewidth = 0.8
) +
# Sumbu X
scale_x_date(
date_breaks = "2 months",
date_labels = "%b\n%Y"
) +
labs(
title = "Log Harga Gabah Kering Panen",
subtitle = "Tahun 2023 - 2024",
x = "Bulan",
y = "Log Harga"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(face = "bold", color = "#C62828"),
plot.subtitle = element_text(color = "#555555")
)
ggplotly(pl_tr)Pada visualisai grafik sebelumnya terbentuk trend dan tidak stasiner terhadap varians, sehingga dilakukan transformasi logaritma pada data. Setelah dilakukan transformasi diperoleh hasil nilai yang semula disekitar 5,2 sampai 6,2 setelah ditransformasi dengan metode logaritma nilainya berubah menjadi disekitar 1,6 sampai 1,8.
Apabila pada grafik keduanya tidak terlihat perbedaan, namun yang berubah adalah nilai sumbu-y. hasil tersebut memperlihatkan varians data menjadi lebih kecil.
(diff_log_harga <- diff(transfrm_harga))## [1] -0.009661911 0.028710106 0.018692133 -0.028170877 0.018868484
## [6] 0.018519048 0.009132484 -0.018349139 0.027398974 0.008968670
## [11] 0.017699577 -0.008810630 0.008810630 0.017391743 0.017094433
## [16] -0.025752496 0.017241806 0.016949558 0.008368250 -0.016807118
## [21] 0.025105921 0.016393810 0.024097552Apabila dilihat dari output tersebut terdapat beberapa nilai yang berubah menjadi positif dan beberpa nilai berubah menjadi negatif yang tersebar disekitar angka 0, dengan demikia trend yang terlihat di awal sudah berkurang.
sd(harga_ts); sd(transfrm_harga); sd(diff_log_harga)## [1] 0.3141514## [1] 0.05539227## [1] 0.01725887# valuasi ramalan naif (data uji: 3 bulan terakhir)
train <- head(data_harga, 21); test <- tail(data_harga, 3)Membagi data kedalam data training dan data testing dengan proporsi 21 observasi data untuk training dan 3 data untuk testing
naive_forecast <- rep(tail(train, 1), 3)Hasil dari naif tesnya adalah 5,9. Nilai tersebut diambil dari periode terakhir sebagai nilai ramalan, sehingaa hasil seluruh peramalan bernilai 5,9
error <- test - naive_forecastOutput tersebut merupakan hasil dari pengurangan antara nilai prediksi dengan nilai aktualnya
ME <- mean(error); MAE <- mean(abs(error))Niai ME menunjukkan rata-rata kesalahan peramalan yang cenderung lebih rendah daripada nilai aktual sebesar sekitar 0,267 satuan. Menunjukkan adanya kecenderungan ramalan underestimate terhadap nilai aktual.
MAE menunjukkan rata-rata besar kesalahan tanpa memperhatikan arah kesalahan. Diperoleh nilai ME sebesar 0,2667 dan MAE sebesar 0,2667, nilai tersebut menunjukkan bahwa rata-rata besar kesalahan absolut hasil peramalan adalah sekitar 0,267 satuan.
MSE <- mean(error^2); RMSE <- sqrt(MSE)MSE merupakan rata-rata kuadrat kesalahan peramalan. Nilai MSE sebesar 0,0817 menunjukkan bahwa rata-rata kuadrat kesalahan hasil peramalan adalah sebesar 0,0817 satuan kuadrat.
Nilai RMSE sebesar 0,2858 menunjukkan bahwa besarnya kesalahan peramalan metode Naive, dalam satuan data asli, rata-rata sekitar 0,286 satuan dari nilai aktual.
MAPE <- mean(abs(error/test)) * 100Nilai MAPE yang diperoleh adalah 4,297862%, artinya hasil peramalan memiliki penyimpangan rata-rata sekitar 4,30% dibandingkan dengan nilai aktual.