Projek Magang

Panggil data

Data 12 peubah

datah <- readRDS("Datahilang.rds")
datah$SunD1h<-as.numeric(datah$SunD1h)
head(datah)
##   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

datahilang1 <- readRDS("Datahilang1.rds")
head(datahilang1)
##   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

colSums(is.na(datah))
## 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

library(mice)
## 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
md.pattern(datah)

##       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
md.pattern(datahilang1)

##       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

summary(datah)
##  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

result <- round(imputation_mode_mean(datah),1)
head(result)
##   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
colSums(is.na(result))
## 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
msemean
## [1] 5.5528
rmsemean
## [1] 2.356438
mapemean
## [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.

library(VIM)
## 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

result2 <- imputation_fun_vim(datah)
head(result2)
##   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
colSums(is.na(result2))
## 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
mseknn
## [1] 75.99929
rmseknn
## [1] 8.717757
mapeknn
## [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

library(dplyr)
## 
## 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
result2.1 <- result2 %>% select('Precmm', "TemperatureCAvg", "TemperatureCMax", "TemperatureCMin")
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
mseknn1
## [1] 207.0009
rmseknn1
## [1] 14.38752
mapeknn1
## [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)
}
result6<- impute_with_rpart_all(datah)
head(result6)
##   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
mserpart
## [1] 31.91977
rmserpart
## [1] 5.649758
maperpart
## [1] 30.66934

Mengambil 4 peubah dari hasil pemodelan

result6.1 <- result6 %>% select('Precmm', "TemperatureCAvg", "TemperatureCMax", "TemperatureCMin")
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
mserpart1
## [1] 199.9871
rmserpart1
## [1] 14.14168
maperpart1
## [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)

library(missRanger)
## Warning: package 'missRanger' was built under R version 4.3.3
meanmachine1<- missRanger(datah, formula=.~., num.trees=100,seed=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%
head(meanmachine1)
##   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
msemm
## [1] 45.42434
rmsemm
## [1] 6.739758
mapemm
## [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
msemm
## [1] 202.3591
rmsemm
## [1] 14.2253
mapemm
## [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.

library(imputeTS)
## Warning: package 'imputeTS' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
result8<-na_kalman(datah)
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
msekalman
## [1] 9.149158
rmsekalman
## [1] 3.024757
mapekalman
## [1] 18.23355

Akurasi dan evaluasi tergolong cukup baik karena mape berada dibawah 20%

Mengambil 4 peubah dari hasil pemodelan

result8.1 <- result8 %>% select('Precmm', "TemperatureCAvg", "TemperatureCMax", "TemperatureCMin")
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
msekalman
## [1] 350.9322
rmsekalman
## [1] 18.73318
mapekalman
## [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

md.pattern(datahilang1)

##       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)
}
hasil <- round(imputation_mode_mean(datahilang1),1)
head(hasil)
##   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
colSums(is.na(hasil))
## 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
msemeann
## [1] 7.111148
rmsemeann
## [1] 2.666674
mapemeann
## [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)
}
hasil2 <- imputation_fun_vim(datahilang1)
head(hasil2)
##   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
colSums(is.na(hasil2))
## 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
mseknnn
## [1] 108.5061
rmseknnn
## [1] 10.41663
mapeknnn
## [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)
}
hasil6<- impute_with_rpart_all(datahilang1)
head(hasil6)
##   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
mserpartt
## [1] 21.75938
rmserpartt
## [1] 4.664695
maperpartt
## [1] 31.22689

akurasi dan evaluasi lumayan baik tapi tidak dapat dikatakan sangat baik

Metode Missranger (mean machine)

library(missRanger)
hasil7<- missRanger(datahilang1, formula=.~., num.trees=200,seed=4)
## 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%
head(hasil7)
##   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
msemmm
## [1] 51.94585
rmsemmm
## [1] 7.207347
mapemmm
## [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.

library(imputeTS)
hasil8<-na_kalman(datahilang1)
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
msekalmann
## [1] 11.69681
rmsekalmann
## [1] 3.42006
mapekalmann
## [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)

library(missMethods)
## Warning: package 'missMethods' was built under R version 4.3.3
library(norm)
## 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.
ds_imp <- impute_EM(datahilang1, stochastic = FALSE)
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
msemm
## [1] 27.2264
rmsemm
## [1] 5.217892
mapemm
## [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