Projek Magang
Panggil data
Data 12 peubah
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 3 27.9 31.5 24.2 25.1 82.9 6.7
## 4 28.2 32.7 23.6 25.5 88.6 8.2
## 5 28.5 33.2 23.8 25.0 75.1 8.5
## 6 28.8 33.6 24.0 25.2 76.2 7.8
## 7 27.6 32.3 23.5 25.0 79.7 8.2
## 8 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 3 1011.7 2 5.4 2.8 5.3 9.6
## 4 1009.8 17 5.8 2.4 3.8 7.3
## 5 1008.9 0 4.4 2.8 8.4 8.8
## 6 1010.3 0 4.8 3.4 6.1 9.0
## 7 1010.5 5 5.2 3.2 4.1 8.8
## 8 1008.7 7 5.0 2.2 3.9 7.6
datapenuh <- readRDS("Datapenuh.rds")
datapenuh$SunD1h<-as.numeric(datapenuh$SunD1h)
head(datapenuh)## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 1 27.9 31.5 24.2 25.1 82.9 6.7
## 2 28.2 32.7 23.6 25.5 88.6 8.2
## 3 28.5 33.2 23.8 25.0 75.1 8.5
## 4 28.8 33.6 24.0 25.2 76.2 7.8
## 5 27.6 32.3 23.5 25.0 79.7 8.2
## 6 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 1 1011.7 2 5.4 2.8 5.3 9.6
## 2 1009.8 17 5.8 2.4 3.8 7.3
## 3 1008.9 0 4.4 2.8 8.4 8.8
## 4 1010.3 0 4.8 3.4 6.1 9.0
## 5 1010.5 5 5.2 3.2 4.1 8.8
## 6 1008.7 7 5.0 2.2 3.9 7.6
Data 4 peubah
## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 3 27.9 31.5 24.2 2
## 4 28.2 32.7 23.6 17
## 5 28.5 33.2 23.8 0
## 6 28.8 33.6 24.0 0
## 7 27.6 32.3 23.5 5
## 8 27.2 30.6 23.9 7
datapenuhlain <- readRDS("Datapenuhlain.rds")
datapenuhlain<-as.data.frame(datapenuhlain)
head(datapenuhlain)## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 1 27.9 31.5 24.2 2
## 2 28.2 32.7 23.6 17
## 3 28.5 33.2 23.8 0
## 4 28.8 33.6 24.0 0
## 5 27.6 32.3 23.5 5
## 6 27.2 30.6 23.9 7
Eksplorasi
Jumlah missing value
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg
## 648 331 648 648 17
## WindkmhInt PresslevHp Precmm TotClOct lowClOct
## 16 16 3391 78 64
## SunD1h VisKm
## 686 0
Plot missing value
## Warning: package 'mice' was built under R version 4.3.3
##
## Attaching package: 'mice'
## The following object is masked from 'package:stats':
##
## filter
## The following objects are masked from 'package:base':
##
## cbind, rbind
## VisKm WindkmhInt PresslevHp HrAvg lowClOct TotClOct TemperatureCMax
## 32866 1 1 1 1 1 1 1
## 3207 1 1 1 1 1 1 1
## 438 1 1 1 1 1 1 1
## 44 1 1 1 1 1 1 1
## 160 1 1 1 1 1 1 1
## 24 1 1 1 1 1 1 1
## 73 1 1 1 1 1 1 1
## 60 1 1 1 1 1 1 1
## 226 1 1 1 1 1 1 0
## 36 1 1 1 1 1 1 0
## 43 1 1 1 1 1 1 0
## 7 1 1 1 1 1 1 0
## 14 1 1 1 1 1 0 1
## 1 1 1 1 1 1 0 0
## 1 1 1 1 1 0 1 1
## 41 1 1 1 1 0 0 1
## 1 1 1 1 1 0 0 1
## 4 1 1 1 1 0 0 1
## 1 1 1 1 1 0 0 0
## 1 1 1 1 0 1 1 0
## 5 1 0 0 0 0 0 0
## 11 1 0 0 0 0 0 0
## 0 16 16 17 64 78 331
## TemperatureCAvg TemperatureCMin TdAvgC SunD1h Precmm
## 32866 1 1 1 1 1 0
## 3207 1 1 1 1 0 1
## 438 1 1 1 0 1 1
## 44 1 1 1 0 0 2
## 160 0 0 0 1 1 3
## 24 0 0 0 1 0 4
## 73 0 0 0 0 1 4
## 60 0 0 0 0 0 5
## 226 0 0 0 1 1 4
## 36 0 0 0 1 0 5
## 43 0 0 0 0 1 5
## 7 0 0 0 0 0 6
## 14 1 1 1 1 1 1
## 1 0 0 0 1 0 6
## 1 1 1 1 1 1 1
## 41 1 1 1 1 1 2
## 1 1 1 1 1 0 3
## 4 1 1 1 0 1 3
## 1 0 0 0 1 1 6
## 1 0 0 0 0 1 6
## 5 0 0 0 0 1 10
## 11 0 0 0 0 0 11
## 648 648 648 686 3391 6543
## TemperatureCMax TemperatureCAvg TemperatureCMin Precmm
## 33364 1 1 1 1 0
## 3252 1 1 1 0 1
## 233 1 0 0 1 2
## 84 1 0 0 0 3
## 276 0 0 0 1 3
## 55 0 0 0 0 4
## 331 648 648 3391 5018
Berdasarkan plot tersebut, terdapat data hilang berjumlah 331 pada suhu rata-rata, 648 pada suhu max dan min, dan 3391 pada curah hujan.
Eksplorasi deskriptif
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC
## Min. :11.40 Min. :25.00 Min. : 8.40 Min. :19.10
## 1st Qu.:27.00 1st Qu.:31.90 1st Qu.:23.40 1st Qu.:23.80
## Median :27.90 Median :32.80 Median :24.00 Median :24.30
## Mean :27.78 Mean :32.75 Mean :24.02 Mean :24.21
## 3rd Qu.:28.60 3rd Qu.:33.70 3rd Qu.:24.70 3rd Qu.:24.80
## Max. :32.10 Max. :39.30 Max. :28.40 Max. :27.10
## NA's :648 NA's :331 NA's :648 NA's :648
## HrAvg WindkmhInt PresslevHp Precmm
## Min. :47.20 Min. : 0.000 Min. :1005 Min. : 0.00
## 1st Qu.:78.00 1st Qu.: 3.700 1st Qu.:1009 1st Qu.: 0.00
## Median :82.10 Median : 5.300 Median :1010 Median : 2.00
## Mean :81.69 Mean : 5.564 Mean :1010 Mean : 12.15
## 3rd Qu.:85.90 3rd Qu.: 6.900 3rd Qu.:1011 3rd Qu.: 13.60
## Max. :98.20 Max. :56.100 Max. :1028 Max. :649.00
## NA's :17 NA's :16 NA's :16 NA's :3391
## TotClOct lowClOct SunD1h VisKm
## Min. :1.100 Min. :0.000 Min. : 0.000 Min. : 0.200
## 1st Qu.:5.600 1st Qu.:2.800 1st Qu.: 2.500 1st Qu.: 7.100
## Median :6.400 Median :3.400 Median : 5.100 Median : 8.000
## Mean :6.148 Mean :3.459 Mean : 4.964 Mean : 7.894
## 3rd Qu.:6.900 3rd Qu.:4.200 3rd Qu.: 7.300 3rd Qu.: 9.000
## Max. :8.000 Max. :8.000 Max. :24.000 Max. :14.500
## NA's :78 NA's :64 NA's :686
Terdapat pencilan pada suhu min, HrAvg, curah hujan dan jarak pandang.Ada kemungkinan hal tersebut memengaruhi model
Fungsi akurasi dan evaluasi
# Mask untuk nilai hilang di data asli
missing_mask <- is.na(datah)
missing_maskk <- is.na(datahilang1)
# Hitung MAE, MSE, atau RMSE hanya untuk nilai yang diimputasi
mae_imputation <- function(true_values, imputed_values, missing_mask) {
return(mean(abs(true_values[missing_mask] - imputed_values[missing_mask]), na.rm = TRUE))
}
mse_imputation <- function(true_values, imputed_values, missing_mask) {
return(mean((true_values[missing_mask] - imputed_values[missing_mask])^2, na.rm = TRUE))
}
rmse_imputation <- function(true_values, imputed_values, missing_mask) {
return(sqrt(mean((true_values[missing_mask] - imputed_values[missing_mask])^2, na.rm = TRUE)))
}
mape_fun_with_mask <- function(y_true, y_pred, missing_mask) {
y_true_masked <- y_true[missing_mask]
y_pred_masked <- y_pred[missing_mask]
return(mean(abs((y_true_masked - y_pred_masked) / y_true_masked)) * 100)
}IMPUTATION
Metode Mean
Mean disini imputasi menggunakan rata-rata peubah secara keseluruhan
imputation_mode_mean <- function(df){
# browser()
Mode <- function(x) {
ux <- unique(na.omit(x))
ux[which.max(tabulate(match(x, ux)))]
}
for (i in 1L:length(df)){
if (sum(is.na(df[,i])) > 0){
if (mode(df[,i]) == 'character' | is.factor(df[,i])){
to_imp <- Mode(df[,i])
df[,i][is.na(df[,i])] <- to_imp
}
else{
to_imp <- mean(df[,i], na.rm = TRUE)
df[,i][is.na(df[,i])] <- to_imp
}
}
}
return(df)
}Mean 12 pubah
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 3 27.9 31.5 24.2 25.1 82.9 6.7
## 4 28.2 32.7 23.6 25.5 88.6 8.2
## 5 28.5 33.2 23.8 25.0 75.1 8.5
## 6 28.8 33.6 24.0 25.2 76.2 7.8
## 7 27.6 32.3 23.5 25.0 79.7 8.2
## 8 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 3 1011.7 2 5.4 2.8 5.3 9.6
## 4 1009.8 17 5.8 2.4 3.8 7.3
## 5 1008.9 0 4.4 2.8 8.4 8.8
## 6 1010.3 0 4.8 3.4 6.1 9.0
## 7 1010.5 5 5.2 3.2 4.1 8.8
## 8 1008.7 7 5.0 2.2 3.9 7.6
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg
## 0 0 0 0 0
## WindkmhInt PresslevHp Precmm TotClOct lowClOct
## 0 0 0 0 0
## SunD1h VisKm
## 0 0
Akurasi Mean 12 peubah
maemean <- mae_imputation(datapenuh, result, missing_mask)
msemean <- mse_imputation(datapenuh, result, missing_mask)
rmsemean <- rmse_imputation(datapenuh, result, missing_mask)
mapemean <- mape_fun_with_mask(datapenuh, result, missing_mask)
maemean## [1] 1.505533
## [1] 5.5528
## [1] 2.356438
## [1] 16.65181
Mape berada dibawah 20% sehingga dapat dikatakan cukup baik untuk memprediksi. Namun, hal ini juga dapat disebabkan datapenuh yang digunakan masih menggunakan rata-rata per bulan sehingga hasil prediksi tergolong cukup baik.
Metode K-NN
Mengisi nilai hilang berdasarkan nilai data terdekat (neighbors) secara metrik dari data yang tersedia setelahnya diisi dengan rata-rata dari nilai tetangga terdekat tersebut.
## Warning: package 'VIM' was built under R version 4.3.3
## Loading required package: colorspace
## Loading required package: grid
## VIM is ready to use.
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
##
## Attaching package: 'VIM'
## The following object is masked from 'package:datasets':
##
## sleep
imputation_fun_vim <- function(df){
no_columns <- length(df)
imputed <- kNN(df)
imputed <- imputed[,1:no_columns]
return(imputed)
}K-NN 12 peubah
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 1 27.9 31.5 24.2 25.1 82.9 6.7
## 2 28.2 32.7 23.6 25.5 88.6 8.2
## 3 28.5 33.2 23.8 25.0 75.1 8.5
## 4 28.8 33.6 24.0 25.2 76.2 7.8
## 5 27.6 32.3 23.5 25.0 79.7 8.2
## 6 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 1 1011.7 2 5.4 2.8 5.3 9.6
## 2 1009.8 17 5.8 2.4 3.8 7.3
## 3 1008.9 0 4.4 2.8 8.4 8.8
## 4 1010.3 0 4.8 3.4 6.1 9.0
## 5 1010.5 5 5.2 3.2 4.1 8.8
## 6 1008.7 7 5.0 2.2 3.9 7.6
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg
## 0 0 0 0 0
## WindkmhInt PresslevHp Precmm TotClOct lowClOct
## 0 0 0 0 0
## SunD1h VisKm
## 0 0
maeknn <- mae_imputation(datapenuh, result2, missing_mask)
mseknn <- mse_imputation(datapenuh, result2, missing_mask)
rmseknn <- rmse_imputation(datapenuh, result2, missing_mask)
mapeknn <- mape_fun_with_mask(datapenuh, result2, missing_mask)
maeknn## [1] 6.143206
## [1] 75.99929
## [1] 8.717757
## [1] 51.48797
akurasi pada moetode KNN sangat tinggi yaitu 50% sehingga dapat dikatakan prediksi tidak cukup baik pada data
Mengambil 4 peubah
Dilakukan pengujian akurasi pada 4 peubah utama untuk melihat apakah peubah lainnya memiliki pengaruh pada prediksi data hilang
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
maeknn1 <- mae_imputation(datapenuhlain, result2.1, missing_maskk)
mseknn1 <- mse_imputation(datapenuhlain, result2.1, missing_maskk)
rmseknn1 <- rmse_imputation(datapenuhlain, result2.1, missing_maskk)
mapeknn1 <- mape_fun_with_mask(datapenuhlain, result2.1, missing_maskk)
maeknn1## [1] 12.58204
## [1] 207.0009
## [1] 14.38752
## [1] 98.15032
Evaluasi menghasilkan angka yang sangat besar menandakan peubah lainnya tidak cukup memiliki korelasi pada 4 peubah utama
Metode rpart
Rpart membangun pohon keputusan atau regresi berdasarkan data yang tersedia. Menghasilkan beberapa set data yang berbeda, yang disebut multiple imputation, untuk mencerminkan ketidakpastian dalam proses imputasi.
library(rpart)
# Fungsi untuk imputasi menggunakan rpart untuk semua kolom yang memiliki nilai hilang
impute_with_rpart_all <- function(df) {
# Identifikasi kolom dengan nilai hilang
missing_cols <- colnames(df)[colSums(is.na(df)) > 0]
for (col in missing_cols) {
# Cek tipe data kolom
if (is.factor(df[[col]])) {
# Jika kolom adalah faktor (kategorikal)
model <- rpart(as.formula(paste(col, "~ .")),
data = df[!is.na(df[[col]]), ],
method = "class",
na.action = na.omit)
# Prediksi untuk nilai yang hilang
pred <- predict(model, df[is.na(df[[col]]), ], type = "class")
} else {
# Jika kolom adalah numerik
model <- rpart(as.formula(paste(col, "~ .")),
data = df[!is.na(df[[col]]), ],
method = "anova",
na.action = na.omit)
# Prediksi untuk nilai yang hilang
pred <- predict(model, df[is.na(df[[col]]), ])
}
# Imputasi nilai hilang
df[[col]][is.na(df[[col]])] <- pred
}
return(df)
}## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 3 27.9 31.5 24.2 25.1 82.9 6.7
## 4 28.2 32.7 23.6 25.5 88.6 8.2
## 5 28.5 33.2 23.8 25.0 75.1 8.5
## 6 28.8 33.6 24.0 25.2 76.2 7.8
## 7 27.6 32.3 23.5 25.0 79.7 8.2
## 8 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 3 1011.7 2 5.4 2.8 5.3 9.6
## 4 1009.8 17 5.8 2.4 3.8 7.3
## 5 1008.9 0 4.4 2.8 8.4 8.8
## 6 1010.3 0 4.8 3.4 6.1 9.0
## 7 1010.5 5 5.2 3.2 4.1 8.8
## 8 1008.7 7 5.0 2.2 3.9 7.6
maerpart <- mae_imputation(datapenuh, result6, missing_mask)
mserpart <- mse_imputation(datapenuh, result6, missing_mask)
rmserpart <- rmse_imputation(datapenuh, result6, missing_mask)
maperpart <- mape_fun_with_mask(datapenuh, result6, missing_mask)
maerpart## [1] 3.610425
## [1] 31.91977
## [1] 5.649758
## [1] 30.66934
Mengambil 4 peubah dari hasil pemodelan
maerpart1 <- mae_imputation(datapenuhlain, result6.1, missing_maskk)
mserpart1 <- mse_imputation(datapenuhlain, result6.1, missing_maskk)
rmserpart1 <- rmse_imputation(datapenuhlain, result6.1, missing_maskk)
maperpart1 <- mape_fun_with_mask(datapenuhlain, result6.1, missing_maskk)
maerpart1## [1] 12.5044
## [1] 199.9871
## [1] 14.14168
## [1] 97.5115
Sama seperti sebelumnya, pemodelan dengan 12 peubah tidak memengaruhi nilai evaluasi imputasi 4 peubah utama. Hal ini terjadi karena peubah lainnya tidak memiliki korelasi yang baik
Metode Missranger (mean machine)
## Warning: package 'missRanger' was built under R version 4.3.3
## Missing value imputation by random forests
##
## Variables to impute: WindkmhInt, PresslevHp, HrAvg, lowClOct, TotClOct, TemperatureCMax, TemperatureCAvg, TemperatureCMin, TdAvgC, SunD1h, Precmm
## Variables used to impute: TemperatureCAvg, TemperatureCMax, TemperatureCMin, TdAvgC, HrAvg, WindkmhInt, PresslevHp, Precmm, TotClOct, lowClOct, SunD1h, VisKm
##
## iter 1
##
|
| | 0%
|
|====== | 9%
|
|============= | 18%
|
|=================== | 27%
|
|========================= | 36%
|
|================================ | 45%
|
|====================================== | 55%
|
|============================================= | 64%
|
|=================================================== | 73%
|
|========================================================= | 82%
|
|================================================================ | 91%
|
|======================================================================| 100%
## iter 2
##
|
| | 0%
|
|====== | 9%
|
|============= | 18%
|
|=================== | 27%
|
|========================= | 36%
|
|================================ | 45%
|
|====================================== | 55%
|
|============================================= | 64%
|
|=================================================== | 73%
|
|========================================================= | 82%
|
|================================================================ | 91%
|
|======================================================================| 100%
## iter 3
##
|
| | 0%
|
|====== | 9%
|
|============= | 18%
|
|=================== | 27%
|
|========================= | 36%
|
|================================ | 45%
|
|====================================== | 55%
|
|============================================= | 64%
|
|=================================================== | 73%
|
|========================================================= | 82%
|
|================================================================ | 91%
|
|======================================================================| 100%
## TemperatureCAvg TemperatureCMax TemperatureCMin TdAvgC HrAvg WindkmhInt
## 3 27.9 31.5 24.2 25.1 82.9 6.7
## 4 28.2 32.7 23.6 25.5 88.6 8.2
## 5 28.5 33.2 23.8 25.0 75.1 8.5
## 6 28.8 33.6 24.0 25.2 76.2 7.8
## 7 27.6 32.3 23.5 25.0 79.7 8.2
## 8 27.2 30.6 23.9 25.0 81.3 8.2
## PresslevHp Precmm TotClOct lowClOct SunD1h VisKm
## 3 1011.7 2 5.4 2.8 5.3 9.6
## 4 1009.8 17 5.8 2.4 3.8 7.3
## 5 1008.9 0 4.4 2.8 8.4 8.8
## 6 1010.3 0 4.8 3.4 6.1 9.0
## 7 1010.5 5 5.2 3.2 4.1 8.8
## 8 1008.7 7 5.0 2.2 3.9 7.6
maemm <- mae_imputation(datapenuh, meanmachine1, missing_mask)
msemm <- mse_imputation(datapenuh, meanmachine1, missing_mask)
rmsemm <- rmse_imputation(datapenuh, meanmachine1, missing_mask)
mapemm <- mape_fun_with_mask(datapenuh, meanmachine1, missing_mask)
maemm## [1] 4.203212
## [1] 45.42434
## [1] 6.739758
## [1] 36.5804
Evaluasi dan akurasi missranger tergolong baik tapi tidak cukup dikatakan baik juga.
Mengambil 4 peubah dari hasil pemodelan
meanmachine <- meanmachine1 %>% select('Precmm', "TemperatureCAvg", "TemperatureCMax", "TemperatureCMin")maemm <- mae_imputation(datapenuhlain, meanmachine, missing_maskk)
msemm <- mse_imputation(datapenuhlain, meanmachine, missing_maskk)
rmsemm <- rmse_imputation(datapenuhlain, meanmachine, missing_maskk)
mapemm <- mape_fun_with_mask(datapenuhlain, meanmachine, missing_maskk)
maemm## [1] 12.55254
## [1] 202.3591
## [1] 14.2253
## [1] 97.72158
Nilainya sangat besar sehingga tidak dapat dikatakan sebagai imputasi yang baik
Metode Kalman FIlter
Menduga data hilang pada data time series sehingga bisa digunakan untuk memprediksi berdasarkan musim atau berdasarkan hari terdekat.
## Warning: package 'imputeTS' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
maekalman <- mae_imputation(datapenuh, result8, missing_mask)
msekalman <- mse_imputation(datapenuh, result8, missing_mask)
rmsekalman <- rmse_imputation(datapenuh, result8, missing_mask)
mapekalman <- mape_fun_with_mask(datapenuh, result8, missing_mask)
maekalman## [1] 2.035664
## [1] 9.149158
## [1] 3.024757
## [1] 18.23355
Akurasi dan evaluasi tergolong cukup baik karena mape berada dibawah 20%
Mengambil 4 peubah dari hasil pemodelan
maekalman <- mae_imputation(datapenuhlain, result8.1, missing_mask)
msekalman <- mse_imputation(datapenuhlain, result8.1, missing_mask)
rmsekalman <- rmse_imputation(datapenuhlain, result8.1, missing_mask)
mapekalman <- mape_fun_with_mask(datapenuhlain, result8.1, missing_mask)
maekalman## [1] 15.1642
## [1] 350.9322
## [1] 18.73318
## [1] NA
Kesimpulan
hasil akurasi dan evaluasi dari 12 peubah dapat dikategorikan baik pada metode mean dan kalman-filter. Kalman-filter memungkinkan prediksi data dari periode sebelumnya menggunakan algoritma arima.Lalu, 4 peubah utama tidak dapat di prediksi dengan baik menggunakan 12 peubah. Hal ini di lihat dari hasil akurasi dan evaluasi yang sangat tinggi. Sehingga, analisis akan dilanjutkan dengan menggunakan 4 peubah utama.
Percobaan dengan 4 peubah
## TemperatureCMax TemperatureCAvg TemperatureCMin Precmm
## 33364 1 1 1 1 0
## 3252 1 1 1 0 1
## 233 1 0 0 1 2
## 84 1 0 0 0 3
## 276 0 0 0 1 3
## 55 0 0 0 0 4
## 331 648 648 3391 5018
Metode Mean
imputation_mode_mean <- function(df){
# browser()
Mode <- function(x) {
ux <- unique(na.omit(x))
ux[which.max(tabulate(match(x, ux)))]
}
for (i in 1L:length(df)){
if (sum(is.na(df[,i])) > 0){
if (mode(df[,i]) == 'character' | is.factor(df[,i])){
to_imp <- Mode(df[,i])
df[,i][is.na(df[,i])] <- to_imp
}
else{
to_imp <- mean(df[,i], na.rm = TRUE)
df[,i][is.na(df[,i])] <- to_imp
}
}
}
return(df)
}## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 3 27.9 31.5 24.2 2
## 4 28.2 32.7 23.6 17
## 5 28.5 33.2 23.8 0
## 6 28.8 33.6 24.0 0
## 7 27.6 32.3 23.5 5
## 8 27.2 30.6 23.9 7
## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 0 0 0 0
maemeann <- mae_imputation(datapenuhlain, hasil, missing_maskk)
msemeann <- mse_imputation(datapenuhlain, hasil, missing_maskk)
rmsemeann <- rmse_imputation(datapenuhlain, hasil, missing_maskk)
mapemeann <- mape_fun_with_mask(datapenuhlain, hasil, missing_maskk)
maemeann## [1] 1.811837
## [1] 7.111148
## [1] 2.666674
## [1] 19.46479
Mape berada dibawah 20% sehingga dapat dikatakan cukup baik untuk memprediksi.
Metode K-NN
library(VIM)
imputation_fun_vim <- function(df){
no_columns <- length(df)
imputed <- kNN(df)
imputed <- imputed[,1:no_columns]
return(imputed)
}## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 1 27.9 31.5 24.2 2
## 2 28.2 32.7 23.6 17
## 3 28.5 33.2 23.8 0
## 4 28.8 33.6 24.0 0
## 5 27.6 32.3 23.5 5
## 6 27.2 30.6 23.9 7
## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 0 0 0 0
maeknnn <- mae_imputation(datapenuhlain, hasil2, missing_maskk)
mseknnn <- mse_imputation(datapenuhlain, hasil2, missing_maskk)
rmseknnn<- rmse_imputation(datapenuhlain, hasil2, missing_maskk)
mapeknnn <- mape_fun_with_mask(datapenuhlain, hasil2, missing_maskk)
maeknnn## [1] 7.774492
## [1] 108.5061
## [1] 10.41663
## [1] 61.67575
Nilai mape sangat besar sehingga tidak dipilih sebagai metode terbaik
Metode rpart
Rpart membangun pohon keputusan atau regresi berdasarkan data yang tersedia. Menghasilkan beberapa set data yang berbeda, yang disebut multiple imputation, untuk mencerminkan ketidakpastian dalam proses imputasi.
library(rpart)
# Fungsi untuk imputasi menggunakan rpart untuk semua kolom yang memiliki nilai hilang
impute_with_rpart_all <- function(df) {
# Identifikasi kolom dengan nilai hilang
missing_cols <- colnames(df)[colSums(is.na(df)) > 0]
for (col in missing_cols) {
# Cek tipe data kolom
if (is.factor(df[[col]])) {
# Jika kolom adalah faktor (kategorikal)
model <- rpart(as.formula(paste(col, "~ .")),
data = df[!is.na(df[[col]]), ],
method = "class",
na.action = na.omit)
# Prediksi untuk nilai yang hilang
pred <- predict(model, df[is.na(df[[col]]), ], type = "class")
} else {
# Jika kolom adalah numerik
model <- rpart(as.formula(paste(col, "~ .")),
data = df[!is.na(df[[col]]), ],
method = "anova",
na.action = na.omit)
# Prediksi untuk nilai yang hilang
pred <- predict(model, df[is.na(df[[col]]), ])
}
# Imputasi nilai hilang
df[[col]][is.na(df[[col]])] <- pred
}
return(df)
}## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 3 27.9 31.5 24.2 2
## 4 28.2 32.7 23.6 17
## 5 28.5 33.2 23.8 0
## 6 28.8 33.6 24.0 0
## 7 27.6 32.3 23.5 5
## 8 27.2 30.6 23.9 7
maerpartt <- mae_imputation(datapenuhlain, hasil6, missing_maskk)
mserpartt <- mse_imputation(datapenuhlain, hasil6, missing_maskk)
rmserpartt <- rmse_imputation(datapenuhlain, hasil6, missing_maskk)
maperpartt <- mape_fun_with_mask(datapenuhlain, hasil6, missing_maskk)
maerpartt## [1] 3.421815
## [1] 21.75938
## [1] 4.664695
## [1] 31.22689
akurasi dan evaluasi lumayan baik tapi tidak dapat dikatakan sangat baik
Metode Missranger (mean machine)
## Missing value imputation by random forests
##
## Variables to impute: TemperatureCMax, TemperatureCAvg, TemperatureCMin, Precmm
## Variables used to impute: TemperatureCAvg, TemperatureCMax, TemperatureCMin, Precmm
##
## iter 1
##
|
| | 0%
|
|================== | 25%
|
|=================================== | 50%
|
|==================================================== | 75%
|
|======================================================================| 100%
## iter 2
##
|
| | 0%
|
|================== | 25%
|
|=================================== | 50%
|
|==================================================== | 75%
|
|======================================================================| 100%
## iter 3
##
|
| | 0%
|
|================== | 25%
|
|=================================== | 50%
|
|==================================================== | 75%
|
|======================================================================| 100%
## TemperatureCAvg TemperatureCMax TemperatureCMin Precmm
## 3 27.9 31.5 24.2 2
## 4 28.2 32.7 23.6 17
## 5 28.5 33.2 23.8 0
## 6 28.8 33.6 24.0 0
## 7 27.6 32.3 23.5 5
## 8 27.2 30.6 23.9 7
maemmm <- mae_imputation(datapenuhlain, hasil7, missing_maskk)
msemmm <- mse_imputation(datapenuhlain, hasil7, missing_maskk)
rmsemmm <- rmse_imputation(datapenuhlain, hasil7, missing_maskk)
mapemmm <- mape_fun_with_mask(datapenuhlain, hasil7, missing_maskk)
maemmm## [1] 4.630837
## [1] 51.94585
## [1] 7.207347
## [1] 40.91723
akurasi dan evaluasi berada di 20-50% cukup bagus tapi butuh perbaikan pada modelnya
Metode Kalman FIlter
Menduga data hilang pada data time series sehingga bisa digunakan untuk memprediksi berdasarkan musim atau berdasarkan hari terdekat.
maekalmann <- mae_imputation(datapenuhlain, hasil8, missing_maskk)
msekalmann <- mse_imputation(datapenuhlain, hasil8, missing_maskk)
rmsekalmann <- rmse_imputation(datapenuhlain, hasil8, missing_maskk)
mapekalmann <- mape_fun_with_mask(datapenuhlain, hasil8, missing_maskk)
maekalmann## [1] 2.471924
## [1] 11.69681
## [1] 3.42006
## [1] 21.03581
akurasi dan evaluasi cukup bagus karena berada di rentang 20-50%. Bisa di coba tangani atau pemodelan lain
Metode Expectation-Maximization (EM)
## Warning: package 'missMethods' was built under R version 4.3.3
## This package has some major limitations
## (for example, it does not work reliably when
## the number of variables exceeds 30),
## and has been superseded by the norm2 package.
maemm<- mae_imputation(datapenuhlain, ds_imp, missing_maskk)
msemm <- mse_imputation(datapenuhlain, ds_imp, missing_maskk)
rmsemm <- rmse_imputation(datapenuhlain, ds_imp, missing_maskk)
mapemm <- mape_fun_with_mask(datapenuhlain, ds_imp, missing_maskk)
maemm## [1] 3.522939
## [1] 27.2264
## [1] 5.217892
## [1] 32.98664
akurasi dan evaluasi cukup bagus karena berada di rentang 20-50%. Bisa di coba tangani atau pemodelan lain
Kesimpulan
hasil imputasi dengan 4 peubah utama terbaik sejauh ini menggunakan metode mean, rpart, kalman-filter dan expectation-maximization