Classification 2 : Random Forest Model

1. Latar Belakang Masalah
2. Baca dan Inspect Data
3. Preprocessing
4. Cross Validation
- 4.1 Bagi data menjadi train dan test
- 4.2 Cek proporsi target variable
5. Random Forest Model
6. Evaluasi Model
7. Kesimpulan

library(dplyr)
library(tidyverse)
library(caret)
library(randomForest)
library(rsample)
library(ggplot2)
library(plotly)

1. Latar Belakang Masalah

Pada LBB kali ini, saya ingin menentukan produk mana yang harus terus saya jual atau produk yang harus saya hapus dari daftar inventory. Saya memiliki data-data yang mampu membantu saya untuk melakukan analisis hal-hal apa saja yang perlu ditingkatkan untuk penjualan produk saya. Adapun data yang saya gunakan adalah data sales dari kaggle.com

Metode machine learning yang akan saya gunakan adalah random forest. Hal ini dikarenakan data yang digunakan banyak memuat variable numerik pada prediktor variable nya, dan saya ingin menghindari overfitting yang bisa terjadi ketika saya menggunakan decision tree.

2. Baca dan Inspect Data

sales <- read.csv("C2/C2/data_input/SalesKaggle3.csv")
str(sales)

## 'data.frame':    198917 obs. of  14 variables:
##  $ Order           : int  2 3 4 6 7 8 9 10 11 12 ...
##  $ File_Type       : Factor w/ 2 levels "Active","Historical": 2 2 2 2 2 2 2 2 2 2 ...
##  $ SKU_number      : int  1737127 3255963 612701 115883 863939 214948 484059 146401 110568 764270 ...
##  $ SoldFlag        : int  0 0 0 1 1 0 0 0 0 0 ...
##  $ SoldCount       : int  0 0 0 1 1 0 0 0 0 0 ...
##  $ MarketingType   : Factor w/ 2 levels "D","S": 1 1 1 1 1 1 1 1 1 1 ...
##  $ ReleaseNumber   : int  15 7 0 4 2 0 13 4 11 5 ...
##  $ New_Release_Flag: int  1 1 0 1 1 0 1 1 1 1 ...
##  $ StrengthFactor  : num  682743 1016014 340464 334011 1287938 ...
##  $ PriceReg        : num  45 24.8 46 100 122 ...
##  $ ReleaseYear     : int  2015 2005 2013 2006 2010 2011 2010 2011 2008 2004 ...
##  $ ItemCount       : int  8 39 34 20 28 33 33 57 36 19 ...
##  $ LowUserPrice    : num  29 0 30.2 133.9 4 ...
##  $ LowNetPrice     : num  31.8 15.5 28 83.2 24 ...

Dapat dilihat bahwa data yang saya miliki adalah 198917 observasi dengan 14 variable, dengan keterangan sebagai berikut :

Order: Hanya penghitung berurutan
File_Type : Tipe file yaitu data penjualan historical dan data inventory active
SKU_number: Ini adalah pengidentifikasi unik untuk setiap produk.
SoldFlag: 1 = klasifikasi data apakah data terjual dalam 6 mos terakhir. 0 = Tidak terjual
MarketingType = Dua kategori bagaimana memasarkan produk.
New_Release_Flag = Produk apa pun yang memiliki rilis di masa mendatang

3. Preprocessing

colSums(is.na(sales))

##            Order        File_Type       SKU_number         SoldFlag 
##                0                0                0           122921 
##        SoldCount    MarketingType    ReleaseNumber New_Release_Flag 
##           122921                0                0                0 
##   StrengthFactor         PriceReg      ReleaseYear        ItemCount 
##                0                0                0                0 
##     LowUserPrice      LowNetPrice 
##                0                0

sales[is.na(sales)] <- 0
anyNA(sales)

## [1] FALSE

colSums(is.na(sales))

##            Order        File_Type       SKU_number         SoldFlag 
##                0                0                0                0 
##        SoldCount    MarketingType    ReleaseNumber New_Release_Flag 
##                0                0                0                0 
##   StrengthFactor         PriceReg      ReleaseYear        ItemCount 
##                0                0                0                0 
##     LowUserPrice      LowNetPrice 
##                0                0

colnames(sales) <- tolower(colnames(sales))

Dari 14 variable diatas, saya ingin menjadikan SoldFlag sebagai target variable saya, dimana SoldFlag memginformasikan apakah produk terjual dalam 6 bulan terakhir atau tidak terjual dalam 6 bulan terakhir.

3.1 Mengubah tipe class target

sales$soldflag <- as.factor(sales$soldflag)
dim(sales)

## [1] 198917     14

str(sales)

## 'data.frame':    198917 obs. of  14 variables:
##  $ order           : int  2 3 4 6 7 8 9 10 11 12 ...
##  $ file_type       : Factor w/ 2 levels "Active","Historical": 2 2 2 2 2 2 2 2 2 2 ...
##  $ sku_number      : int  1737127 3255963 612701 115883 863939 214948 484059 146401 110568 764270 ...
##  $ soldflag        : Factor w/ 2 levels "0","1": 1 1 1 2 2 1 1 1 1 1 ...
##  $ soldcount       : num  0 0 0 1 1 0 0 0 0 0 ...
##  $ marketingtype   : Factor w/ 2 levels "D","S": 1 1 1 1 1 1 1 1 1 1 ...
##  $ releasenumber   : int  15 7 0 4 2 0 13 4 11 5 ...
##  $ new_release_flag: int  1 1 0 1 1 0 1 1 1 1 ...
##  $ strengthfactor  : num  682743 1016014 340464 334011 1287938 ...
##  $ pricereg        : num  45 24.8 46 100 122 ...
##  $ releaseyear     : int  2015 2005 2013 2006 2010 2011 2010 2011 2008 2004 ...
##  $ itemcount       : int  8 39 34 20 28 33 33 57 36 19 ...
##  $ lowuserprice    : num  29 0 30.2 133.9 4 ...
##  $ lownetprice     : num  31.8 15.5 28 83.2 24 ...

head(sales)

##   order  file_type sku_number soldflag soldcount marketingtype
## 1     2 Historical    1737127        0         0             D
## 2     3 Historical    3255963        0         0             D
## 3     4 Historical     612701        0         0             D
## 4     6 Historical     115883        1         1             D
## 5     7 Historical     863939        1         1             D
## 6     8 Historical     214948        0         0             D
##   releasenumber new_release_flag strengthfactor pricereg releaseyear
## 1            15                1         682743    44.99        2015
## 2             7                1        1016014    24.81        2005
## 3             0                0         340464    46.00        2013
## 4             4                1         334011   100.00        2006
## 5             2                1        1287938   121.95        2010
## 6             0                0        1783153   132.00        2011
##   itemcount lowuserprice lownetprice
## 1         8        28.97       31.84
## 2        39         0.00       15.54
## 3        34        30.19       27.97
## 4        20       133.93       83.15
## 5        28         4.00       23.99
## 6        33       138.98       13.64

3.2 Menghapus variable

Untuk menghapus variable-variable yang memiliki variansi 0, digunakan fungsi nearZeroVar().

sales_n0v <- nearZeroVar(sales)
sales_v <- sales[,-sales_n0v]

Saya juga akan menghapus beberapa variable yang tidak berpengaruh terhadap target variable.

sales_v <- sales_v %>% select(-order,
                   -sku_number,
                   -releasenumber,
                   -new_release_flag
                   )
str(sales_v)

## 'data.frame':    198917 obs. of  9 variables:
##  $ file_type     : Factor w/ 2 levels "Active","Historical": 2 2 2 2 2 2 2 2 2 2 ...
##  $ soldflag      : Factor w/ 2 levels "0","1": 1 1 1 2 2 1 1 1 1 1 ...
##  $ marketingtype : Factor w/ 2 levels "D","S": 1 1 1 1 1 1 1 1 1 1 ...
##  $ strengthfactor: num  682743 1016014 340464 334011 1287938 ...
##  $ pricereg      : num  45 24.8 46 100 122 ...
##  $ releaseyear   : int  2015 2005 2013 2006 2010 2011 2010 2011 2008 2004 ...
##  $ itemcount     : int  8 39 34 20 28 33 33 57 36 19 ...
##  $ lowuserprice  : num  29 0 30.2 133.9 4 ...
##  $ lownetprice   : num  31.8 15.5 28 83.2 24 ...

3.3 Cek table variable

Cek table variable file_type, marketingtype, soldflag

table(sales_v$file_type)

## 
##     Active Historical 
##     122921      75996

table(sales_v$soldflag)

## 
##      0      1 
## 185921  12996

table(sales_v$marketingtype)

## 
##      D      S 
##  97971 100946

file_type = data penjualan historis ‘Historical’ lebih sedikit dibandingkan dengan data inventory aktif ‘Active’ atau yang tidak terjual.
soldflag = data produk yang tidak terjual selama 6 bulan trakhir lebih banyak dibandingkan yang terjual
marketingtype = kategori pemasaran produk S lebih banyak dibanding D.

Cek table antar variable file_type dengan soldflag, dan marketingtype dengan soldflag

table(sales_v$file_type, sales_v$soldflag)

##             
##                   0      1
##   Active     122921      0
##   Historical  63000  12996

table(sales_v$marketingtype, sales_v$soldflag)

##    
##         0     1
##   D 88817  9154
##   S 97104  3842

Dari hasil di atas didapat :

Sebanyak 12996 data penjualan historis yang laku terjual selama 6 bulan terakhir, dan sisanya merupakan tidak laku terjual, dan seluruh data inventory aktif tidak terjual
Kategori pemasaran yang berhasil menjual produk selama 6 bulan terakhir paling banyak yaitu pemasaran D, dapat diartikan pemasaran D lebih baik dibandingkan pemasaran S

Bagi data penjualan historis dan active

historical_sales <- subset(sales_v, file_type == "Historical")
active_sales <- subset(sales_v, file_type == "Active")

Visualisasi variable releaseyear terhadap soldflag dari tipe pemasaran yang berbeda

plot1 <- ggplot(historical_sales, aes(releaseyear, fill=soldflag)) + 
  geom_bar() + 
  facet_wrap(~historical_sales$marketingtype) +
  xlab("Release year of product") +
  ylab("Total SKU count") +
  ggtitle("Overview of Different Marketing Type Impact To Historical Sales")

ggplotly(plot1)

4. Cross Validation

4.1 Bagi data menjadi train dan test

Bagi data menjadi train-test atau train-test-validation (opsional untuk random forest). Kalau pakai random forest, train-test sudah otomatis dilakukan oleh proses k-fold cross validation

set.seed(123)
sales_intrain <- initial_split(data = sales_v, prop = 0.8 , strata = "soldflag")
train_sales <- training(sales_intrain)
test_sales <- testing(sales_intrain)

4.2 Cek proporsi target variable

prop.table(table(sales$soldflag))

## 
##          0          1 
## 0.93466622 0.06533378

prop.table(table(train_sales$soldflag))

## 
##          0          1 
## 0.93452688 0.06547312

prop.table(table(test_sales$soldflag))

## 
##          0          1 
## 0.93522359 0.06477641

5. Random Forest Model

Saya telah melakukan percobaan untuk membuat random forest dengan kombinasi dari jumlah fold adalah 2 dan repeats 1. Adapun untuk mempersingkat waktu, saya telah menyimpannya ke dalam format RDS. Sehingga model yang dibuat reproducible

5.1 Buat Model

#set.seed(417)
#ctrl21 <- trainControl(method="repeatedcv", number=2, repeats=1)
#sales_forest <- train(soldflag ~ ., data=train_sales, method="rf", trControl = ctrl21)

5.2 Save model kedalam format .RDS

#saveRDS(sales_forest, "sales_forest_2N1R.RDS")

5.3 Read model

s21 <- readRDS("sales_forest_2N1R.RDS")

s21$finalModel

## 
## Call:
##  randomForest(x = x, y = y, mtry = param$mtry) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 2
## 
##         OOB estimate of  error rate: 6.18%
## Confusion matrix:
##        0    1 class.error
## 0 148084  738 0.004958944
## 1   9102 1210 0.882660978

6. Evaluasi Model

confusionMatrix(predict(s21, test_sales), test_sales$soldflag)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 37168  1472
##          1    38  1105
##                                                
##                Accuracy : 0.962                
##                  95% CI : (0.9601, 0.9639)     
##     No Information Rate : 0.9352               
##     P-Value [Acc > NIR] : < 0.00000000000000022
##                                                
##                   Kappa : 0.5773               
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.9990               
##             Specificity : 0.4288               
##          Pos Pred Value : 0.9619               
##          Neg Pred Value : 0.9668               
##              Prevalence : 0.9352               
##          Detection Rate : 0.9343               
##    Detection Prevalence : 0.9713               
##       Balanced Accuracy : 0.7139               
##                                                
##        'Positive' Class : 0                    
##

plot_rf1 <- plot(s21$finalModel)
legend("topright", colnames(s21$finalModel$err.rate),col=1:6,cex=0.8,fill=1:6)

7. Kesimpulan

Setelah membuat model dengan menggunakan 2 folds dan 1 repeat, saya mendapatkan hasil nilai OOB sebesar 6.18% . Selain itu,, dengan menginspek terhadap evaluasi model, didapat evaluasi model dengan accuracy sebesar 93.57% .