#Pemodelan TSR Dengan Variabel Dummy
library(MASS)
## Warning: package 'MASS' was built under R version 4.3.1
library(hms)
## Warning: package 'hms' was built under R version 4.3.1
library(car)
## Warning: package 'car' was built under R version 4.3.1
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.1
library(forecast)
## Warning: package 'forecast' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(tseries)
## Warning: package 'tseries' was built under R version 4.3.3
library(timeSeries)
## Loading required package: timeDate
## Warning: package 'timeDate' was built under R version 4.3.3
##
## Attaching package: 'timeSeries'
## The following objects are masked from 'package:graphics':
##
## lines, points
library(quadprog)
## Warning: package 'quadprog' was built under R version 4.3.1
library(zoo)
## Warning: package 'zoo' was built under R version 4.3.1
##
## Attaching package: 'zoo'
## The following object is masked from 'package:timeSeries':
##
## time<-
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(fracdiff)
## Warning: package 'fracdiff' was built under R version 4.3.3
library(fUnitRoots)
## Warning: package 'fUnitRoots' was built under R version 4.3.3
library(lmtest)
## Warning: package 'lmtest' was built under R version 4.3.1
library(RcmdrMisc)
## Warning: package 'RcmdrMisc' was built under R version 4.3.3
## Loading required package: sandwich
## Warning: package 'sandwich' was built under R version 4.3.1
##
## Attaching package: 'RcmdrMisc'
## The following object is masked from 'package:forecast':
##
## CV
data<-read.table(file.choose(),header=TRUE)
head(data)
## Tanggal Terakhir D1 D2 D3 t
## 1 1/8/2010 3081.88 0 0 0 1
## 2 1/9/2010 3501.30 0 0 0 2
## 3 1/10/2010 3635.32 0 0 0 3
## 4 1/11/2010 3531.21 0 0 0 4
## 5 1/12/2010 3703.51 0 0 0 5
## 6 1/1/2011 3409.17 0 0 0 6
data
## Tanggal Terakhir D1 D2 D3 t
## 1 1/8/2010 3081.88 0 0 0 1
## 2 1/9/2010 3501.30 0 0 0 2
## 3 1/10/2010 3635.32 0 0 0 3
## 4 1/11/2010 3531.21 0 0 0 4
## 5 1/12/2010 3703.51 0 0 0 5
## 6 1/1/2011 3409.17 0 0 0 6
## 7 1/2/2011 3470.35 0 0 0 7
## 8 1/3/2011 3678.67 0 0 0 8
## 9 1/4/2011 3819.62 0 0 0 9
## 10 1/5/2011 3836.97 0 0 0 10
## 11 1/6/2011 3888.57 0 0 0 11
## 12 1/7/2011 4130.80 0 0 0 12
## 13 1/8/2011 3841.73 0 0 0 13
## 14 1/9/2011 3549.03 0 0 0 14
## 15 1/10/2011 3790.85 0 0 0 15
## 16 1/11/2011 3715.08 0 0 0 16
## 17 1/12/2011 3821.99 0 0 0 17
## 18 1/1/2012 3941.69 0 0 0 18
## 19 1/2/2012 3985.21 0 0 0 19
## 20 1/3/2012 4121.55 0 0 0 20
## 21 1/4/2012 4180.73 0 0 0 21
## 22 1/5/2012 3832.82 0 0 0 22
## 23 1/6/2012 3955.58 0 0 0 23
## 24 1/7/2012 4142.34 0 0 0 24
## 25 1/8/2012 4060.33 0 0 0 25
## 26 1/9/2012 4262.56 0 0 0 26
## 27 1/10/2012 4350.29 0 0 0 27
## 28 1/11/2012 4276.14 0 0 0 28
## 29 1/12/2012 4316.69 0 0 0 29
## 30 1/1/2013 4453.70 0 0 0 30
## 31 1/2/2013 4795.79 0 0 0 31
## 32 1/3/2013 4940.99 0 0 0 32
## 33 1/4/2013 5034.07 0 0 0 33
## 34 1/5/2013 5068.63 0 0 0 34
## 35 1/6/2013 4818.90 0 0 0 35
## 36 1/7/2013 4610.38 1 0 0 36
## 37 1/8/2013 4195.09 0 0 0 37
## 38 1/9/2013 4316.18 0 0 0 38
## 39 1/10/2013 4510.63 0 0 0 39
## 40 1/11/2013 4256.44 0 0 0 40
## 41 1/12/2013 4274.18 0 0 0 41
## 42 1/1/2014 4418.76 0 0 0 42
## 43 1/2/2014 4620.22 0 0 0 43
## 44 1/3/2014 4768.28 0 0 0 44
## 45 1/4/2014 4840.15 0 0 0 45
## 46 1/5/2014 4893.91 0 0 0 46
## 47 1/6/2014 4878.58 0 0 0 47
## 48 1/7/2014 5088.80 0 1 0 48
## 49 1/8/2014 5136.86 0 0 0 49
## 50 1/9/2014 5137.58 0 0 0 50
## 51 1/10/2014 5089.55 0 0 0 51
## 52 1/11/2014 5149.89 0 0 0 52
## 53 1/12/2014 5226.95 0 0 0 53
## 54 1/1/2015 5289.40 0 0 0 54
## 55 1/2/2015 5450.29 0 0 0 55
## 56 1/3/2015 5518.67 0 0 0 56
## 57 1/4/2015 5086.42 0 0 0 57
## 58 1/5/2015 5216.38 0 0 0 58
## 59 1/6/2015 4910.66 0 0 0 59
## 60 1/7/2015 4802.53 0 0 1 60
## 61 1/8/2015 4509.61 0 0 0 61
## 62 1/9/2015 4223.91 0 0 0 62
## 63 1/10/2015 4455.18 0 0 0 63
## 64 1/11/2015 4446.46 0 0 0 64
## 65 1/12/2015 4593.01 0 0 0 65
## 66 1/1/2016 4615.16 0 0 0 66
## 67 1/2/2016 4770.96 0 0 0 67
## 68 1/3/2016 4845.37 0 0 0 68
## 69 1/4/2016 4838.58 0 0 0 69
## 70 1/5/2016 4796.87 0 0 0 70
## 71 1/6/2016 5016.65 0 0 0 71
## 72 1/7/2016 5215.99 0 0 0 72
## 73 1/8/2016 5386.08 0 0 0 73
## 74 1/9/2016 5364.80 0 0 0 74
## 75 1/10/2016 5422.54 0 0 0 75
## 76 1/11/2016 5148.91 0 0 0 76
## 77 1/12/2016 5296.71 0 0 0 77
## 78 1/1/2017 5294.10 0 0 0 78
## 79 1/2/2017 5386.69 0 0 0 79
## 80 1/3/2017 5568.11 0 0 0 80
## 81 1/4/2017 5685.30 0 0 0 81
## 82 1/5/2017 5738.15 0 0 0 82
## 83 1/6/2017 5829.71 0 0 0 83
## 84 1/7/2017 5840.94 0 0 0 84
## 85 1/8/2017 5864.06 0 0 0 85
## 86 1/9/2017 5900.85 0 0 0 86
## 87 1/10/2017 6005.78 0 0 0 87
## 88 1/11/2017 5952.14 0 0 0 88
## 89 1/12/2017 6355.65 0 0 0 89
## 90 1/1/2018 6605.63 0 0 0 90
## 91 1/2/2018 6597.22 0 0 0 91
## 92 1/3/2018 6188.99 0 0 0 92
## 93 1/4/2018 5994.60 1 0 0 93
## 94 1/5/2018 5983.59 0 0 0 94
## 95 1/6/2018 5799.24 0 0 0 95
## 96 1/7/2018 5936.44 0 0 0 96
## 97 1/8/2018 6018.46 0 0 0 97
## 98 1/9/2018 5976.55 0 0 0 98
## 99 1/10/2018 5831.65 0 0 0 99
## 100 1/11/2018 6056.12 0 0 0 100
## 101 1/12/2018 6194.50 0 0 0 101
## 102 1/1/2019 6532.97 0 0 0 102
## 103 1/2/2019 6443.35 0 0 0 103
## 104 1/3/2019 6468.75 0 0 0 104
## 105 1/4/2019 6455.35 0 1 0 105
## 106 1/5/2019 6209.12 0 0 0 106
## 107 1/6/2019 6358.63 0 0 0 107
## 108 1/7/2019 6390.50 0 0 0 108
## 109 1/8/2019 6328.47 0 0 0 109
## 110 1/9/2019 6169.10 0 0 0 110
## 111 1/10/2019 6228.32 0 0 0 111
## 112 1/11/2019 6011.83 0 0 0 112
## 113 1/12/2019 6299.54 0 0 0 113
## 114 1/1/2020 5940.05 0 0 0 114
## 115 1/2/2020 5452.70 0 0 0 115
## 116 1/3/2020 4538.93 0 0 0 116
## 117 1/4/2020 4716.40 0 0 1 117
## 118 1/5/2020 4753.61 0 0 0 118
## 119 1/6/2020 4905.39 0 0 0 119
## 120 1/7/2020 5149.63 0 0 0 120
## 121 1/8/2020 5238.49 0 0 0 121
## 122 1/9/2020 4870.04 0 0 0 122
## 123 1/10/2020 5128.23 0 0 0 123
## 124 1/11/2020 5612.42 0 0 0 124
## 125 1/12/2020 5979.07 0 0 0 125
## 126 1/1/2021 5862.35 0 0 0 126
## 127 1/2/2021 6241.80 0 0 0 127
## 128 1/3/2021 5985.52 0 0 0 128
## 129 1/4/2021 5995.62 0 0 0 129
## 130 1/5/2021 5947.46 0 0 0 130
## 131 1/6/2021 5985.49 0 0 0 131
## 132 1/7/2021 6070.04 0 0 0 132
## 133 1/8/2021 6150.30 0 0 0 133
## 134 1/9/2021 6286.94 0 0 0 134
## 135 1/10/2021 6591.35 0 0 0 135
## 136 1/11/2021 6533.93 0 0 0 136
## 137 1/12/2021 6581.48 0 0 0 137
## 138 1/1/2022 6631.15 0 0 0 138
## 139 1/2/2022 6888.17 0 0 0 139
## 140 1/3/2022 7071.44 0 0 0 140
## 141 1/4/2022 7228.91 0 0 0 141
## 142 1/5/2022 7148.97 0 0 0 142
## 143 1/6/2022 6911.58 0 0 0 143
## 144 1/7/2022 6951.12 0 0 0 144
## 145 1/8/2022 7178.59 0 0 0 145
## 146 1/9/2022 7040.80 0 0 0 146
## 147 1/10/2022 7098.89 0 0 0 147
## 148 1/11/2022 7081.31 0 0 0 148
## 149 1/12/2022 6850.62 0 0 0 149
## 150 1/1/2023 6839.34 0 0 0 150
## 151 1/2/2023 6843.24 1 0 0 151
## 152 1/3/2023 6805.28 0 0 0 152
## 153 1/4/2023 6915.72 0 0 0 153
## 154 1/5/2023 6633.26 0 0 0 154
## 155 1/6/2023 6661.88 0 0 0 155
## 156 1/7/2023 6931.36 0 0 0 156
## 157 1/8/2023 6953.26 0 0 0 157
## 158 1/9/2023 6939.89 0 0 0 158
## 159 1/10/2023 6752.21 0 0 0 159
## 160 1/11/2023 7080.74 0 0 0 160
## 161 1/12/2023 7272.80 0 0 0 161
## 162 1/1/2024 7207.94 0 0 0 162
## 163 1/2/2024 7316.11 0 1 0 163
## 164 1/3/2024 7288.81 0 0 0 164
## 165 1/4/2024 7234.20 0 0 0 165
## 166 1/5/2024 6970.74 0 0 0 166
## 167 1/6/2024 7063.58 0 0 0 167
## 168 1/7/2024 7255.76 0 0 0 168
## 169 1/8/2024 7670.73 0 0 0 169
## 170 1/9/2024 7527.93 0 0 0 170
## 171 1/10/2024 7574.02 0 0 0 171
## 172 1/11/2024 7114.27 0 0 0 172
## 173 1/12/2024 7079.90 0 0 0 173
## 174 1/1/2025 7109.20 0 0 0 174
## 175 1/2/2025 6270.60 0 0 1 175
## 176 1/3/2025 6510.62 0 0 0 176
## 177 1/4/2025 6766.80 0 0 0 177
## 178 1/5/2025 6839.55 0 0 0 178
#In Sample - Out Sample
Yt=data$Terakhir[1:161]
t=data$t[1:161]
ts.plot(as.ts(Yt),lwd=5,ylab="Zt",col="red")
D1=data$D1[1:161]
D2=data$D2[1:161]
D3=data$D3[1:161]
#Regresi Runtun Waktu
model1=lm(Yt~t+D1+D2+D3)
summary(model1)
##
## Call:
## lm(formula = Yt ~ t + D1 + D2 + D3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1570.68 -252.33 14.12 305.81 1032.41
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3716.4649 70.7499 52.530 <2e-16 ***
## t 20.6306 0.7555 27.308 <2e-16 ***
## D1 174.0864 259.6565 0.670 0.5036
## D2 477.3697 316.8011 1.507 0.1339
## D3 -782.8074 316.8396 -2.471 0.0146 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 445.1 on 156 degrees of freedom
## Multiple R-squared: 0.8286, Adjusted R-squared: 0.8242
## F-statistic: 188.5 on 4 and 156 DF, p-value: < 2.2e-16
#Seleksi Variabel
model2=lm(Yt~t+D3)
summary(model2)
##
## Call:
## lm(formula = Yt ~ t + D3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1580.20 -262.10 18.54 311.83 1023.06
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3725.2226 70.6995 52.691 <2e-16 ***
## t 20.6372 0.7566 27.277 <2e-16 ***
## D3 -792.1466 317.4639 -2.495 0.0136 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 446.1 on 158 degrees of freedom
## Multiple R-squared: 0.8256, Adjusted R-squared: 0.8234
## F-statistic: 374 on 2 and 158 DF, p-value: < 2.2e-16
stepwise(model1,direction = "backward",criterion = "AIC")
##
## Direction: backward
## Criterion: AIC
##
## Start: AIC=1968.59
## Yt ~ t + D1 + D2 + D3
##
## Df Sum of Sq RSS AIC
## - D1 1 89061 30997712 1967.0
## <none> 30908651 1968.6
## - D2 1 449875 31358526 1968.9
## - D3 1 1209446 32118097 1972.8
## - t 1 147749640 178658291 2249.1
##
## Step: AIC=1967.05
## Yt ~ t + D2 + D3
##
## Df Sum of Sq RSS AIC
## <none> 30997712 1967.0
## - D2 1 443886 31441598 1967.3
## - D3 1 1220507 32218219 1971.3
## - t 1 148215592 179213304 2247.6
##
## Call:
## lm(formula = Yt ~ t + D2 + D3)
##
## Coefficients:
## (Intercept) t D2 D3
## 3718.29 20.65 474.13 -786.27
#Sudah Out-Sample
YtOut=data$Terakhir[162:178]
tOut=data$t[162:178]
D1Out=data$D1[162:178]
D2Out=data$D2[162:178]
D3Out=data$D3[162:178]
dataout=data.frame(YtOut,tOut,D3Out)
modelout1=lm(YtOut~tOut+D3Out)
summary(modelout1)
##
## Call:
## lm(formula = YtOut ~ tOut + D3Out)
##
## Residuals:
## Min 1Q Median 3Q Max
## -455.24 -168.60 -42.57 46.22 491.65
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12326.84 2330.91 5.288 0.000115 ***
## tOut -30.46 13.73 -2.218 0.043571 *
## D3Out -725.72 285.88 -2.538 0.023639 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 268.2 on 14 degrees of freedom
## Multiple R-squared: 0.521, Adjusted R-squared: 0.4526
## F-statistic: 7.615 on 2 and 14 DF, p-value: 0.005782
modelout2=lm(YtOut~tOut+D3Out)
summary(modelout2)
##
## Call:
## lm(formula = YtOut ~ tOut + D3Out)
##
## Residuals:
## Min 1Q Median 3Q Max
## -455.24 -168.60 -42.57 46.22 491.65
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12326.84 2330.91 5.288 0.000115 ***
## tOut -30.46 13.73 -2.218 0.043571 *
## D3Out -725.72 285.88 -2.538 0.023639 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 268.2 on 14 degrees of freedom
## Multiple R-squared: 0.521, Adjusted R-squared: 0.4526
## F-statistic: 7.615 on 2 and 14 DF, p-value: 0.005782
#Prediksi dan Peramalan
prediksi <- predict(model2)
prediksi
## 1 2 3 4 5 6 7 8
## 3745.860 3766.497 3787.134 3807.771 3828.408 3849.046 3869.683 3890.320
## 9 10 11 12 13 14 15 16
## 3910.957 3931.594 3952.231 3972.869 3993.506 4014.143 4034.780 4055.417
## 17 18 19 20 21 22 23 24
## 4076.054 4096.692 4117.329 4137.966 4158.603 4179.240 4199.877 4220.515
## 25 26 27 28 29 30 31 32
## 4241.152 4261.789 4282.426 4303.063 4323.700 4344.338 4364.975 4385.612
## 33 34 35 36 37 38 39 40
## 4406.249 4426.886 4447.523 4468.160 4488.798 4509.435 4530.072 4550.709
## 41 42 43 44 45 46 47 48
## 4571.346 4591.983 4612.621 4633.258 4653.895 4674.532 4695.169 4715.806
## 49 50 51 52 53 54 55 56
## 4736.444 4757.081 4777.718 4798.355 4818.992 4839.629 4860.267 4880.904
## 57 58 59 60 61 62 63 64
## 4901.541 4922.178 4942.815 4171.306 4984.090 5004.727 5025.364 5046.001
## 65 66 67 68 69 70 71 72
## 5066.638 5087.275 5107.913 5128.550 5149.187 5169.824 5190.461 5211.098
## 73 74 75 76 77 78 79 80
## 5231.736 5252.373 5273.010 5293.647 5314.284 5334.921 5355.559 5376.196
## 81 82 83 84 85 86 87 88
## 5396.833 5417.470 5438.107 5458.744 5479.382 5500.019 5520.656 5541.293
## 89 90 91 92 93 94 95 96
## 5561.930 5582.567 5603.205 5623.842 5644.479 5665.116 5685.753 5706.390
## 97 98 99 100 101 102 103 104
## 5727.028 5747.665 5768.302 5788.939 5809.576 5830.213 5850.850 5871.488
## 105 106 107 108 109 110 111 112
## 5892.125 5912.762 5933.399 5954.036 5974.673 5995.311 6015.948 6036.585
## 113 114 115 116 117 118 119 120
## 6057.222 6077.859 6098.496 6119.134 5347.624 6160.408 6181.045 6201.682
## 121 122 123 124 125 126 127 128
## 6222.319 6242.957 6263.594 6284.231 6304.868 6325.505 6346.142 6366.780
## 129 130 131 132 133 134 135 136
## 6387.417 6408.054 6428.691 6449.328 6469.965 6490.603 6511.240 6531.877
## 137 138 139 140 141 142 143 144
## 6552.514 6573.151 6593.788 6614.426 6635.063 6655.700 6676.337 6696.974
## 145 146 147 148 149 150 151 152
## 6717.611 6738.249 6758.886 6779.523 6800.160 6820.797 6841.434 6862.072
## 153 154 155 156 157 158 159 160
## 6882.709 6903.346 6923.983 6944.620 6965.257 6985.895 7006.532 7027.169
## 161
## 7047.806
forecast <- predict(modelout2)
forecast
## 1 2 3 4 5 6 7 8
## 7392.297 7361.837 7331.377 7300.917 7270.457 7239.997 7209.537 7179.076
## 9 10 11 12 13 14 15 16
## 7148.616 7118.156 7087.696 7057.236 7026.776 6270.600 6965.855 6935.395
## 17
## 6904.935
##AKURASI GABUNGAN
predfore<-c(prediksi,forecast)
predfore_fix <- predfore[1:162]
RMSE <- sqrt(mean((data$Terakhir - predfore)^2))
MAPE <- mean(abs(data$Terakhir - predfore) / abs(data$Terakhir)) * 100
SMAPE <- mean(2 * abs(data$Terakhir - predfore) / (abs(data$Terakhir) + abs(predfore))) * 100
RMSE
## [1] 426.9594
MAPE
## [1] 6.104493
SMAPE
## [1] 5.993879
#AKURASI --- In-Sample Accuracy ---
actual_in <- Yt
pred_in <- prediksi
RMSE_in <- sqrt(mean((actual_in - pred_in)^2))
MAPE_in <- mean(abs(actual_in - pred_in) / abs(actual_in)) * 100
SMAPE_in <- mean(2 * abs(actual_in - pred_in) / (abs(actual_in) + abs(pred_in))) * 100
# AKURASI--- Out-Sample Accuracy ---
actual_out <- YtOut
pred_out <- forecast
RMSE_out <- sqrt(mean((actual_out - pred_out)^2))
MAPE_out <- mean(abs(actual_out - pred_out) / abs(actual_out)) * 100
SMAPE_out <- mean(2 * abs(actual_out - pred_out) / (abs(actual_out) + abs(pred_out))) * 100
# --- Cetak Hasil ---
cat("Akurasi In-Sample:\n")
## Akurasi In-Sample:
cat(" RMSE =", RMSE_in, "\n")
## RMSE = 441.9156
cat(" MAPE =", MAPE_in, "%\n")
## MAPE = 6.488924 %
cat(" SMAPE =", SMAPE_in, "%\n\n")
## SMAPE = 6.36597 %
cat("Akurasi Out-Sample:\n")
## Akurasi Out-Sample:
cat(" RMSE =", RMSE_out, "\n")
## RMSE = 243.3586
cat(" MAPE =", MAPE_out, "%\n")
## MAPE = 2.463705 %
cat(" SMAPE =", SMAPE_out, "%\n")
## SMAPE = 2.469959 %
#Plot Perbandingan
# Gabungkan nilai aktual (Yt dan YtOut)
actual <- c(Yt, YtOut)
# Gabungkan hasil prediksi (in-sample) dan forecast (out-sample)
predfore <- c(prediksi, forecast)
# Buat time index
time_index <- 1:length(actual)
# Plot perbandingan
plot(time_index, actual, type = "l", col = "deeppink", lwd = 2,
ylab = "Nilai TSR", xlab = "Waktu",
main = "Perbandingan Nilai Aktual vs Prediksi + Forecast")
lines(time_index, predfore, col = "red", lwd = 2, lty = 2)
legend("topleft", legend = c("Aktual", "Prediksi + Forecast"),
col = c("deeppink", "red"), lty = c(1,2), lwd = 2)
abline(v = length(Yt), col = "darkgreen", lty = 3)
text(length(Yt)+1, max(actual), "Mulai Out-Sample", pos = 4, col = "darkgreen")
