Peramalan Penerimaan Pajak Pertambahan Nilai (PPN) Menggunakan Metode Brown’s Double Exponential Smoothing (B-DES)

2. Library

library(readr)
library(dplyr)
library(forecast)

data_ppn <- read_csv(
  "C:/Users/rizki/OneDrive/Documents/MAGANG (smt 5)/SEMESTER 5/Laporan Akhir/Mini Projek/sby.csv"
)

head(data_ppn)

## # A tibble: 6 × 3
##   Tahun Bulan            PPN
##   <dbl> <chr>          <dbl>
## 1  2019 Januari  39000000000
## 2  2019 Februari 34000000000
## 3  2019 Maret    34000000000
## 4  2019 April    29000000000
## 5  2019 Mei      42000000000
## 6  2019 Juni     29000000000

ppn_ts <- ts(
  as.numeric(data_ppn$PPN),
  start = c(2019, 1),
  frequency = 12
)

ppn_ts

##          Jan     Feb     Mar     Apr     May     Jun     Jul     Aug     Sep
## 2019 3.9e+10 3.4e+10 3.4e+10 2.9e+10 4.2e+10 2.9e+10 4.4e+10 3.9e+10 4.0e+10
## 2020 6.4e+10 4.5e+10 4.0e+10 4.6e+10 3.0e+10 4.3e+10 4.5e+10 4.2e+10 4.2e+10
## 2021 4.7e+10 5.5e+10 4.8e+10 4.3e+10 3.0e+10 4.6e+10 5.2e+10 5.1e+10 4.8e+10
## 2022 3.5e+10 3.3e+10 3.3e+10 3.9e+10 2.8e+10 3.2e+10 4.1e+10 3.5e+10 3.6e+10
## 2023 5.4e+10 3.7e+10 3.0e+10 3.6e+10 2.3e+10 1.5e+10 1.9e+10 2.5e+10 2.8e+10
##          Oct     Nov     Dec
## 2019 4.3e+10 4.2e+10 3.6e+10
## 2020 4.4e+10 5.2e+10 5.0e+10
## 2021 5.3e+10 5.8e+10 3.5e+10
## 2022 3.5e+10 3.8e+10 4.6e+10
## 2023 3.0e+10 3.9e+10 3.6e+10

plot(
  ppn_ts,
  main = "Penerimaan PPN Bulanan 2019–2023",
  xlab = "Waktu",
  ylab = "Jumlah PPN",
  col = "black"
)
points(ppn_ts, pch = 20, col = "blue")

df_des_all <- data.frame()
small_rmse_des <- Inf

alpha_range <- seq(0.1, 0.9, by = 0.01)
beta_range  <- seq(0.1, 0.9, by = 0.01)

for (a in alpha_range) {
  for (b in beta_range) {
    
    model_des <- HoltWinters(
      ppn_ts,
      alpha = a,
      beta  = b,
      gamma = FALSE
    )
    
    sse  <- model_des$SSE
    mse  <- sse / length(ppn_ts)
    rmse <- sqrt(mse)
    
    df_des_all <- rbind(
      df_des_all,
      data.frame(
        Alpha = a,
        Beta  = b,
        SSE   = sse,
        MSE   = mse,
        RMSE  = rmse
      )
    )
    
    if (rmse < small_rmse_des) {
      small_rmse_des <- rmse
      AlphaOpt <- a
      BetaOpt  <- b
    }
  }
}
NilaiOptDES <- data.frame(
  AlphaOpt = AlphaOpt,
  BetaOpt  = BetaOpt
)

NilaiOptDES

##   AlphaOpt BetaOpt
## 1     0.66     0.1

df_des_all %>%
  arrange(RMSE) %>%
  select(Alpha, Beta, RMSE) %>%
  slice(1:5)

##   Alpha Beta       RMSE
## 1  0.66  0.1 8881783451
## 2  0.67  0.1 8882361223
## 3  0.65  0.1 8882477974
## 4  0.68  0.1 8884184278
## 5  0.64  0.1 8884473116

model_des_opt <- HoltWinters(
  ppn_ts,
  alpha = AlphaOpt,
  beta  = BetaOpt,
  gamma = FALSE
)

model_des_opt

## Holt-Winters exponential smoothing with trend and without seasonal component.
## 
## Call:
## HoltWinters(x = ppn_ts, alpha = AlphaOpt, beta = BetaOpt, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.66
##  beta : 0.1
##  gamma: FALSE
## 
## Coefficients:
##          [,1]
## a 35834776622
## b   349855331

ppn_fitted <- data.frame(
  Aktual = as.numeric(ppn_ts),
  Fitted = c(NA, NA, model_des_opt$fitted[,1])
)

head(ppn_fitted)

##    Aktual      Fitted
## 1 3.9e+10          NA
## 2 3.4e+10          NA
## 3 3.4e+10 29000000000
## 4 2.9e+10 27630000000
## 5 4.2e+10 23954620000
## 6 2.9e+10 32475985880

forecast_des_2024 <- forecast(
  model_des_opt,
  h = 12,
  level = c(80, 95)
)

forecast_des_2024

##          Point Forecast       Lo 80       Hi 80        Lo 95        Hi 95
## Jan 2024    36184631954 24647070174 47722193733  18539453901  53829810006
## Feb 2024    36534487285 22276954944 50792019625  14729473232  58339501338
## Mar 2024    36884342616 19949890043 53818795189  10985332359  62783352873
## Apr 2024    37234197947 17618632722 56849763171   7234779734  67233616160
## May 2024    37584053278 15258707265 59909399291   3440382976  71727723580
## Jun 2024    37933908609 12856280904 63011536315   -419013303  76286830522
## Jul 2024    38283763940 10403141458 66164386422  -4355968553  80923496434
## Aug 2024    38633619272  7894298014 69372940529  -8378115717  85645354260
## Sep 2024    38983474603  5326716051 72640233155 -12490095694  90457044900
## Oct 2024    39333329934  2698600709 75968059158 -16694653484  95361313352
## Nov 2024    39683185265     8967698 79357402832 -20993294430 100359664960
## Dec 2024    40033040596 -2742624910 82808706102 -25386694404 105452775596

forecast_des_table <- data.frame(
  Bulan = seq(
    as.Date("2024-01-01"),
    by = "month",
    length.out = 12
  ),
  Forecast_PPN = as.numeric(forecast_des_2024$mean),
  Lower_80 = as.numeric(forecast_des_2024$lower[,1]),
  Upper_80 = as.numeric(forecast_des_2024$upper[,1]),
  Lower_95 = as.numeric(forecast_des_2024$lower[,2]),
  Upper_95 = as.numeric(forecast_des_2024$upper[,2])
)

forecast_des_table

##         Bulan Forecast_PPN    Lower_80    Upper_80     Lower_95     Upper_95
## 1  2024-01-01  36184631954 24647070174 47722193733  18539453901  53829810006
## 2  2024-02-01  36534487285 22276954944 50792019625  14729473232  58339501338
## 3  2024-03-01  36884342616 19949890043 53818795189  10985332359  62783352873
## 4  2024-04-01  37234197947 17618632722 56849763171   7234779734  67233616160
## 5  2024-05-01  37584053278 15258707265 59909399291   3440382976  71727723580
## 6  2024-06-01  37933908609 12856280904 63011536315   -419013303  76286830522
## 7  2024-07-01  38283763940 10403141458 66164386422  -4355968553  80923496434
## 8  2024-08-01  38633619272  7894298014 69372940529  -8378115717  85645354260
## 9  2024-09-01  38983474603  5326716051 72640233155 -12490095694  90457044900
## 10 2024-10-01  39333329934  2698600709 75968059158 -16694653484  95361313352
## 11 2024-11-01  39683185265     8967698 79357402832 -20993294430 100359664960
## 12 2024-12-01  40033040596 -2742624910 82808706102 -25386694404 105452775596

ts.plot(
  ppn_ts,
  col = "black",
  lwd = 2,
  xlab = "Waktu",
  ylab = "Jumlah PPN",
  main = "Brown Double Exponential Smoothing PPN"
)

lines(
  ts(ppn_fitted$Fitted, start = c(2019,1), frequency = 12),
  col = "blue",
  lwd = 2
)

lines(
  forecast_des_2024$mean,
  col = "red",
  lwd = 2
)

legend(
  "topleft",
  legend = c("Aktual", "Smooth DES", "Forecast DES 2024"),
  col = c("black", "blue", "red"),
  lwd = c(2,2,2),
  bty = "n"
)

checkresiduals(model_des_opt)

## 
##  Ljung-Box test
## 
## data:  Residuals from HoltWinters
## Q* = 6.0588, df = 12, p-value = 0.9131
## 
## Model df: 0.   Total lags used: 12

train_ppn <- window(ppn_ts, end = c(2022, 12))
test_ppn  <- window(ppn_ts, start = c(2023, 1))

model_des_train <- HoltWinters(
  train_ppn,
  alpha = AlphaOpt,
  beta  = BetaOpt,
  gamma = FALSE
)

forecast_des_test <- forecast(
  model_des_train,
  h = length(test_ppn)
)

accuracy(
  forecast_des_test,
  test_ppn
)

##                        ME        RMSE         MAE        MPE     MAPE      MASE
## Training set   1774678047  8996626822  6753034885   2.119993 16.36561 0.6642329
## Test set     -14335018543 17698625214 16134777790 -63.337185 66.67007 1.5870273
##                    ACF1 Theil's U
## Training set -0.1338451        NA
## Test set      0.4518360  3.289082

Peramalan Penerimaan Pajak Pertambahan Nilai (PPN) Menggunakan Metode Brown’s Double Exponential Smoothing (B-DES)

Rizki Wahyu

2026-01-01

1. Latar Belakang

2. Library