This material is to practise machine learning with mlr package. If you want to learn more about it, please see this link

In this tutorial, Random Forest classification models will be built to predict three levels of classes using a dataset called wine from HDclassif package. Let’s get started.

Load required library and dataset

# Predicting diabetes 

library(HDclassif) # Diabetes data from this package

library(tibble)

library(tidyverse)

library(ggplot2)

library(mlr) # Machine learning with r package

data(wine, package = "HDclassif")

wine_tibble<-as_tibble(wine)

head(wine_tibble) # Look at first few rows 
NA

Data cleaning

Rename the wine_tibble data

names(wine_tibble) <- c("Class", "Alco", "Malic", "Ash", "Alk", "Mag",
                    "Phe", "Flav", "Non_flav", "Proan", "Col", "Hue",
                    "OD", "Prol")

head(wine_tibble)
NA

This dataset has 14 columns and 178 rows (cases).

Convert Class variable to factor
wine_tibble$Class<-as.factor(wine_tibble$Class)
Rename levels of class as wine A, B and C
# Using for loop to assign levels A, B and C

for (i in 1:nrow(wine_tibble)){
  if (wine_tibble$Class[i]=="1"){
    wine_tibble$Types[i]<-"A"
  } else if(wine_tibble$Class[i]=="2"){
    wine_tibble$Types[i]<-"B"
  }else{
    wine_tibble$Types[i]<-"C"
  }
}
Unknown or uninitialised column: 'Types'.
# Convert as factor levels
wine_tibble$Types<-as.factor(wine_tibble$Types)

wine_tibble<- wine_tibble %>% select(-Class) # Remove Class variable 

tail(wine_tibble)
NA
Visualizing the data by boxplot
# Convert long data to wide data

Visual<-wine_tibble %>% gather(key="Predictors", value = "Values",-Types)

ggplot(Visual) + facet_wrap(~Predictors, scales="free_y")+ geom_boxplot(aes(x=Types,y=Values, fill=Types)) + theme_bw()

Building Random Forest

Create Task, Learner
# Create a task, learner 
df<- data.frame(wine_tibble)

RF_task<-makeClassifTask(data=df, target = "Types")

library(randomForest)

RF_learner<-makeLearner("classif.randomForest")
Find hyperparameters

Thare are some parameters need to be optimized

paraspace<-makeParamSet(makeIntegerParam("ntree", lower = 200, upper = 500), makeIntegerParam("mtry", lower = 3, upper = 8),
                        makeIntegerParam("nodesize", lower = 1,upper = 3), makeIntegerParam("maxnodes", lower = 5, upper = 15))

randsearch<-makeTuneControlRandom(maxit=100)

Kfold<-makeResampleDesc(method = "RepCV", folds=10, reps=5, stratify = T)

library(parallel)
library(parallelMap)
package 㤼㸱parallelMap㤼㸲 was built under R version 3.6.3
parallelStartSocket(cpus = detectCores())
Starting parallelization in mode=socket with cpus=8.
Turning_para<-tuneParams(RF_learner,RF_task,resampling = Kfold, par.set = paraspace, control = randsearch)
[Tune] Started tuning learner classif.randomForest for parameter set:

With control class: TuneControlRandom
Imputation value: 1
Exporting objects to slaves for mode socket: .mlr.slave.options
Mapping in parallel: mode = socket; level = mlr.tuneParams; cpus = 8; elements = 100.
[Tune] Result: ntree=255; mtry=3; nodesize=2; maxnodes=14 : mmce.test.mean=0.0168778
parallelStop()
Stopped parallelization. All cleaned up.
Turning_para
Tune result:
Op. pars: ntree=255; mtry=3; nodesize=2; maxnodes=14
mmce.test.mean=0.0168778

Set hyperparameters as filtered through turning paparmeter process

RF_Set<-setHyperPars(RF_learner, par.vals = Turning_para$x)

train_RF<-train(RF_Set, RF_task)
Plotting the random forest
get_RF <- getLearnerModel(train_RF)

plot(get_RF)

Class_wine <- colnames(get_RF$err.rate)

legend("topright", Class_wine,
       col = 1:length(Class_wine),
       lty = 1:length(Class_wine))

Cross-validating the model

outer <- makeResampleDesc("RepCV", reps = 2, stratify = T, folds=2)

forestWrapper <- makeTuneWrapper("classif.randomForest", resampling = outer,
                                 par.set = paraspace,
                                 control = randsearch)

parallelStartSocket(cpus = detectCores())
Starting parallelization in mode=socket with cpus=8.
cvWithTuning <- resample(forestWrapper, RF_task, resampling = outer)
Exporting objects to slaves for mode socket: .mlr.slave.options
Resampling: repeated cross-validation
Measures:             mmce      
Mapping in parallel: mode = socket; level = mlr.resample; cpus = 8; elements = 4.


Aggregated Result: mmce.test.mean=0.0169823
parallelStop()
Stopped parallelization. All cleaned up.
cvWithTuning
Resample Result
Task: df
Learner: classif.randomForest.tuned
Aggr perf: mmce.test.mean=0.0169823
Runtime: 19.3315

Check confusion matrix

calculateConfusionMatrix(cvWithTuning$pred,relative = T)
Relative confusion matrix (normalized by row/column):
        predicted
true     A         B         C         -err.-   
  A      0.98/0.98 0.02/0.01 0.00/0.00 0.02     
  B      0.01/0.02 0.97/0.99 0.01/0.02 0.03     
  C      0.00/0.00 0.00/0.00 1.00/0.98 0.00     
  -err.-      0.02      0.01      0.02 0.02     


Absolute confusion matrix:
        predicted
true       A   B  C -err.-
  A      116   2  0      2
  B        2 138  2      4
  C        0   0 96      0
  -err.-   2   2  2      6
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQNCiAgaHRtbF9kb2N1bWVudDoNCiAgICBkZl9wcmludDogcGFnZWQNCi0tLQ0KDQpUaGlzIG1hdGVyaWFsIGlzIHRvIHByYWN0aXNlIGBtYWNoaW5lIGxlYXJuaW5nIHdpdGggbWxyYCBwYWNrYWdlLiBJZiB5b3Ugd2FudCB0byBsZWFybiBtb3JlIGFib3V0IGl0LCBwbGVhc2Ugc2VlIHRoaXMgW2xpbmtdKGh0dHBzOi8vd3d3Lm1hbm5pbmcuY29tL2Jvb2tzL21hY2hpbmUtbGVhcm5pbmctd2l0aC1yLXRoZS10aWR5dmVyc2UtYW5kLW1scikNCg0KSW4gdGhpcyB0dXRvcmlhbCwgYCBSYW5kb20gRm9yZXN0YCBjbGFzc2lmaWNhdGlvbiBtb2RlbHMgd2lsbCBiZSBidWlsdCB0byBwcmVkaWN0IHRocmVlIGxldmVscyBvZiBjbGFzc2VzIHVzaW5nIGEgZGF0YXNldCBjYWxsZWQgYHdpbmVgIGZyb20gYEhEY2xhc3NpZmAgcGFja2FnZS4gTGV0J3MgZ2V0IHN0YXJ0ZWQuDQoNCiMgTG9hZCByZXF1aXJlZCBsaWJyYXJ5IGFuZCBkYXRhc2V0DQoNCmBgYHtyfQ0KIyBQcmVkaWN0aW5nIGRpYWJldGVzIA0KDQpsaWJyYXJ5KEhEY2xhc3NpZikgIyBEaWFiZXRlcyBkYXRhIGZyb20gdGhpcyBwYWNrYWdlDQoNCmxpYnJhcnkodGliYmxlKQ0KDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCg0KbGlicmFyeShnZ3Bsb3QyKQ0KDQpsaWJyYXJ5KG1scikgIyBNYWNoaW5lIGxlYXJuaW5nIHdpdGggciBwYWNrYWdlDQoNCmRhdGEod2luZSwgcGFja2FnZSA9ICJIRGNsYXNzaWYiKQ0KDQp3aW5lX3RpYmJsZTwtYXNfdGliYmxlKHdpbmUpDQoNCmhlYWQod2luZV90aWJibGUpICMgTG9vayBhdCBmaXJzdCBmZXcgcm93cyANCg0KYGBgDQoNCiMgRGF0YSBjbGVhbmluZyANCg0KIyMjIyMgUmVuYW1lIHRoZSB3aW5lX3RpYmJsZSBkYXRhDQoNCmBgYHtyfQ0KDQpuYW1lcyh3aW5lX3RpYmJsZSkgPC0gYygiQ2xhc3MiLCAiQWxjbyIsICJNYWxpYyIsICJBc2giLCAiQWxrIiwgIk1hZyIsDQogICAgICAgICAgICAgICAgICAgICJQaGUiLCAiRmxhdiIsICJOb25fZmxhdiIsICJQcm9hbiIsICJDb2wiLCAiSHVlIiwNCiAgICAgICAgICAgICAgICAgICAgIk9EIiwgIlByb2wiKQ0KDQpoZWFkKHdpbmVfdGliYmxlKQ0KDQpgYGANCg0KVGhpcyBkYXRhc2V0IGhhcyAxNCBjb2x1bW5zIGFuZCAxNzggcm93cyAoY2FzZXMpLiAgDQoNCiMjIyMjIENvbnZlcnQgYENsYXNzIHZhcmlhYmxlYCB0byBmYWN0b3IgDQoNCmBgYHtyfQ0Kd2luZV90aWJibGUkQ2xhc3M8LWFzLmZhY3Rvcih3aW5lX3RpYmJsZSRDbGFzcykNCg0KYGBgDQoNCiMjIyMjIFJlbmFtZSBsZXZlbHMgb2YgY2xhc3MgYXMgd2luZSBBLCBCIGFuZCBDDQoNCmBgYHtyfQ0KIyBVc2luZyBmb3IgbG9vcCB0byBhc3NpZ24gbGV2ZWxzIEEsIEIgYW5kIEMNCg0KZm9yIChpIGluIDE6bnJvdyh3aW5lX3RpYmJsZSkpew0KICBpZiAod2luZV90aWJibGUkQ2xhc3NbaV09PSIxIil7DQogICAgd2luZV90aWJibGUkVHlwZXNbaV08LSJBIg0KICB9IGVsc2UgaWYod2luZV90aWJibGUkQ2xhc3NbaV09PSIyIil7DQogICAgd2luZV90aWJibGUkVHlwZXNbaV08LSJCIg0KICB9ZWxzZXsNCiAgICB3aW5lX3RpYmJsZSRUeXBlc1tpXTwtIkMiDQogIH0NCn0NCiMgQ29udmVydCBhcyBmYWN0b3IgbGV2ZWxzDQp3aW5lX3RpYmJsZSRUeXBlczwtYXMuZmFjdG9yKHdpbmVfdGliYmxlJFR5cGVzKQ0KDQp3aW5lX3RpYmJsZTwtIHdpbmVfdGliYmxlICU+JSBzZWxlY3QoLUNsYXNzKSAjIFJlbW92ZSBDbGFzcyB2YXJpYWJsZSANCg0KdGFpbCh3aW5lX3RpYmJsZSkNCg0KYGBgDQoNCiMjIyMjIFZpc3VhbGl6aW5nIHRoZSBkYXRhIGJ5IGJveHBsb3QNCg0KYGBge3J9DQojIENvbnZlcnQgbG9uZyBkYXRhIHRvIHdpZGUgZGF0YQ0KDQpWaXN1YWw8LXdpbmVfdGliYmxlICU+JSBnYXRoZXIoa2V5PSJQcmVkaWN0b3JzIiwgdmFsdWUgPSAiVmFsdWVzIiwtVHlwZXMpDQoNCmdncGxvdChWaXN1YWwpICsgZmFjZXRfd3JhcCh+UHJlZGljdG9ycywgc2NhbGVzPSJmcmVlX3kiKSsgZ2VvbV9ib3hwbG90KGFlcyh4PVR5cGVzLHk9VmFsdWVzLCBmaWxsPVR5cGVzKSkgKyB0aGVtZV9idygpDQoNCmBgYA0KDQoNCiMgQnVpbGRpbmcgUmFuZG9tIEZvcmVzdCANCg0KIyMjIyMgQ3JlYXRlIFRhc2ssIExlYXJuZXINCg0KYGBge3J9DQojIENyZWF0ZSBhIHRhc2ssIGxlYXJuZXIgDQpkZjwtIGRhdGEuZnJhbWUod2luZV90aWJibGUpDQoNClJGX3Rhc2s8LW1ha2VDbGFzc2lmVGFzayhkYXRhPWRmLCB0YXJnZXQgPSAiVHlwZXMiKQ0KDQpsaWJyYXJ5KHJhbmRvbUZvcmVzdCkNCg0KUkZfbGVhcm5lcjwtbWFrZUxlYXJuZXIoImNsYXNzaWYucmFuZG9tRm9yZXN0IikNCg0KDQpgYGANCg0KIyMjIyMgRmluZCBoeXBlcnBhcmFtZXRlcnMgDQpUaGFyZSBhcmUgc29tZSBwYXJhbWV0ZXJzIG5lZWQgdG8gYmUgb3B0aW1pemVkIA0KDQpgYGB7cn0NCnBhcmFzcGFjZTwtbWFrZVBhcmFtU2V0KG1ha2VJbnRlZ2VyUGFyYW0oIm50cmVlIiwgbG93ZXIgPSAyMDAsIHVwcGVyID0gNTAwKSwgbWFrZUludGVnZXJQYXJhbSgibXRyeSIsIGxvd2VyID0gMywgdXBwZXIgPSA4KSwNCiAgICAgICAgICAgICAgICAgICAgICAgIG1ha2VJbnRlZ2VyUGFyYW0oIm5vZGVzaXplIiwgbG93ZXIgPSAxLHVwcGVyID0gMyksIG1ha2VJbnRlZ2VyUGFyYW0oIm1heG5vZGVzIiwgbG93ZXIgPSA1LCB1cHBlciA9IDE1KSkNCg0KcmFuZHNlYXJjaDwtbWFrZVR1bmVDb250cm9sUmFuZG9tKG1heGl0PTEwMCkNCg0KS2ZvbGQ8LW1ha2VSZXNhbXBsZURlc2MobWV0aG9kID0gIlJlcENWIiwgZm9sZHM9MTAsIHJlcHM9NSwgc3RyYXRpZnkgPSBUKQ0KDQpsaWJyYXJ5KHBhcmFsbGVsKQ0KbGlicmFyeShwYXJhbGxlbE1hcCkNCg0KcGFyYWxsZWxTdGFydFNvY2tldChjcHVzID0gZGV0ZWN0Q29yZXMoKSkNCg0KVHVybmluZ19wYXJhPC10dW5lUGFyYW1zKFJGX2xlYXJuZXIsUkZfdGFzayxyZXNhbXBsaW5nID0gS2ZvbGQsIHBhci5zZXQgPSBwYXJhc3BhY2UsIGNvbnRyb2wgPSByYW5kc2VhcmNoKQ0KDQpwYXJhbGxlbFN0b3AoKQ0KDQpUdXJuaW5nX3BhcmENCg0KYGBgDQoNCiMgU2V0IGh5cGVycGFyYW1ldGVycyBhcyBmaWx0ZXJlZCB0aHJvdWdoIHR1cm5pbmcgcGFwYXJtZXRlciBwcm9jZXNzDQoNCmBgYHtyfQ0KUkZfU2V0PC1zZXRIeXBlclBhcnMoUkZfbGVhcm5lciwgcGFyLnZhbHMgPSBUdXJuaW5nX3BhcmEkeCkNCg0KdHJhaW5fUkY8LXRyYWluKFJGX1NldCwgUkZfdGFzaykNCg0KYGBgDQoNCiMjIyMjIFBsb3R0aW5nIHRoZSByYW5kb20gZm9yZXN0IA0KDQpgYGB7cn0NCmdldF9SRiA8LSBnZXRMZWFybmVyTW9kZWwodHJhaW5fUkYpDQoNCnBsb3QoZ2V0X1JGKQ0KDQpDbGFzc193aW5lIDwtIGNvbG5hbWVzKGdldF9SRiRlcnIucmF0ZSkNCg0KbGVnZW5kKCJ0b3ByaWdodCIsIENsYXNzX3dpbmUsDQogICAgICAgY29sID0gMTpsZW5ndGgoQ2xhc3Nfd2luZSksDQogICAgICAgbHR5ID0gMTpsZW5ndGgoQ2xhc3Nfd2luZSkpDQoNCmBgYA0KDQojIENyb3NzLXZhbGlkYXRpbmcgdGhlIG1vZGVsDQoNCmBgYHtyfQ0Kb3V0ZXIgPC0gbWFrZVJlc2FtcGxlRGVzYygiUmVwQ1YiLCByZXBzID0gMiwgc3RyYXRpZnkgPSBULCBmb2xkcz0yKQ0KDQpmb3Jlc3RXcmFwcGVyIDwtIG1ha2VUdW5lV3JhcHBlcigiY2xhc3NpZi5yYW5kb21Gb3Jlc3QiLCByZXNhbXBsaW5nID0gb3V0ZXIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwYXIuc2V0ID0gcGFyYXNwYWNlLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY29udHJvbCA9IHJhbmRzZWFyY2gpDQoNCnBhcmFsbGVsU3RhcnRTb2NrZXQoY3B1cyA9IGRldGVjdENvcmVzKCkpDQoNCmN2V2l0aFR1bmluZyA8LSByZXNhbXBsZShmb3Jlc3RXcmFwcGVyLCBSRl90YXNrLCByZXNhbXBsaW5nID0gb3V0ZXIpDQoNCnBhcmFsbGVsU3RvcCgpDQoNCmN2V2l0aFR1bmluZw0KDQpgYGANCg0KIyBDaGVjayBjb25mdXNpb24gbWF0cml4IA0KDQpgYGB7cn0NCmNhbGN1bGF0ZUNvbmZ1c2lvbk1hdHJpeChjdldpdGhUdW5pbmckcHJlZCxyZWxhdGl2ZSA9IFQpDQoNCmBgYA0KDQoNCg==