1. Setup

Libraries and Setup

We’ll set-up caching for this notebook given how computationally expensive some of the code we will write can get.

You will need to use install.packages() to install any packages that are not already downloaded onto your machine. You then load the package into your workspace using the library() function:

1
2


library(tidyverse)
library(caret)

2. Nested Dataframe

You’ll learn how to use purrr, caret and dplyr to quickly create some of dataset + model combinations, store data & model objects neatly in one tibble, and post process programatically. These tools enable succinct functional programming in which a lot gets done with just a few lines of code. The data to be used is loan.csv which can be downloaded here link here. In this article we will predict the default variable which has a yes or no value.

1
2


loan <- read.csv("data_input/loan.csv")
glimpse(loan)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19


#> Rows: 1,000
#> Columns: 17
#> $ checking_balance     <chr> "< 0 DM", "1 - 200 DM", "unknown", "< 0 DM", "< 0…
#> $ months_loan_duration <int> 6, 48, 12, 42, 24, 36, 24, 36, 12, 30, 12, 48, 12…
#> $ credit_history       <chr> "critical", "good", "critical", "good", "poor", "…
#> $ purpose              <chr> "furniture/appliances", "furniture/appliances", "…
#> $ amount               <int> 1169, 5951, 2096, 7882, 4870, 9055, 2835, 6948, 3…
#> $ savings_balance      <chr> "unknown", "< 100 DM", "< 100 DM", "< 100 DM", "<…
#> $ employment_duration  <chr> "> 7 years", "1 - 4 years", "4 - 7 years", "4 - 7…
#> $ percent_of_income    <int> 4, 2, 2, 2, 3, 2, 3, 2, 2, 4, 3, 3, 1, 4, 2, 4, 4…
#> $ years_at_residence   <int> 4, 2, 3, 4, 4, 4, 4, 2, 4, 2, 1, 4, 1, 4, 4, 2, 4…
#> $ age                  <int> 67, 22, 49, 45, 53, 35, 53, 35, 61, 28, 25, 24, 2…
#> $ other_credit         <chr> "none", "none", "none", "none", "none", "none", "…
#> $ housing              <chr> "own", "own", "own", "other", "other", "other", "…
#> $ existing_loans_count <int> 2, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2…
#> $ job                  <chr> "skilled", "skilled", "unskilled", "skilled", "sk…
#> $ dependents           <int> 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
#> $ phone                <chr> "yes", "no", "no", "no", "no", "yes", "no", "yes"…
#> $ default              <chr> "no", "yes", "no", "no", "yes", "no", "no", "no",…

1
2
3
4
5
6


loan <- loan %>%
  head(-10)

test <- loan %>% 
  tail(10) %>% 
  select(-default)

The loan data will be divided into test data and loan data. Test data will be used when testing the model that has been made, while the data loan will be used to model the classification.

2.1 Single Data Frame x Multiple Model

Before creating a nested dataframe, we must prepare a model that will be used first. The model to be used must be used as a function to make it easier when used in the map () function that comes from the purrr package. besides that we can set the parameters that will be used in the function. In the chunk below 2 models are created, namely the decision tree and random forest using the caret package.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29


#create Random forest function
RandomForestModel <- function(X, Y){
    ctrl <- trainControl(
        method = "cv",
        number = 3
    )
    train(
        x = X,
        y = Y,
        trContrl = ctrl,
        method = 'rf'
    )
}

#create decision tree function
RpartModel <- function(X, Y) {
    ctrl <- trainControl(
        method = "repeatedcv",
        number = 5
    )
    train(
        x = X,
        y = Y,
        method = 'rpart2',
        trControl = ctrl,
        tuneGrid = data.frame(maxdepth=c(2,3,4,5)),
        preProc = c('center', 'scale')
    )
}

After making a model in the form of a function, then making the model into a dataframe.

1
2
3
4


model_list <- list(rpart = RpartModel,
                   rforest = RandomForestModel) %>%
    enframe(name = 'modelName',value = 'model')
model_list

1
2
3
4
5


#> # A tibble: 2 × 2
#>   modelName model 
#>   <chr>     <list>
#> 1 rpart     <fn>  
#> 2 rforest   <fn>

model_list produces 2 columns, namely modelName, and model. ModelName is the name of the model, and the model contains the functions of the model. Next the dataframe to be used replicates as many models as you want to use. The loan dataset will be replicates as much as the model used by rep () function.

1
2
3
4
5
6


nmodel <- length(model_list) #get length of model_list

nested.loan <- list(loan) %>% 
  rep(nmodel) %>% 
  enframe(name = "Id", value = "rawdata")
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 2
#>      Id rawdata        
#>   <int> <list>         
#> 1     1 <df [990 × 17]>
#> 2     2 <df [990 × 17]>

nested.loan has 2 columns, namely Id and rawdata which contain the loan dataframe. Then rawdata will be separated into train.y which contains the default variable and train.x contains the others.

1
2
3
4


nested.loan <- nested.loan %>% 
  mutate(train.x = map(rawdata, ~select(.x, -default)),
         train.y = map(rawdata, ~.x$default))
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 4
#>      Id rawdata         train.x         train.y    
#>   <int> <list>          <list>          <list>     
#> 1     1 <df [990 × 17]> <df [990 × 16]> <chr [990]>
#> 2     2 <df [990 × 17]> <df [990 × 16]> <chr [990]>

The next step is to join nested.loan with model_list using bind_cols ()

1
2
3


nested.loan <- nested.loan %>% 
  bind_cols(model_list)
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 6
#>      Id rawdata         train.x         train.y     modelName model 
#>   <int> <list>          <list>          <list>      <chr>     <list>
#> 1     1 <df [990 × 17]> <df [990 × 16]> <chr [990]> rpart     <fn>  
#> 2     2 <df [990 × 17]> <df [990 × 16]> <chr [990]> rforest   <fn>

The model we have created can be used with the function invoke_map () which functions to combine functions and lists as parameters.

1
2
3
4


nested.loan <- nested.loan %>% 
  mutate(parm = map2(train.x, train.y, ~list(.x, .y)),
         model = invoke_map(model,parm))
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 7
#>      Id rawdata         train.x         train.y     modelName model   parm      
#>   <int> <list>          <list>          <list>      <chr>     <list>  <list>    
#> 1     1 <df [990 × 17]> <df [990 × 16]> <chr [990]> rpart     <train> <list [2]>
#> 2     2 <df [990 × 17]> <df [990 × 16]> <chr [990]> rforest   <train> <list [2]>

To see how well the model has been made, it can be seen from the Accuracy of each model.

1
2
3
4


nested.loan <- nested.loan %>% 
  mutate(Accuracy = map_dbl(model, ~max(.x$results$Accuracy))) %>% 
  arrange(desc(Accuracy))
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 8
#>      Id rawdata         train.x train.y     modelName model   parm   Accuracy
#>   <int> <list>          <list>  <list>      <chr>     <list>  <list>    <dbl>
#> 1     2 <df [990 × 17]> <df>    <chr [990]> rforest   <train> <list>    0.750
#> 2     1 <df [990 × 17]> <df>    <chr [990]> rpart     <train> <list>    0.731

From the above results it can be seen that the random forest model produces an accuracy of 0.75 and the decission tree is 0.74. Next, we will do predict to the test data that has been made using an existing model. the data test must replicate as many models as used and then join the nested.loan data using left_join()

1
2
3
4
5
6


nested.loan <- test %>% 
  list() %>% 
  rep(nrow(nested.loan)) %>% 
  enframe(name = "Id",value = "test.x") %>% 
  left_join(nested.loan, by = "Id")
nested.loan

1
2
3
4
5


#> # A tibble: 2 × 9
#>      Id test.x         rawdata train.x train.y modelName model   parm   Accuracy
#>   <int> <list>         <list>  <list>  <list>  <chr>     <list>  <list>    <dbl>
#> 1     1 <df [10 × 16]> <df>    <df>    <chr>   rpart     <train> <list>    0.731
#> 2     2 <df [10 × 16]> <df>    <df>    <chr>   rforest   <train> <list>    0.750

Now we create a pred variable that contains results from predict

1
2
3
4


nested.loan <- nested.loan %>% 
  mutate(pred = map2(model, test.x, ~predict(.x, .y))) %>% 
  select(Id,modelName,Accuracy,pred)
glimpse(nested.loan$pred)

1
2
3


#> List of 2
#>  $ : Factor w/ 2 levels "no","yes": 2 1 1 2 1 1 1 1 2 2
#>  $ : Factor w/ 2 levels "no","yes": 2 2 1 2 1 1 1 1 1 1

2.2 Multiple Data Frame x Single Model

Now we will split loan data by checking_balance variable which has 4 levels namely < 0 DM, > 200 DM, 1 - 200 DM, and unknown

1
2
3
4
5
6


nested.split <- loan %>%
  group_by(checking_balance) %>% 
  nest(.key = "rawdata") %>% 
  mutate(train.x = map(rawdata, ~select(.x, -default)),
         train.y = map(rawdata, ~.x$default))
nested.split

1
2
3
4
5
6
7
8


#> # A tibble: 4 × 4
#> # Groups:   checking_balance [4]
#>   checking_balance rawdata             train.x             train.y    
#>   <chr>            <list>              <list>              <list>     
#> 1 < 0 DM           <tibble [270 × 16]> <tibble [270 × 15]> <chr [270]>
#> 2 1 - 200 DM       <tibble [268 × 16]> <tibble [268 × 15]> <chr [268]>
#> 3 unknown          <tibble [389 × 16]> <tibble [389 × 15]> <chr [389]>
#> 4 > 200 DM         <tibble [63 × 16]>  <tibble [63 × 15]>  <chr [63]>

The model that will be used is random forest

1
2
3
4


nested.rf <- nested.split %>% 
  mutate(param = map2(train.x, train.y, ~list(.x, .y)),
         model = invoke_map(RandomForestModel,param))
nested.rf

1
2
3
4
5
6
7
8


#> # A tibble: 4 × 6
#> # Groups:   checking_balance [4]
#>   checking_balance rawdata             train.x            train.y param  model  
#>   <chr>            <list>              <list>             <list>  <list> <list> 
#> 1 < 0 DM           <tibble [270 × 16]> <tibble>           <chr>   <list> <train>
#> 2 1 - 200 DM       <tibble [268 × 16]> <tibble>           <chr>   <list> <train>
#> 3 unknown          <tibble [389 × 16]> <tibble>           <chr>   <list> <train>
#> 4 > 200 DM         <tibble [63 × 16]>  <tibble [63 × 15]> <chr>   <list> <train>

To see how well the model is made, we can see the accuracy obtained from the model we made.

1
2
3


nested.rf <- nested.rf %>% 
  mutate(Accuracy = map_dbl(model, ~max(.x$results$Accuracy)))
nested.rf

1
2
3
4
5
6
7
8


#> # A tibble: 4 × 7
#> # Groups:   checking_balance [4]
#>   checking_balance rawdata             train.x  train.y param  model   Accuracy
#>   <chr>            <list>              <list>   <list>  <list> <list>     <dbl>
#> 1 < 0 DM           <tibble [270 × 16]> <tibble> <chr>   <list> <train>    0.622
#> 2 1 - 200 DM       <tibble [268 × 16]> <tibble> <chr>   <list> <train>    0.665
#> 3 unknown          <tibble [389 × 16]> <tibble> <chr>   <list> <train>    0.879
#> 4 > 200 DM         <tibble [63 × 16]>  <tibble> <chr>   <list> <train>    0.745

2.3 Multiple Data Frame x Multiple Model

To run multi models against multi data, we must repeat data as much as the model that will be used. nested.split is a data loan that is divided based on the checking_balance variable which contains 4 levels while the model used is 2, namely random forest and decision tree, the amount of data is 8 (4 X 2).

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17


#replicates nested.split as much the model will be used
nested.multi <- nested.split %>% 
  list() %>%
  rep(nmodel) %>%
  bind_rows()

#replicates model_list as much the data frame
model.multi <- model_list %>% 
  list() %>% 
  rep(nrow(nested.split)) %>% 
  bind_rows() %>% 
  arrange(modelName)

#join nested.multi and model.multi
nested.multi <- nested.multi %>% 
  bind_cols(model.multi)
nested.multi

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12


#> # A tibble: 8 × 6
#> # Groups:   checking_balance [4]
#>   checking_balance rawdata             train.x  train.y     modelName model 
#>   <chr>            <list>              <list>   <list>      <chr>     <list>
#> 1 < 0 DM           <tibble [270 × 16]> <tibble> <chr [270]> rforest   <fn>  
#> 2 1 - 200 DM       <tibble [268 × 16]> <tibble> <chr [268]> rforest   <fn>  
#> 3 unknown          <tibble [389 × 16]> <tibble> <chr [389]> rforest   <fn>  
#> 4 > 200 DM         <tibble [63 × 16]>  <tibble> <chr [63]>  rforest   <fn>  
#> 5 < 0 DM           <tibble [270 × 16]> <tibble> <chr [270]> rpart     <fn>  
#> 6 1 - 200 DM       <tibble [268 × 16]> <tibble> <chr [268]> rpart     <fn>  
#> 7 unknown          <tibble [389 × 16]> <tibble> <chr [389]> rpart     <fn>  
#> 8 > 200 DM         <tibble [63 × 16]>  <tibble> <chr [63]>  rpart     <fn>

Now we can modeling each data category with each model

1
2
3
4


nested.multi <- nested.multi %>% 
  mutate(param = map2(train.x, train.y, ~list(.x, .y)),
         model = invoke_map(model,param))
nested.multi

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12


#> # A tibble: 8 × 7
#> # Groups:   checking_balance [4]
#>   checking_balance rawdata             train.x  train.y modelName model   param 
#>   <chr>            <list>              <list>   <list>  <chr>     <list>  <list>
#> 1 < 0 DM           <tibble [270 × 16]> <tibble> <chr>   rforest   <train> <list>
#> 2 1 - 200 DM       <tibble [268 × 16]> <tibble> <chr>   rforest   <train> <list>
#> 3 unknown          <tibble [389 × 16]> <tibble> <chr>   rforest   <train> <list>
#> 4 > 200 DM         <tibble [63 × 16]>  <tibble> <chr>   rforest   <train> <list>
#> 5 < 0 DM           <tibble [270 × 16]> <tibble> <chr>   rpart     <train> <list>
#> 6 1 - 200 DM       <tibble [268 × 16]> <tibble> <chr>   rpart     <train> <list>
#> 7 unknown          <tibble [389 × 16]> <tibble> <chr>   rpart     <train> <list>
#> 8 > 200 DM         <tibble [63 × 16]>  <tibble> <chr>   rpart     <train> <list>

1

nested.multi$model[[1]]$finalModel

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12


#> 
#> Call:
#>  randomForest(x = x, y = y, mtry = param$mtry, trContrl = ..1) 
#>                Type of random forest: classification
#>                      Number of trees: 500
#> No. of variables tried at each split: 8
#> 
#>         OOB estimate of  error rate: 37.04%
#> Confusion matrix:
#>     no yes class.error
#> no  83  53   0.3897059
#> yes 47  87   0.3507463

And we can see the accuracy each model

1
2


nested.multi <- nested.multi %>% 
  mutate(Accuracy = map_dbl(model, ~max(.x$results$Accuracy)))

1
2
3
4


library(lime)

model_result <- lime(x = nested.multi$train.x[[1]],nested.multi$model[[1]])
model_result$bin_continuous

1

#> [1] TRUE