Anggota Kelompok
Muhammad Nur Alfi Syahri (2207106039)
Syarifah Nasywa (2207016040)
Shalihatunnisa (2207016054)
Debora Natania Priskila Boru Ginting (2207016066)
Definisi curah hujan merupakan jumlah air hujan yang turun di daerah tertentu dalam periode waktu tertentu (harian, mingguan, bulanan atau tahunan) yang diukur dengan satuan tinggi milimeter (mm) di atas permukaan horizontal. Curah hujan merupakan fenomena alam yang memiliki peran penting dalam kehidupan sehari-hari. Kemampuan untuk memahami dan meramalkan pola curah hujan sangatlah krusial, terutama dalam rangka mitigasi bencana alam, perencanaan pengelolaan sumber daya air, serta pelaksanaan manajemen lingkungan.
Analisis data dalam penelitian ini berfungsi untuk memperdalam pemahaman terhadap karakteristik curah hujan pada periode waktu tertentu. Peramalan hujan menjadi sangat penting untuk mendukung pengambilan keputusan dalam perencanaan sumber daya air, pembangunan infrastruktur dan kesiapsiagaan terhadap bencana hidrometereologi seperti banjir.
Oleh karena itu, dilakukan pemodelan dengan membandingkan tiga metode peramalan ARIMA, Neural Network (NN) dan Naive Trend untuk memprediksi curah hujan di Balikpapan. Diharapkan hasil analisis ini dapat memberikan gambaran metode yang paling sesuai digunakan, sekaligus menunjukkan bagaimana data runtun waktu bisa dimanfaatkan untuk mendukung pengambilan keputusan yang lebih responsif terhadap kondisi cuaca di masa depan.
library(MASS)
library(car)
## Loading required package: carData
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(tseries)
library(quadprog)
library(zoo)
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(fracdiff)
library(fUnitRoots)
library(lmtest)
library(Rssa)
## Loading required package: svd
##
## Attaching package: 'Rssa'
## The following object is masked from 'package:stats':
##
## decompose
library(tseries)
library(MLmetrics)
##
## Attaching package: 'MLmetrics'
## The following object is masked from 'package:base':
##
## Recall
library(urca)
##
## Attaching package: 'urca'
## The following objects are masked from 'package:fUnitRoots':
##
## punitroot, qunitroot, unitrootTable
library(TSA)
## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast
##
## Attaching package: 'TSA'
## The following objects are masked from 'package:stats':
##
## acf, arima
## The following object is masked from 'package:utils':
##
## tar
library(tsoutliers)
library(ggplot2)
library(Metrics)
##
## Attaching package: 'Metrics'
## The following object is masked from 'package:forecast':
##
## accuracy
Data yang digunakan dalam penelitian ini merupakan data Curah Hujan Kota Balikpapan periode Januari 2018 hingga Desember 2023.
data<-read.csv(file.choose(),header = T)
data
## Zt
## 1 254.4
## 2 217.7
## 3 412.2
## 4 117.1
## 5 381.7
## 6 222.0
## 7 319.2
## 8 151.4
## 9 18.5
## 10 212.8
## 11 120.2
## 12 367.4
## 13 291.5
## 14 75.4
## 15 159.1
## 16 149.6
## 17 166.6
## 18 636.6
## 19 243.2
## 20 63.7
## 21 97.2
## 22 242.2
## 23 89.0
## 24 115.5
## 25 158.1
## 26 316.7
## 27 196.8
## 28 337.3
## 29 287.6
## 30 545.6
## 31 521.7
## 32 263.5
## 33 473.9
## 34 257.6
## 35 315.4
## 36 280.6
## 37 250.4
## 38 135.4
## 39 167.0
## 40 159.8
## 41 260.5
## 42 176.6
## 43 148.6
## 44 446.0
## 45 421.0
## 46 357.3
## 47 306.8
## 48 233.0
## 49 207.0
## 50 205.0
## 51 404.0
## 52 164.0
## 53 109.0
## 54 234.0
## 55 282.0
## 56 552.0
## 57 369.0
## 58 232.0
## 59 190.0
## 60 226.0
## 61 228.1
## 62 272.4
## 63 240.7
## 64 274.3
## 65 271.3
## 66 185.6
## 67 126.8
## 68 83.1
## 69 104.3
## 70 204.7
## 71 83.5
## 72 266.7
#In-Sample 90% (1-65)
Zt<-ts(data$Zt[1:65])
plot(Zt, type="b", ylim=c(min(Zt),max(Zt)),cex=1.2,pch=21,bg="red",col="orange",lwd=2, frame=TRUE,
xlab="Periode ke-", ylab="Jumlah Data",
main="Curah Hujan Bulanan Kota Balikpapan")
legend("bottomright",legend="Jumlah Data",
col=c("orange"),lty=1,cex=0.65,pt.cex=2,bty="n")
mean(Zt)
## [1] 255.4185
Berdasarkan grafik runtun waktu data Curah Hujan Bulanan Kota Balikpapan dari bulan Januari 2018 hingga Desember 2023 cenderung menunjukkan pola yang fluktuatif dari waktu ke waktu. Meskipun terdapat beberapa periode dengan curah hujan yang tinggi maupun rendah, secara visual terlihat bahwa data cenderung tidak stasioner karena pergerakan data tidak berfluktuasi secara konsisten di sekitar nilai rata-rata.
#Naive Linear
mnaive_linear <- matrix(0, nrow = nrow(data), ncol = 1)
for (i in 1:(nrow(data)-1)){
if (i == 1){
mnaive_linear[i] <- Zt[i]
mnaive_linear[i+1] <- Zt[i+1]
}
else if (i <= length(Zt)){
mnaive_linear[i+1] <- Zt[i] + (Zt[i]-Zt[i-1])
}
else if (i == (length(Zt) + 1)){
mnaive_linear[i+1] <- mnaive_linear[i] + (mnaive_linear[i]-Zt[i-1])
}
else {
mnaive_linear[i+1] <- mnaive_linear[i] + (mnaive_linear[i]-mnaive_linear[i-1])
}
}
pred_naive_lin <- mnaive_linear[1:65]
pred_naive_lin
## [1] 254.4 217.7 181.0 606.7 -178.0 646.3 62.3 416.4 -16.4 -114.4
## [11] 407.1 27.6 614.6 215.6 -140.7 242.8 140.1 183.6 1106.6 -150.2
## [21] -115.8 130.7 387.2 -64.2 142.0 200.7 475.3 76.9 477.8 237.9
## [31] 803.6 497.8 5.3 684.3 41.3 373.2 245.8 220.2 20.4 198.6
## [41] 152.6 361.2 92.7 120.6 743.4 396.0 293.6 256.3 159.2 181.0
## [51] 203.0 603.0 -76.0 54.0 359.0 330.0 822.0 186.0 95.0 148.0
## [61] 262.0 230.2 316.7 209.0 307.9
ramal_naive_lin <- mnaive_linear[66:72]
ramal_naive_lin
## [1] 268.3 265.3 262.3 259.3 256.3 253.3 250.3
punyalinear<-c(pred_naive_lin,ramal_naive_lin)
Berdasarkan hasil peramalan metode naive linear, dapat disimpulkan bahwa model ini memproyeksikan tren curah hujan bulanan di Kota Balikpapan akan menurun secara linier dalam beberapa periode ke depan.
#Naive Eksponensial
mnaive_eks <- matrix(0, nrow = nrow(data), ncol = 1)
for (i in 1:(nrow(data)-1)){
if (i == 1){
mnaive_eks[i] <- Zt[i]
mnaive_eks[i+1] <- Zt[i+1]
}
else if (i <= length(Zt)){
mnaive_eks[i+1] <- Zt[i] * (Zt[i]/Zt[i-1])
}
else if (i == (length(Zt) + 1)){
mnaive_eks[i+1] <- mnaive_eks[i] * (mnaive_eks[i]/Zt[i-1])
}
else {
mnaive_eks[i+1] <- mnaive_eks[i] * (mnaive_eks[i]/mnaive_eks[i-1])
}
}
pred_naive_eks <- mnaive_eks[1:65]
pred_naive_eks
## [1] 254.400000 217.700000 186.294379 780.472393 33.266400 1244.192058
## [7] 129.117108 458.957838 71.810652 2.260568 2447.775135 67.894925
## [13] 1122.984692 231.279940 19.503122 335.713660 140.667253 185.531818
## [19] 2432.530372 92.909582 16.684581 148.317739 603.506584 32.704377
## [25] 149.890449 216.412208 634.401581 122.293148 578.106148 245.223125
## [31] 1035.046453 498.846939 133.088461 852.300607 140.024815 386.169099
## [37] 249.639696 223.450321 73.215495 205.974889 152.910419 424.657384
## [43] 119.721919 125.039411 1338.600269 397.401345 303.238219 263.437559
## [49] 176.952412 183.901288 203.019324 796.175610 66.574257 72.445122
## [55] 502.348624 339.846154 1080.510638 246.668478 145.864499 155.603448
## [61] 268.821053 230.219513 325.303639 212.689023 312.590320
ramal_naive_eks <- mnaive_eks[66:72]
ramal_naive_eks
## [1] 268.3328 265.3981 262.4954 259.6245 256.7850 253.9766 251.1989
punyaeks<-c(pred_naive_eks,ramal_naive_eks)
Berdasarkan hasil peramalan menggunakan metode naive eksponensial, diperoleh bahwa nilai curah hujan di Kota Balikpapan diprediksi akan mengalami penurunan secara eksponensial yang stabil dalam beberapa periode ke depan. Meskipun data historis menunjukkan fluktuasi yang tajam akibat sensitivitas metode terhadap perubahan rasio antar periode, tren prediksi menunjukkan kecenderungan menurun secara bertahap. Hal ini mencerminkan bahwa metode naive eksponensial sangat peka terhadap pola pertumbuhan data sebelumnya dan lebih cocok digunakan apabila data memiliki tren pertumbuhan atau penurunan eksponensial yang jelas.
YT <- data$Zt[1:65]
jumlah_test <- data$Zt[66:72]
df_plot <- data.frame(
Index = 1:(length(YT) + length(jumlah_test)),
Actual = c(YT, jumlah_test),
Linear = punyalinear,
Exponential = punyaeks
)
ggplot(df_plot, aes(x = Index)) +
geom_line(aes(y = data$Zt), color = "black", size = 1.2) +
geom_line(aes(y = punyalinear), color = "blue", linetype = "dashed", size = 1) +
geom_line(aes(y = punyaeks), color = "red", linetype = "dotted", size = 1) +
labs(title = "Perbandingan Aktual vs Prediksi Linear & Eksponensial",
y = "Pencarian Khong Guan", x = "Index Waktu") +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Gambar di atas menyajikan perbandingan antara data aktual curah hujan bulanan di Kota Balikpapan dengan hasil peramalan menggunakan dua pendekatan sederhana, yaitu metode naive linear dan metode naive eksponensial. Data aktual ditampilkan dalam bentuk garis berwarna hitam, sedangkan hasil prediksi naive linear dan naive eksponensial masing-masing direpresentasikan oleh garis biru putus-putus dan garis merah titik-titik.Â
Secara umum, data aktual menunjukkan pola fluktuatif dengan beberapa lonjakan nilai curah hujan yang cukup signifikan pada periode-periode tertentu. Metode naive linear memberikan hasil peramalan yang relatif stabil dan cenderung mengikuti arah pergerakan data aktual. Meskipun metode ini tidak mampu sepenuhnya menangkap nilai puncak atau lonjakan ekstrem yang terjadi dalam data, hasil prediksinya menunjukkan kesesuaian tren secara visual terhadap data historis. ebaliknya, metode naive eksponensial menghasilkan prediksi yang sangat fluktuatif dan bersifat tidak stabil, terutama pada periode ketika data aktual mengalami perubahan ekstrem. Hal ini disebabkan oleh sensitivitas metode terhadap rasio pertumbuhan antar dua periode sebelumnya, sehingga menghasilkan prediksi dengan nilai yang secara signifikan menyimpang dari data aktual, baik dalam bentuk overestimate maupun underestimate.
smape <- function(actual, forecast) {
mean(2 * abs(forecast - actual) / (abs(actual) + abs(forecast))) * 100
}
eval_model <- function(actual, pred) {
list(
MAPE = round(mape(actual, pred) * 100, 2),
RMSE = round(rmse(actual, pred), 2),
SMAPE = round(smape(actual, pred), 2)
)
}
eval_linear <- eval_model(data$Zt, punyalinear)
eval_exp <- eval_model(data$Zt, punyaeks)
cat("== Evaluasi Linear Trend ==\n")
## == Evaluasi Linear Trend ==
print(eval_linear)
## $MAPE
## [1] 97.47
##
## $RMSE
## [1] 251.02
##
## $SMAPE
## [1] 80.25
cat("\n== Evaluasi Eksponensial Trend ==\n")
##
## == Evaluasi Eksponensial Trend ==
print(eval_exp)
## $MAPE
## [1] 137.18
##
## $RMSE
## [1] 484.44
##
## $SMAPE
## [1] 71.48
hasil_komparasi <- data.frame(
Metode = c("Linear", "Eksponensial"),
MAPE = c(eval_linear$MAPE, eval_exp$MAPE),
RMSE = c(eval_linear$RMSE, eval_exp$RMSE),
SMAPE = c(eval_linear$SMAPE, eval_exp$SMAPE)
)
print(hasil_komparasi)
## Metode MAPE RMSE SMAPE
## 1 Linear 97.47 251.02 80.25
## 2 Eksponensial 137.18 484.44 71.48
Berdasarkan hasil evaluasi terhadap metode naive linear dan naive eksponensial, diperoleh bahwa metode naive linear menunjukkan kinerja peramalan yang lebih baik dalam memodelkan data curah hujan bulanan di Kota Balikpapan. Hal ini ditunjukkan oleh nilai Mean Absolute Percentage Error (MAPE) sebesar 97,47% dan Root Mean Square Error (RMSE) sebesar 251,02, yang masing-masing lebih rendah dibandingkan metode naive eksponensial yang mencatat nilai MAPE sebesar 137,18% dan RMSE sebesar 484,44. Meskipun metode naive eksponensial menghasilkan nilai Symmetric Mean Absolute Percentage Error (SMAPE) yang sedikit lebih kecil, yaitu 71,48% dibandingkan dengan 80,25% pada metode naive linear, namun perbedaan tersebut tidak menggambarkan keunggulan keseluruhan karena nilai error absolut dan kuadratnya lebih besar. Sehingga dapat disimpulkan bahwa metode Naive Linier dinilai lebih akurat dan layak digunakan dalam peramalan data curah hujan di Kota Balikpapan.
#stasioneritas varians
boxcox(Zt~1) #cek stasioner dalam variansi
p<-powerTransform(Zt)
p
## Estimated transformation parameter
## Zt
## 0.5047982
y<-Zt^(p$lambda)
Berdasarkan hasil perhitungan transformasi Box-Cox, dengan selang kepercayaan 95%, didapatkan sebesar 0.5047982. Karena nilai tidak sama dengan 1 maka dapat disimpulkan bahwa tidak stasioner dalam varians dan perlu dilakukan transformasi.
ts.plot(y,ylab="Zt Hasil Transformasi",xlab="Periode")
acf(y,main="",ylab="FOK",144)
pacf(y,main="",ylab="FOKP",144)
#stasioneritas rata-rata
adfTest(y)
##
## Title:
## Augmented Dickey-Fuller Test
##
## Test Results:
## PARAMETER:
## Lag Order: 1
## STATISTIC:
## Dickey-Fuller: -0.7647
## P VALUE:
## 0.3687
##
## Description:
## Tue May 13 18:22:06 2025 by user: nasywa
Berdasaran hasil perhitungan Augmented Dicky-Fuller Test didapatkan P-Value > 0.05. Maka dapat disimpulkan bahwa data tidak stasioner terhadap rata-rata sehingga diperlukan differencing untuk menanganinya.
#Diff 1 kali
datadiff=diff(y,differences=1)
datadiff
## Time Series:
## Start = 2
## End = 65
## Frequency = 1
## [1] -1.23877590 5.75713435 -9.82643044 9.03100721 -4.81147780
## [6] 3.07638795 -5.76290713 -8.24264124 10.60592822 -3.74930049
## [11] 8.50024420 -2.17400490 -8.67936372 4.05876151 -0.39549398
## [16] 0.69953090 12.79666772 -10.01333924 -7.86952123 1.93599689
## [21] 5.90025630 -6.33879543 1.35544082 1.88818728 5.41159460
## [26] -3.90594979 4.49727961 -1.46013942 6.64938699 -0.53827026
## [31] -6.86420503 5.74969740 -5.93920351 1.77345696 -1.04627002
## [36] -0.96138496 -4.33554592 1.33068318 -0.29138691 3.62386032
## [41] -2.95346965 -1.13690323 9.25978122 -0.62410947 -1.67875245
## [46] -1.43951233 -2.33478604 -0.90846192 -0.07216356 5.99873868
## [51] -7.56347452 -2.44550285 5.02477499 1.55090795 6.96364867
## [56] -4.45533958 -4.12711082 -1.49937827 1.29393893 0.07220757
## [61] 1.45299325 -1.02649238 1.08608665 -0.09419032
adfTest(datadiff)
## Warning in adfTest(datadiff): p-value smaller than printed p-value
##
## Title:
## Augmented Dickey-Fuller Test
##
## Test Results:
## PARAMETER:
## Lag Order: 1
## STATISTIC:
## Dickey-Fuller: -8.2937
## P VALUE:
## 0.01
##
## Description:
## Tue May 13 18:22:06 2025 by user: nasywa
Setelah dilakukan differencing 1 kali didapatkan P-Value < 0.05. Maka dapat disimpulkan bahwa data sudah stasioner terhadap rata-rata.
# IDENTIFIKASI MODEL SEMENTARA
acf(datadiff,main="",ylab="FOK",144) #q=1
grid()
Berdasarkan plot ACF, dapat dilihat bahwa pada lag 1 signifikan. Sehingga dapat diketahui bahwa nilai pada orde q paling besar ialah 1 dan orde q yang mungkin adalah 0 dan 1.
pacf(datadiff,main="",ylab="FOKP",144) #p=
grid()
Berdasarkan plot PACF, dapat dilihat bahwa pada lag 1 signifikan. Sehingga dapat diketahui bahwa nilai pada orde p paling besar ialah 1 dan orde p yang mungkin adalah 0 dan 1. Maka diperoleh model ARIMA (0,1,1), ARIMA (1,1,0) dan ARIMA (1,1,1).
# Pengujian Signifikansi Parameter
fit1=arima(x=y,order=c(1,1,0))
fit1
##
## Call:
## arima(x = y, order = c(1, 1, 0))
##
## Coefficients:
## ar1
## -0.3853
## s.e. 0.1140
##
## sigma^2 estimated as 21.79: log likelihood = -189.5, aic = 380.99
coeftest(fit1) #Signifikan
##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## ar1 -0.38530 0.11396 -3.3811 0.000722 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit2=arima(x=y,order=c(0,1,1))
fit2
##
## Call:
## arima(x = y, order = c(0, 1, 1))
##
## Coefficients:
## ma1
## -0.9421
## s.e. 0.0668
##
## sigma^2 estimated as 17.24: log likelihood = -183.02, aic = 368.04
coeftest(fit2) #Signifikan
##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## ma1 -0.942124 0.066769 -14.11 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit3=arima(x=y,order=c(1,1,1))
fit3
##
## Call:
## arima(x = y, order = c(1, 1, 1))
##
## Coefficients:
## ar1 ma1
## 0.2475 -0.9813
## s.e. 0.1290 0.0858
##
## sigma^2 estimated as 16.16: log likelihood = -181.21, aic = 366.41
coeftest(fit3) #Tidak Signifikan
##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## ar1 0.247483 0.129024 1.9181 0.0551 .
## ma1 -0.981331 0.085761 -11.4426 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Berdasarkan pengujian signifikansi parameter, dapat diketahui model ARIMA (1,1,0) dan ARIMA (0,1,1) telah signifikan karena nilai p-value untuk setiap parameter kurang dari taraf signifikan yang telah dientukan yaitu sebesar 0,05. Kemudian dari kedua model yang terbentuk akan dilakukan tahap pengujian diagnostik model.
# PEMERIKSAAAN DIAGNOSTIK
res1=resid(fit1) #Normal Tidak White Noise
shapiro.test(res1)
##
## Shapiro-Wilk normality test
##
## data: res1
## W = 0.98536, p-value = 0.6389
ks.test(res1,"pnorm",mean(res1),sqrt(var(res1)))
##
## Exact one-sample Kolmogorov-Smirnov test
##
## data: res1
## D = 0.090147, p-value = 0.6333
## alternative hypothesis: two-sided
tsdiag(fit1,72)
res2=resid(fit2) #Normal White Noise
shapiro.test(res2)
##
## Shapiro-Wilk normality test
##
## data: res2
## W = 0.98496, p-value = 0.6169
ks.test(res2,"pnorm",mean(res2),sqrt(var(res2)))
##
## Exact one-sample Kolmogorov-Smirnov test
##
## data: res2
## D = 0.094985, p-value = 0.568
## alternative hypothesis: two-sided
tsdiag(fit2,72)
Berdasarkan hasil pengujian normalitas residual menggunakan uji Kolmogorov-Smirnov maka dapat disimpulkan bahwa semua model ARIMA memenuhi asumsi normalitas residual. Kemudian, berdasarkan pengujian white noise menggunakan uji Ljung-Box Test yang memenuhi asumsi normalitas dan white noise adalah model ARIMA (0,1,1).
#Evaluasi Model In-Sample
predfit2<-fitted(fit2)^(1/p$lambda)
Mape2<-MAPE(predfit2,Zt)*100
aic2<-fit2$aic
hasil<-data.frame(
Model=c("ARIMA(0,1,1)"),
MAPE=c(Mape2),
AIC=c(aic2)
)
hasil
## Model MAPE AIC
## 1 ARIMA(0,1,1) 58.81631 368.0448
Berdasarkan hasil evaluasi model ARIMA, diperoleh nilai MAPE sebesar 58,81631 dan AIC sebesar 368,0448 untuk model ARIMA (0,1,1).Â
#Terpilih Model ARIMA (0,1,1) Sebagai Model Terbaik
rtnorm <- function(n, mean, sd, a = -Inf, b = Inf){qnorm(runif(n, pnorm(a, mean, sd), pnorm(b, mean, sd)), mean, sd)}
set.seed(1)
nilai <- rtnorm(n=19, mean=mean(res2), sd=sd(res2), a=min(res2), max(res2))
nilai #residual bangkitan untuk hitung arima
## [1] -2.3504375 -1.1136714 0.9887196 5.6868125 -3.2105726 5.4544517
## [7] 6.7524878 1.9406152 1.5899053 -6.0803133 -3.1482965 -3.5920776
## [13] 2.2403312 -0.9837626 3.2720889 0.2077295 2.6039317 9.7347761
## [19] -1.0277414
Berdasarkan hasil pengujian normalitas residual dan white noise maka diperoleh model ARIMA terbaik yaitu ARIMA (0,1,1).
Setelah didapatkan model ARIMA terbaik yang memenuhi asumsi normalitas residual dan white noise, kemudian dilakukan prediksi dan peramalan menggunakan model ARIMA (0,1,1).
prediksisesudah=predict(fit2,n.ahead=19)
x=prediksisesudah$pred+nilai
x
## Time Series:
## Start = 66
## End = 84
## Frequency = 1
## [1] 14.09023 15.32700 17.42939 22.12748 13.23010 21.89512 23.19316 18.38128
## [9] 18.03057 10.36036 13.29237 12.84859 18.68100 15.45691 19.71276 16.64840
## [17] 19.04460 26.17545 15.41293
Peramalan<-((x)^(1/(p$lambda)))
Peramalan
## Time Series:
## Start = 66
## End = 84
## Frequency = 1
## [1] 188.7968 223.0376 287.7179 461.6322 166.6497 452.0786 506.7147 319.6798
## [9] 307.7101 102.6707 168.2073 157.2646 330.0884 226.7980 367.1816 262.7399
## [17] 342.9372 643.9220 225.5215
predikramal<-c(predfit2,Peramalan)
predikramal<-ts(data.frame(predikramal))
predikramal
## Time Series:
## Start = 1
## End = 84
## Frequency = 1
## predikramal
## [1,] 253.8963
## [2,] 244.1317
## [3,] 260.6506
## [4,] 266.8509
## [5,] 248.9993
## [6,] 262.3634
## [7,] 260.3951
## [8,] 261.0075
## [9,] 237.2786
## [10,] 207.9528
## [11,] 206.0012
## [12,] 201.1815
## [13,] 213.4625
## [14,] 216.1698
## [15,] 203.0655
## [16,] 199.2219
## [17,] 195.3166
## [18,] 195.9920
## [19,] 217.4803
## [20,] 217.8080
## [21,] 204.5131
## [22,] 196.7899
## [23,] 198.9163
## [24,] 190.5224
## [25,] 185.2789
## [26,] 183.9028
## [27,] 190.9647
## [28,] 191.6075
## [29,] 199.3803
## [30,] 204.6823
## [31,] 220.8290
## [32,] 235.2106
## [33,] 237.0901
## [34,] 248.8506
## [35,] 249.4237
## [36,] 253.1153
## [37,] 254.6866
## [38,] 254.3396
## [39,] 246.3117
## [40,] 241.2087
## [41,] 236.0125
## [42,] 237.3802
## [43,] 233.5586
## [44,] 228.1532
## [45,] 238.9118
## [46,] 248.1367
## [47,] 253.9553
## [48,] 256.8850
## [49,] 255.4570
## [50,] 252.4981
## [51,] 249.6277
## [52,] 257.5684
## [53,] 251.5535
## [54,] 241.6995
## [55,] 241.2533
## [56,] 243.5488
## [57,] 258.0626
## [58,] 263.9536
## [59,] 262.0423
## [60,] 257.5552
## [61,] 255.6705
## [62,] 254.0319
## [63,] 255.0778
## [64,] 254.2346
## [65,] 255.3763
## [66,] 188.7968
## [67,] 223.0376
## [68,] 287.7179
## [69,] 461.6322
## [70,] 166.6497
## [71,] 452.0786
## [72,] 506.7147
## [73,] 319.6798
## [74,] 307.7101
## [75,] 102.6707
## [76,] 168.2073
## [77,] 157.2646
## [78,] 330.0884
## [79,] 226.7980
## [80,] 367.1816
## [81,] 262.7399
## [82,] 342.9372
## [83,] 643.9220
## [84,] 225.5215
#Mape Out-Sample
MapeOut<-MAPE(Peramalan[1:7],data$Zt[66:72])*100
MapeOut
## [1] 173.7779
#Plot
plot(predikramal,ylim=c(min(data$Zt),max(data$Zt)),main="Aktual vs Prediksi",xlab= "Waktu",ylab="Curah Hujan Bulanan Kota Balikpapan",col="white")
points(predikramal,cex=1,col="coral2",pch=19)
lines(predikramal,col="coral2",lwd=2)
points(data$Zt,cex=1,col="black",pch=19)
lines(data$Zt,col="black",lwd=2,cex=1.5)
legend("topleft",legend=c("Prediksi","Aktual"),cex=1,lty=1,col=c("coral2","black"),pch=10)
grid()
Berdasarkan grafik perbandingan data aktual dan data prediksi curah hujan bulanan Kota Balikpapan, terlihat bahwa pola prediksi secara umum belum sepenuhnya mengikuti pola fluktuatif data aktual. Meskipun pada beberapa titik prediksi tampak mendekati nilai aktual, secara keseluruhan hasil prediksi cenderung lebih halus dan tidak mampu menangkap lonjakan maupun penurunan tajam yang terjadi pada data aktual. Hal ini terlihat terutama pada periode awal hingga pertengahan waktu pengamatan, di mana variabilitas data aktual cukup tinggi namun tidak tercermin pada pola prediksi. Sementara itu, pada bagian akhir grafik, hasil peramalan menunjukkan kecenderungan meningkat secara bertahap, namun dengan pola yang relatif lebih stabil atau konstan dibandingkan pola data aktual yang fluktuatif. Dengan demikian, dapat disimpulkan bahwa model prediksi masih memiliki keterbatasan dalam merepresentasikan pergerakan dari data aktual, terutama dalam merespons perubahan ekstrem.
library(neuralnet)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:neuralnet':
##
## compute
## The following object is masked from 'package:car':
##
## recode
## The following object is masked from 'package:MASS':
##
## select
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
#### STANDARISASI DATA ####
max<-max(Zt)
min<-min(Zt)
Yt = 2*((as.numeric(Zt) - min)/(max - min))-1
#PREPROCESSING STANDARDIZED#
y = data.frame(
nilai_asli = Yt
) %>%
mutate(
nilai_lag = dplyr::lag(nilai_asli, n = 1, default = NA)
)
#### Splitting data
trainy = y[1:65,]
trainy = na.omit(trainy)
testy = y[66:72,]
## Tahap Prediksi
### 1 *hidden layer*
#### NN(1)
predict_NN1 = ts(mlp_1_1$net.result[[1]])
kembali_NN1 = ((predict_NN1 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(2)
predict_NN2 = ts(mlp_1_2$net.result[[1]])
kembali_NN2 = ((predict_NN2 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(3)
predict_NN3 = ts(mlp_1_3$net.result[[1]])
kembali_NN3 = ((predict_NN3 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
### 2 *hidden layer*
#### NN(1,1)
predict_NN_1_1 = ts(mlp_2_1_1$net.result[[1]])
kembali_NN_1_1 = ((predict_NN_1_1 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(1,2)
predict_NN_1_2 = ts(mlp_2_1_2$net.result[[1]])
kembali_NN_1_2 = ((predict_NN_1_2 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(1,3)
predict_NN_1_3 = ts(mlp_2_1_3$net.result[[1]])
kembali_NN_1_3 = ((predict_NN_1_3 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(2,1)
predict_NN_2_1 = ts(mlp_2_2_1$net.result[[1]])
kembali_NN_2_1 = ((predict_NN_2_1 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(2,2)
predict_NN_2_2 = ts(mlp_2_2_2$net.result[[1]])
kembali_NN_2_2 = ((predict_NN_2_2 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
#### NN(2,3)
predict_NN_2_3 = ts(mlp_2_2_3$net.result[[1]])
kembali_NN_2_3 = ((predict_NN_2_3 + 1) / 2) * (max(Zt) - min(Zt)) + min(Zt)
## Pemilihan Model NN Terbaik
model_names <- c(
"NN(1)", "NN(2)", "NN(3)",
"NN(1,1)", "NN(1,2)", "NN(1,3)",
"NN(2,1)", "NN(2,2)", "NN(2,3)"
)
# Buat list hasil prediksi yang sesuai
hasil_prediksi <- list(
kembali_NN1, kembali_NN2, kembali_NN3,
kembali_NN_1_1, kembali_NN_1_2, kembali_NN_1_3,
kembali_NN_2_1, kembali_NN_2_2, kembali_NN_2_3
)
# Data aktual
aktual <- ts(Zt[2:65])
# Inisialisasi vektor kosong untuk menyimpan hasil
MAPE_vals <- numeric(length(hasil_prediksi))
RMSE_vals <- numeric(length(hasil_prediksi))
SMAPE_vals <- numeric(length(hasil_prediksi))
# Hitung semua metrik
for (i in seq_along(hasil_prediksi)) {
pred <- ts(hasil_prediksi[[i]])
MAPE_vals[i] <- MAPE(pred, aktual) * 100
RMSE_vals[i] <- RMSE(pred, aktual)
SMAPE_vals[i] <- smape(aktual, pred) * 100
}
# Buat data frame hasil evaluasi
hasil_evaluasi <- data.frame(
Model = model_names,
MAPE = round(MAPE_vals, 2),
RMSE = round(RMSE_vals, 4),
SMAPE = round(SMAPE_vals, 2)
)
# Cetak hasil evaluasi sebagai satu output
print(hasil_evaluasi)
## Model MAPE RMSE SMAPE
## 1 NN(1) 63.42 122.4663 3832.83
## 2 NN(2) 64.10 122.7979 3850.68
## 3 NN(3) 63.48 122.4355 3830.59
## 4 NN(1,1) 64.86 122.5485 3873.60
## 5 NN(1,2) 64.24 122.7222 3845.55
## 6 NN(1,3) 63.76 122.6147 3838.35
## 7 NN(2,1) 64.31 122.7408 3848.01
## 8 NN(2,2) 63.60 122.6754 3838.75
## 9 NN(2,3) 60.99 118.7507 3610.32
Berdasarkan perbandingan ukuran akurasi model dengan menggunakan tiga metrik evaluasi, yaitu MAPE, SMAPE, dan RMSE, terlihat bahwa model NN(2,3) memiliki nilai MAPE sebesar 60,99%, RMSE sebesar 118,7507, dan SMAPE sebesar 3610,32, yang lebih rendah dibandingkan dengan model-model lainnya. Sehingga dapat disimpulkan bahwa model neural network dengan 2 neuron pada input layer dan 3 neuron pada hidden layer merupakan model terbaik diantara delapan model lainnya.
#Pakai Model Terbaik
## Peramalan NN(2,3)
last_lag = tail(trainy$nilai_asli, 1)
forecast_normalized <- numeric(19)
current_lag = last_lag
for (i in 1:19) {
new_data = data.frame(nilai_lag = current_lag)
pred = neuralnet::compute(mlp_2_2_3, covariate = new_data)
forecast_normalized[i] = pred$net.result[1, 1]
current_lag = forecast_normalized[i]
}
forecast_denormalized = ((forecast_normalized + 1) / 2) * (max - min) + min
## Grafik prediksi dan Peramalan *Neural Newtork*
Hasil_NN = ts(c(NA,kembali_NN_2_3,forecast_denormalized[1:7],forecast_denormalized[8:19]))
plot(1:72,data$Zt, type = "l", main = "Grafik Prediksi dan Peramalan NN", ylab = "Nilai Kurs IDR", xlab = "Time") +
points(data$Zt, cex = 0.9, pch = 21) +
lines(1:65,Hasil_NN[1:65], col = "blue") +
lines(66:72,Hasil_NN[66:72], col = "red") +
lines(73:84,Hasil_NN[73:84], col = "green") +
abline(v = 65, lty = 2) +
abline(v = 72, lty = 2)
## integer(0)
legend("topleft", legend = c("Data aktual","Prediksi In sample", "Prediksi Out Sample", "Peramalan"),
col = c("black","blue","red","green"), lty = 1, pch = 20, lwd = 3, bty = "o", cex = 0.8)
grid()
Berdasarkan grafik perbandingan diatas, terlihat bahwa pola prediksi in-sample cukup mengikuti pergerakan data aktual, terutama dalam menangkap trend musiman dan fluktuasi sedang. Namun demikian model belum sepenuhnya mampu merepresentasikan variasi ekstrem yang terjadi pada data aktual, seperti lonjakan tajam dan penurunan curah hujan yang terjadi secara tidak teratur. Hal ini mengindikasikan bahwa kemampuan model dalam menangkap karakteristik non-linier dan ketidakstabilan data masih terbatas.sementara itu pada data out-sample, hasil prediksi terlihat cenderung lebih rata dan tidak mencerminkan fluktuasi data aktual secara akurat, yang menunjukkan bahwa model mengalami penurunan akurasi saat diuji pada data yang tidak digunakan dalam pelatihan. Hasil peramalan untuk periode mendatang (garis hijau) menunjukkan pola yang relatif konstan, tanpa adanya proyeksi variasi musiman yang tajam, sehingga mengindikasikan bahwa model cenderung memberikan hasil prediksi yang relatif stabil untuk masa depan.
## Evaluasi model NN terbaik
# Hitung metrik evaluasi untuk in-sample
MAPE_in <- MAPE(ts(kembali_NN_2_3), ts(Zt[2:65])) * 100
RMSE_in <- RMSE(ts(kembali_NN_2_3), ts(Zt[2:65]))
SMAPE_in <- smape(ts(Zt[2:65]), ts(kembali_NN_2_1)) * 100
# Hitung metrik evaluasi untuk out-sample
MAPE_out <- MAPE(forecast_denormalized[1:7], data$Zt[66:72]) * 100
RMSE_out <- RMSE(forecast_denormalized[1:7], data$Zt[66:72])
SMAPE_out <- smape(data$Zt[66:72], forecast_denormalized[1:7]) * 100
# Gabungkan ke dalam data frame
evaluasi_neural <- data.frame(
Dataset = c("In-Sample", "Out-Sample"),
MAPE = round(c(MAPE_in, MAPE_out), 2),
RMSE = round(c(RMSE_in, RMSE_out), 4),
SMAPE = round(c(SMAPE_in, SMAPE_out), 2)
)
# Cetak hasil
print(evaluasi_neural)
## Dataset MAPE RMSE SMAPE
## 1 In-Sample 60.99 118.7507 3848.01
## 2 Out-Sample 102.58 121.6942 5863.83
Berdasarkan hasil evaluasi model Neural Network terbaik, pada data In-Sample diperoleh nilai MAPE sebesar 60,99%, RMSE sebesar 118,7507, dan SMAPE sebesar 3848,01. Sedangkan pada data Out-Sample diperoleh nilai Mape sebesar 102,58%, RMSE sebesar 121,6942, dan SMAPE sebesar 5863,83. Dengan demikian, dapat disimpulkan bahwa model menunjukkan performa yang lebih baik pada data in-sample, yang mengindikasikan bahwa akurasi peramalan lebih tinggi ketika model diterapkan pada data yang digunakan dalam proses pelatihan.
Berdasarkan hasil penelitian, dapat diperoleh hasil tiga metode peramalan yang digunakan yaitu Naive Trend, ARIMA dan Neural Network. Dari hasil evaluasi diperoleh metode Naive Trend memberikan hasil peramalan yang relatif stabil dan cenderung mengikuti arah pergerakan data aktual namun tidak mampu sepenuhnya menangkap nilai puncak atau lonjakan ekstrem yang terjadi dalam data, sementara ARIMA (0,1,1) menunjukkan perfoma paling stabil dan akurat pada data in sampel dengan MAPE sebesar 58,82% meskipun akurasi menurun pada saat menggunakan data out sample, dan model Neural Network menunjukkan perfoma baik pada data in sample, namun kurang akurat saat diuji pada data out sample. Oleh karena itu, ARIMA (0,1,1) menjadi model terbaik dalam meramalkan curah hujan bulanan di kota Balikpapan.
Lumintang, I. A., Windah, R. L., & Silfiani, M. (2024). Perbandingan Beberapa Metode Univariat Time Series Pada peramalan Curah Hujan. Jurnal Statistika dan Komputasi. 6(1). 1-10.
Ruhiat, D. (2022). Implementasi Distribusi Peluang Gumber Untuk Analisis data Curah Hujan Rencana. Teorema: Teori dan Riset Matematika. 7(1). 213-224.