# Bayesian hyperparameters optimization

**Modeling with R**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

## Introduction

Machine learning models are called by this name because of their ability to learn the best parameter values that are as closest as possible to the right values of the optimum objective function (or loss function). However, since all models require some assumptions (like linearity in linear regression models), parameters (like the cost C in svm models), and settings (like the number of layers in deep learning models) to be prespecified before training the model (in most cases are set by default ), the name of **machine learning** is not fully justified. Theses prespecified parameters are called **hyperparameters**, and should be defined in such a way that the corresponding model reaches its best performance (conditionally on the data at hand).

The search of the best hyperparameters called **tuning**, which simply is training the model with each combination of hyperparameter values many times, using some techniques like cross-validation to make sure that the resulted loss functions highly likely depends on this specific combination values (not by random chances), and then pick the best one that gives the optimum value for the objective function. This means that if our model requires long computational time (due to fewer hardware resources, or large dataset) we cannot try a large number of combinations, and hence we will be likely far away from the best result.

The main problem, however, is how do we define the space of these hyperparameters to choose from. Many methods are available:

**grid search**: Using this method the modeler provides the values for each parameter to evaluate and then pick the combination that gives the best result. However, this method based entirely on the experience of the modeler with the model in question and the data at hand. So with not enough experience, which is often the case, the choice in most cases would be arbitrary.**Random search**: with this method, we choose randomly the values for each hyperparameter, and it turns out that this method is sometimes more accurate than the previous one. However, this method also suffers from the arbitrary choice of values.**Bayesian hyperparameters**: This method uses Bayesian optimization to guide a little bit the search strategy to get the best hyperparameter values with minimum cost (the cost is the number of models to train). We will briefly discuss this method, but if you want more detail you can check the following great article.

we will focus on the best one which is **Bayesian hyperparameters**, but we first start by briefly introducing the others.

To well understand these methods we will make use of small dataset with a small number of predictors, and we will use two models, the machine learning model **Random forest** and the deep learning model **feedforward neural network**.

## Bayesian optimization

The main idea behind this method is very simple, at the first iteration we pick a point at random, then at each iteration, and based on Bayes rule, we make a trade-off between choosing the point that has the highest uncertainty (known as **active learning**) or choosing the point within the region that has already the best result (optimum objective function) until the current iteration. In more detail, let’s say we are dealing with maximization problem such as maximizing the accuracy rate for a classification problem, then, at each iteration, the Bayes optimization method should decide between focusing the search on the region that contains the best point (that resulted in the maximum objective function) until the current iteration (called **exploitation**), or inspecting another region with the highest uncertainty (called **exploration**). The question, however, is how can this method decide between these two options. Well, this method uses what is called **acquisition function**, which is a function that helps to decide what region should we inspect in the next iteration.

### Acquisition functions

Since this problem is always partially random, there exist many forms for this function, and we will discuss briefly the most common ones.

#### Upper confidence bound

Using this function, the following located point will be that that has the highest upper confidence bound, and, assuming the Gaussian process, this bound will be computed as follows:

\[UCB(x)=\mu(x)+\kappa\sigma(x)\]

Where \(\mu\) and \(\sigma\) are the mean and the standard deviation defined by the Gaussian process, and \(\kappa\) is an exploration parameter, the larger the values the more the exploration.

#### Probability of improvement PI

this acquisition function chooses the next point that has the highest probability of improvement over the current maximum objective function \(f_{max}\) obtained from the points evaluated previously.

Assuming the Gaussian process, the new point then will be the one that has the highest following probability:

\[PI(x)=\Phi\left(\frac{\mu(x)-f{max}-\varepsilon}{\sigma(x)}\right)\] Where \(\varepsilon\) plays the role for trading off between exploration and exploitation, such that larger values result in more exploration than exploitation

#### Expected improvement EI

This acquisition function, unlike the previous one, tries to quantify how much improvement we get with the new point, the new point that has the maximum expected value will be chosen.

Again, by assuming the Gaussian process, this function can be computed as follows:

\[EI(x) = \left(\mu(x)-f_{max}\right)\Phi\left(\frac{\mu(x)-f{max}-\varepsilon}{\sigma(x)}\right)+\sigma(x)\phi\left(\frac{\mu(x)-f{max}-\varepsilon}{\sigma(x)}\right)\]

## Data preparation

Let’s first call the packages needed along this article.

library(readr) library(tidymodels) library(themis) library(plot3D)

For our illustration, we will use data downloaded from the link described in the below script. It is already split between a training set and a testing set. The target variable is a highly imbalanced binary variable, and the data has a very large number of missing values. To make our analysis simpler, however, we will reduce the size of this data by first, removing the variables with a large number of missing values, then removing completely the remaining ones, and lastly correcting the imbalance distribution using downsampling method . For more detail about this data check my previous article.

train <- read_csv("https://archive.ics.uci.edu/ml/machine-learning-databases/00421/aps_failure_training_set.csv", skip = 20) test <- read_csv("https://archive.ics.uci.edu/ml/machine-learning-databases/00421/aps_failure_test_set.csv", skip = 20)

This data has 171 variables and a total of 76000 instances, 60000 in the training set, and 16000 in the testing sets. Notice that the missing values in the data are represented by lower case **na** values and not **NA** and hence are not recognized by R as missing values, That is why the **read_csv** function converted all the variables that have these values to the character type.

map_chr(train, typeof) %>% tibble() %>% table() . character double 170 1

To fix this problem, therefore, we replace na by NA then converting back the corresponding variable to the numeric type.

train[-1] <- train[-1] %>% modify(~replace(., .=="na", NA)) %>% modify(., as.double) test[-1] <- test[-1] %>% modify(~replace(., .=="na", NA)) %>% modify(., as.double)

Then we keep only the predictors that have less than 600 missing values, and thereafter, we keep only rows without missing values.

names <- modify(train[-1], is.na) %>% colSums() %>% tibble(names = colnames(train[-1]), missing_values=.) %>% filter(missing_values < 600) %>% select(1) train1 <- train[c("class",names$names)] %>% .[complete.cases(.),] test1 <- test[c("class",names$names)] %>% .[complete.cases(.),] dim(train1) [1] 58888 11 dim(test1) [1] 15728 11

As we see the data now has been reduced to 11 variables. The last thing to check is the distribution of the target variable.

prop.table(table(train1$class)) neg pos 0.98376579 0.01623421

As we see, the data is highly imbalanced, so we correct this problem by downsamplig using the **themis** package. But first, we create a recipe that defines the formula of our model, normalizes the predictors, and down sample the data. Then we execute the recipe to the data using **prep** function, and lastly we retrieve the transformed data by **juice** function.

train2 <- recipe(class~., data=train1) %>% step_normalize(all_predictors()) %>% step_downsample(class, seed = 111) %>% prep() %>% juice()

For the testing set, however, we can transform it by the same recipe, but at the end we make use of the **bake** function instead of **juice** that uses the data defined in the recipe.

test2 <- recipe(class~., data=train1) %>% step_normalize(all_predictors()) %>% themis::step_downsample(class, seed = 111) %>% prep() %>% bake(test1)

It should be noted here that the **step_downsample** is not needed for the testing set, that is why, the **bake** does not execute this step by default applied to any new data. We can check this by the dimension that still the same.

dim(test1); dim(test2) [1] 15728 11 [1] 15728 11

**Note**: The testing set is not needed, since our purpose is the hyperparameter tuning methods, which requires only the training set. But it is included only to show how it is processed with the work flow of tidymodels package.

## Random forest model

Since we are dealing with a classification problem, our objective function will be the area under the ROC curve **roc_area**. And for the model, we will use the most popular one, **Random forest** model with the two hyperparameters to tune:

**mtry**: The number of sampled predictors at each step.**min_n**: The minimum number of instances in the node to split further.

### The true distribution of the hyperparameters

With this small data, this model, in the sense of computational time, is not expensive, so we will try a wide range of values for the above hyperparameters, then we can use this as the true distribution to compare the performance of the hyperparameter tuning methods discussed above.

Using **tidymodels** package we define the model and we leave the `mtry`

and `min_n`

for tuning. To speed up, however, computation process we restrict the number of trees to 100 instead of the default fo 500 trees.

model_tune <- rand_forest(mtry = tune(), min_n = tune(), trees = 100L) %>% set_engine("ranger", seed=222) %>% set_mode("classification")

To avoid the pitfalls of random samples, we use the cross-validation technique.

set.seed(1234) folds <- vfold_cv(train2, v=5, strata = class)

Then we use the following work flow:

tune_wf <- workflow() %>% add_model(model_tune) %>% add_formula(class~.)

Now we are ready to train the model using a wide range of combination values, and then we assume that these combinations are the true distribution of our model. Note that we have 100 combinations, so if the model takes hours to train, then it will require days for tuning. To prevent the model to rerun when rendering this document we save the results in csv file then we load it again. If you want, however, to run this model then uncomment the script

#tuned <- tune_wf %>% # tune_grid(resamples = folds, # grid =expand.grid(mtry=1:10, min_n=1:10), # metrics=metric_set(roc_auc))

To extract the results we use the **collect_metrics** function.

#df <- tuned %>% collect_metrics() #write_csv(df, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df.csv") df <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df.csv") df <- df %>% arrange(-mean) %>% tibble(rank=seq_len(nrow(df)), .) df # A tibble: 100 x 8 rank mtry min_n .metric .estimator mean n std_err <int> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 1 1 2 roc_auc binary 0.984 5 0.00198 2 2 3 6 roc_auc binary 0.984 5 0.00204 3 3 3 7 roc_auc binary 0.983 5 0.00269 4 4 3 8 roc_auc binary 0.983 5 0.00304 5 5 2 10 roc_auc binary 0.983 5 0.00200 6 6 3 4 roc_auc binary 0.983 5 0.00246 7 7 4 4 roc_auc binary 0.983 5 0.00224 8 8 2 1 roc_auc binary 0.983 5 0.00170 9 9 3 5 roc_auc binary 0.983 5 0.00271 10 10 4 5 roc_auc binary 0.983 5 0.00246 # ... with 90 more rows

We reached the maximum value for the objective function **0.9837565** with the following hyperparameter values `mtry = 1`

, and `min_n = 2`

.

**Note**: we will ignore the overfitting problem, since we are only making comparison using the same training set.

We can plot this distribution as follows:

scatter3D(x=df$mtry, y=df$min_n, z=df$mean, phi = 0, bty = "g", type = "h", ticktype = "detailed", pch = 19, cex = 0.5, main="the true distribution", xlab="mtry", ylab="min_n", zlab="roc_auc")

### random search

Now suppose that we are allowed to try only 10 combinations. For random search strategy, we use the **grid_random** function from **dials** package (embedded in tidymodels package).

#tuned_random <- tune_wf %>% # tune_grid(resamples = folds, # grid = grid_random(mtry(range = c(1,10)), min_n(range = c(1,10)), #size = 10), # metrics=metric_set(roc_auc)) #df_r <- tuned_random %>% collect_metrics() #write_csv(df_r, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_r.csv") df_r <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_r.csv") df_r %>% arrange(-mean) %>% head(1) %>% inner_join(df, by="mean") %>% select(rank, mtry.x, min_n.x, mean) # A tibble: 1 x 4 rank mtry.x min_n.x mean <int> <dbl> <dbl> <dbl> 1 13 3 10 0.983

The maximum value obtained by this method is 0.9826900, which corresponds to the 13th rank compared to the maximum value of the the true distribution, and the associated hyperparameters values are `mtry=3`

, `min_n=10`

### bayesian optimization UCB

For the Bayesian optimization method, we make use of the **tune_bayes** function from **tune** package that provides all the acquisition functions discussed above. So we start by UCB function, and we set the argument **kappa** equals to 2, which controls the trade-off between exploitation and exploration such that larger values lead to more exploration. Notice that, by default, this function explores 10 combinations, if you want another number change the argument **iter**.

#tuned_UCB <- tune_wf %>% # tune_bayes(resamples = folds, # param_info=parameters(mtry(range = c(1,10)), min_n(range = c(1,10))), # metrics=metric_set(roc_auc), # objective=conf_bound(kappa = 2)) #df_UCB <- tuned_UCB %>% collect_metrics() #write_csv(df_UCB,"C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_UCB.csv") df_UCB <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_UCB.csv") df_UCB %>% arrange(-mean) %>% head(1) %>% inner_join(df, by="mean") %>% select(rank, mtry.x, min_n.x, mean) # A tibble: 1 x 4 rank mtry.x min_n.x mean <int> <dbl> <dbl> <dbl> 1 2 3 6 0.984

With this acquisition function, we obtained better result than the random search 0.9837529 , which occupies the second position.

### bayesian optimization PI

This time we will explore the acquisition functions PI discussed above. Note that larger values for the argument trade-off lead to more exploration than exploitation.

#tuned_PI <- tune_wf %>% # tune_bayes(resamples = folds, # param_info=parameters(mtry(range = c(1,10)), min_n(range = c(1,10))), # metrics=metric_set(roc_auc), # objective=prob_improve(trade_off = 0.01)) #df_PI <- tuned_PI %>% collect_metrics() #write_csv(df_PI, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_PI.csv") df_PI <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_PI.csv") df_PI %>% arrange(-mean) %>% head(1) %>% inner_join(df, by="mean") %>% select(rank, mtry.x, min_n.x, mean) # A tibble: 1 x 4 rank mtry.x min_n.x mean <int> <dbl> <dbl> <dbl> 1 11 2 9 0.983

As we see, with this acquisition function, we obtained the 11th position which is more worst than the previous one, but still better than random search.

### bayesian optimization EI

Now we try another acquisition function, the expected improvement function.

#tuned_EI <- tune_wf %>% # tune_bayes(resamples = folds, # param_info=parameters(mtry(range = c(1,10)), # min_n(range = c(1,10))), # metrics=metric_set(roc_auc), # objective=exp_improve(trade_off = 0.01)) #df_EI <- tuned_EI %>% collect_metrics() #write_csv(df_EI, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_EI.csv") df_EI <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_EI.csv") df_EI %>% arrange(-mean) %>% head(1) %>% inner_join(df, by="mean") %>% select(rank, mtry.x, min_n.x, mean) # A tibble: 1 x 4 rank mtry.x min_n.x mean <int> <dbl> <dbl> <dbl> 1 2 3 6 0.984

Here also we get the same result as UCB method.

### Contrast the results

df_rf <- tibble(names=c("true", "random", "UCB", "PI", "EI"), mtry=c(df[df$mean==max(df$mean),1, drop=TRUE], df_r[df_r$mean==max(df_r$mean),1, drop=TRUE], df_UCB[df_UCB$mean==max(df_UCB$mean),1, drop=TRUE], df_PI[df_PI$mean==max(df_PI$mean),1, drop=TRUE], df_EI[df_EI$mean==max(df_EI$mean),1, drop=TRUE]), min_n=c(df[df$mean==max(df$mean),2, drop=TRUE], df_r[df_r$mean==max(df_r$mean),2, drop=TRUE], df_UCB[df_UCB$mean==max(df_UCB$mean),2, drop=TRUE], df_PI[df_PI$mean==max(df_PI$mean),2, drop=TRUE], df_EI[df_EI$mean==max(df_EI$mean),2, drop=TRUE]), roc_auc=c(max(df$mean), max(df_r$mean),max(df_UCB$mean), max(df_PI$mean),max(df_EI$mean)), std_err=c(df[df$mean==max(df$mean),ncol(df), drop=TRUE], df_r[df_r$mean==max(df_r$mean),ncol(df_r), drop=TRUE], df_UCB[df_UCB$mean==max(df_UCB$mean),ncol(df_UCB), drop=TRUE], df_PI[df_PI$mean==max(df_PI$mean),ncol(df_PI), drop=TRUE], df_EI[df_EI$mean==max(df_EI$mean),ncol(df_EI), drop=TRUE])) df_rf %>% arrange(-roc_auc) # A tibble: 5 x 5 names mtry min_n roc_auc std_err <chr> <dbl> <dbl> <dbl> <dbl> 1 true 1 1 0.984 0.00198 2 UCB 3 6 0.984 0.00204 3 EI 3 6 0.984 0.00204 4 PI 2 9 0.983 0.00290 5 random 3 10 0.983 0.00275

As we see, the Bayesian optimization method performs better than random search whatever acquisition function used. However, since the acquisition functions have their own hyperparameters (to trade-off between exploration and exploitation), their performance thus may differ strongly from each other. Moreover, the difference can be larger if we use a larger dataset.

## deep learning model

As we did with the random forest model we explore a wide range of hyperparameter values assuming that these values represent the true distribution, then we apply all the above tuning methods. For the model architecture, we use a deep learning model with a single layer, and for tuning, we use the two hyperparameters, the number of nodes, and the number of epochs. The last thing we have to do is to save what we need in csv file and load it again since each time we rerun the model we get a different result, and besides, it takes a lot of time.

model_tune1 <- mlp(hidden_units = tune(), epochs = tune()) %>% set_engine("keras") %>% set_mode("classification") tune_wf1 <- workflow() %>% add_model(model_tune1) %>% add_formula(class~.) #tuned_deepl <- tune_wf1 %>% # tune_grid(resamples = folds, # grid = expand.grid(hidden_units=5:15, epochs=10:20), # metrics=metric_set(roc_auc)) #df1 <- tuned_deepl %>% collect_metrics() #write_csv(df1, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df1.csv") df1 <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df1.csv") df1 %>% arrange(-mean) # A tibble: 121 x 7 hidden_units epochs .metric .estimator mean n std_err <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 12 18 roc_auc binary 0.982 5 0.00255 2 11 20 roc_auc binary 0.982 5 0.00265 3 9 14 roc_auc binary 0.982 5 0.00274 4 8 16 roc_auc binary 0.982 5 0.00207 5 14 18 roc_auc binary 0.982 5 0.00241 6 14 20 roc_auc binary 0.982 5 0.00244 7 12 17 roc_auc binary 0.982 5 0.00265 8 10 16 roc_auc binary 0.982 5 0.00230 9 10 19 roc_auc binary 0.981 5 0.00231 10 12 20 roc_auc binary 0.981 5 0.00227 # ... with 111 more rows

With 12 units in the hidden layer and 18 epochs we reached the maximum value 0.9819806 for the area under the ROC curve.

scatter3D(x=df1$hidden_units, y=df1$epochs, z=df1$mean, phi = 0, bty = "g", type = "h", ticktype = "detailed", pch = 19, cex = 0.5, main="the true distribution", xlab="units", ylab="epochs", zlab="roc_auc")

### Random search

#tuned_random1 <- tune_wf1 %>% # tune_grid(resamples = folds, # grid = grid_random(hidden_units(range = c(5,15)), epochs(range = #c(10,20)), size = 10), # metrics=metric_set(roc_auc)) #df_r1 <- tuned_random1 %>% collect_metrics() #write_csv(df_r1, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_#r1.csv") df_r1 <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_r1.csv") df_r1 %>% arrange(-mean) # A tibble: 10 x 7 hidden_units epochs .metric .estimator mean n std_err <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 14 11 roc_auc binary 0.982 5 0.00230 2 14 17 roc_auc binary 0.981 5 0.00240 3 8 15 roc_auc binary 0.981 5 0.00266 4 11 19 roc_auc binary 0.981 5 0.00268 5 14 16 roc_auc binary 0.981 5 0.00221 6 10 12 roc_auc binary 0.980 5 0.00259 7 7 13 roc_auc binary 0.980 5 0.00229 8 5 16 roc_auc binary 0.980 5 0.00241 9 9 10 roc_auc binary 0.980 5 0.00244 10 5 13 roc_auc binary 0.979 5 0.00270

Since deep learning models strongly depend on an internal random process (like when initializing the weights), and besides, the small difference between results, due to the small size of the data, it is harder to contrast between different methods. To alleviate this problem, however, we use this time the standard errors to highlight the significance differences between the methods.

### Bayesian optimization UCB

#tuned_UCB1 <- tune_wf1 %>% # tune_bayes(resamples = folds, # param_info=parameters(hidden_units(range = c(5L,15L)), # epochs(range = c(10L,20L))), # metrics=metric_set(roc_auc), # objective=conf_bound(kappa = 2)) #df_UCB1 <- tuned_UCB1 %>% collect_metrics() #write_csv(df_UCB1, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_UCB1.csv") df_UCB1 <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_UCB1.csv") df_UCB1 %>% arrange(-mean) # A tibble: 15 x 8 hidden_units epochs .iter .metric .estimator mean n std_err <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 12 19 8 roc_auc binary 0.981 5 0.00237 2 12 17 0 roc_auc binary 0.981 5 0.00250 3 9 19 10 roc_auc binary 0.981 5 0.00203 4 12 18 2 roc_auc binary 0.981 5 0.00236 5 11 17 3 roc_auc binary 0.981 5 0.00248 6 13 19 9 roc_auc binary 0.981 5 0.00246 7 13 18 6 roc_auc binary 0.981 5 0.00260 8 13 17 1 roc_auc binary 0.981 5 0.00254 9 10 19 0 roc_auc binary 0.981 5 0.00230 10 11 19 7 roc_auc binary 0.981 5 0.00221 11 13 15 0 roc_auc binary 0.981 5 0.00257 12 11 18 5 roc_auc binary 0.981 5 0.00269 13 12 16 4 roc_auc binary 0.981 5 0.00213 14 5 11 0 roc_auc binary 0.979 5 0.00233 15 9 12 0 roc_auc binary 0.979 5 0.00288

### Bayesian optimization PI

#tuned_PI1 <- tune_wf1 %>% # tune_bayes(resamples = folds, # param_info=parameters(hidden_units(range = c(5L,15L)), # epochs(range = c(10L,20L))), # metrics=metric_set(roc_auc), # objective=prob_improve(trade_off = 0.01)) #df_PI1 <- tuned_PI1 %>% collect_metrics() #write_csv(df_PI1, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_PI1.csv") df_PI1 <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_PI1.csv") df_PI1 %>% arrange(-mean) # A tibble: 15 x 8 hidden_units epochs .iter .metric .estimator mean n std_err <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 7 20 6 roc_auc binary 0.981 5 0.00236 2 10 10 5 roc_auc binary 0.981 5 0.00237 3 9 17 0 roc_auc binary 0.981 5 0.00216 4 15 16 8 roc_auc binary 0.981 5 0.00213 5 14 20 0 roc_auc binary 0.981 5 0.00251 6 11 20 4 roc_auc binary 0.981 5 0.00282 7 15 10 3 roc_auc binary 0.981 5 0.00272 8 6 10 0 roc_auc binary 0.981 5 0.00286 9 13 20 10 roc_auc binary 0.981 5 0.00253 10 12 14 0 roc_auc binary 0.981 5 0.00268 11 8 12 0 roc_auc binary 0.980 5 0.00220 12 13 10 7 roc_auc binary 0.980 5 0.00273 13 8 10 1 roc_auc binary 0.980 5 0.00305 14 5 20 2 roc_auc binary 0.980 5 0.00227 15 5 12 9 roc_auc binary 0.979 5 0.00234

### Bayesian optimization EI

#tuned_EI1 <- tune_wf1 %>% # tune_bayes(resamples = folds, # param_info=parameters(hidden_units(range = c(5L,15L)), # epochs(range = c(10L,20L))), # metrics=metric_set(roc_auc), # objective=exp_improve(trade_off = 0.01)) #df_EI1 <- tuned_EI1 %>% collect_metrics() #write_csv(df_EI1, "C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_EI1.csv") df_EI1 <- read_csv("C:/Users/dell/Documents/new-blog/content/bayes/hyper_bayes/df_EI1.csv") df_EI1 %>% arrange(-mean) # A tibble: 15 x 8 hidden_units epochs .iter .metric .estimator mean n std_err <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> 1 10 20 0 roc_auc binary 0.981 5 0.00229 2 15 18 1 roc_auc binary 0.981 5 0.00263 3 7 16 0 roc_auc binary 0.981 5 0.00286 4 12 20 8 roc_auc binary 0.981 5 0.00276 5 8 19 6 roc_auc binary 0.981 5 0.00231 6 14 14 0 roc_auc binary 0.981 5 0.00229 7 13 14 7 roc_auc binary 0.981 5 0.00253 8 5 20 10 roc_auc binary 0.981 5 0.00205 9 6 13 5 roc_auc binary 0.981 5 0.00244 10 12 10 0 roc_auc binary 0.980 5 0.00266 11 11 14 4 roc_auc binary 0.980 5 0.00191 12 10 10 9 roc_auc binary 0.980 5 0.00284 13 5 12 0 roc_auc binary 0.980 5 0.00274 14 5 10 2 roc_auc binary 0.980 5 0.00261 15 9 14 3 roc_auc binary 0.979 5 0.00243

### Contrast the results

df_deep <- tibble(names=c("true", "random", "UCB", "PI", "EI"), hidden_units=c(df1[df1$mean==max(df1$mean),1, drop=TRUE], df_r1[df_r1$mean==max(df_r1$mean),1, drop=TRUE], df_UCB1[df_UCB1$mean==max(df_UCB1$mean),1, drop=TRUE], df_PI1[df_PI1$mean==max(df_PI1$mean),1, drop=TRUE], df_EI1[df_EI1$mean==max(df_EI1$mean),1, drop=TRUE]), epochs=c(df1[df1$mean==max(df1$mean),2, drop=TRUE], df_r1[df_r1$mean==max(df_r1$mean),2, drop=TRUE], df_UCB1[df_UCB1$mean==max(df_UCB1$mean),2, drop=TRUE], df_PI1[df_PI1$mean==max(df_PI1$mean),2, drop=TRUE], df_EI1[df_EI1$mean==max(df_EI1$mean),2, drop=TRUE]), roc_auc=c(max(df1$mean), max(df_r1$mean), max(df_UCB1$mean), max(df_PI1$mean),max(df_EI1$mean)), std_err=c(df1[df1$mean==max(df1$mean),ncol(df1), drop=TRUE], df_r1[df_r1$mean==max(df_r1$mean),ncol(df_r1), drop=TRUE], df_UCB1[df_UCB1$mean==max(df_UCB1$mean),ncol(df_UCB1), drop=TRUE], df_PI1[df_PI1$mean==max(df_PI1$mean),ncol(df_PI1), drop=TRUE], df_EI1[df_EI1$mean==max(df_EI1$mean),ncol(df_EI1), drop=TRUE])) df_deep # A tibble: 5 x 5 names hidden_units epochs roc_auc std_err <chr> <dbl> <dbl> <dbl> <dbl> 1 true 12 18 0.982 0.00255 2 random 14 11 0.982 0.00230 3 UCB 12 19 0.981 0.00237 4 PI 7 20 0.981 0.00236 5 EI 10 20 0.981 0.00229 ggplot(df_deep[-1, ]%>% arrange(-roc_auc), aes(x=names, y=roc_auc))+ geom_point(size=2, color= "red")+ geom_hline(yintercept = df_deep[df_deep$names=="true", 4, drop=TRUE], color= "blue", lty="dashed")+ geom_errorbar(aes(ymin=roc_auc-1.92*std_err, ymax=roc_auc+1.92*std_err))

As we see, we do not obtain any significance difference between these methods, which is essentially due to the small size of the data and the small range used for the hyperparameter values. However, with more complex and large data set the difference will be obvious.

## Conclusion

The main purpose of this article is more to show how implementing these methods in practice rather than highlighting the difference of performance between each other. However, the Bayesian optimization is known as the most efficient method, but with the downside that it also requires defining some hyperparameters like the acquisition function, sometimes arbitrarily. In other words, we cannot waste, say the limited budget, that should be concentrated to search for the optimum, to instead try different acquisition functions.

## Session info

sessionInfo() R version 4.0.1 (2020-06-06) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 18362) Matrix products: default locale: [1] LC_COLLATE=English_United States.1252 [2] LC_CTYPE=English_United States.1252 [3] LC_MONETARY=English_United States.1252 [4] LC_NUMERIC=C [5] LC_TIME=English_United States.1252 attached base packages: [1] stats graphics grDevices utils datasets methods base other attached packages: [1] plot3D_1.3 themis_0.1.1 yardstick_0.0.6 workflows_0.1.1 [5] tune_0.1.0 tibble_3.0.1 rsample_0.0.7 recipes_0.1.12 [9] purrr_0.3.4 parsnip_0.1.1 infer_0.5.2 ggplot2_3.3.1 [13] dplyr_1.0.0 dials_0.0.7 scales_1.1.1 broom_0.5.6 [17] tidymodels_0.1.0 readr_1.3.1 loaded via a namespace (and not attached): [1] mlr_2.17.1 backports_1.1.7 fastmatch_1.1-0 [4] tidytext_0.2.4 plyr_1.8.6 igraph_1.2.5 [7] splines_4.0.1 crosstalk_1.1.0.1 listenv_0.8.0 [10] SnowballC_0.7.0 rstantools_2.0.0 inline_0.3.15 [13] digest_0.6.25 foreach_1.5.0 htmltools_0.4.0 [16] rsconnect_0.8.16 fansi_0.4.1 checkmate_2.0.0 [19] magrittr_1.5 BBmisc_1.11 unbalanced_2.0 [22] doParallel_1.0.15 globals_0.12.5 gower_0.2.1 [25] RcppParallel_5.0.1 matrixStats_0.56.0 xts_0.12-0 [28] hardhat_0.1.3 prettyunits_1.1.1 colorspace_1.4-1 [31] xfun_0.14 callr_3.4.3 crayon_1.3.4 [34] lme4_1.1-23 survival_3.1-12 zoo_1.8-8 [37] iterators_1.0.12 glue_1.4.1 gtable_0.3.0 [40] ipred_0.9-9 pkgbuild_1.0.8 rstan_2.19.3 [43] miniUI_0.1.1.1 Rcpp_1.0.4.6 xtable_1.8-4 [46] GPfit_1.0-8 stats4_4.0.1 lava_1.6.7 [49] StanHeaders_2.21.0-5 prodlim_2019.11.13 DT_0.13 [52] htmlwidgets_1.5.1 threejs_0.3.3 FNN_1.1.3 [55] ellipsis_0.3.1 farver_2.0.3 ParamHelpers_1.14 [58] pkgconfig_2.0.3 loo_2.2.0 nnet_7.3-14 [61] utf8_1.1.4 labeling_0.3 tidyselect_1.1.0 [64] rlang_0.4.6 DiceDesign_1.8-1 reshape2_1.4.4 [67] later_1.1.0.1 munsell_0.5.0 tools_4.0.1 [70] cli_2.0.2 generics_0.0.2 ggridges_0.5.2 [73] evaluate_0.14 stringr_1.4.0 fastmap_1.0.1 [76] yaml_2.2.1 processx_3.4.2 knitr_1.28 [79] RANN_2.6.1 future_1.17.0 nlme_3.1-148 [82] mime_0.9 rstanarm_2.19.3 rstudioapi_0.11 [85] tokenizers_0.2.1 compiler_4.0.1 bayesplot_1.7.2 [88] shinythemes_1.1.2 curl_4.3 tidyposterior_0.0.3 [91] lhs_1.0.2 statmod_1.4.34 stringi_1.4.6 [94] ps_1.3.3 blogdown_0.19 lattice_0.20-41 [97] Matrix_1.2-18 nloptr_1.2.2.1 markdown_1.1 [100] shinyjs_1.1 vctrs_0.3.1 pillar_1.4.4 [103] lifecycle_0.2.0 furrr_0.1.0 data.table_1.12.8 [106] httpuv_1.5.4 R6_2.4.1 bookdown_0.19 [109] promises_1.1.1 gridExtra_2.3 janeaustenr_0.1.5 [112] codetools_0.2-16 boot_1.3-25 colourpicker_1.0 [115] MASS_7.3-51.6 gtools_3.8.2 assertthat_0.2.1 [118] ROSE_0.0-3 withr_2.2.0 shinystan_2.5.0 [121] parallel_4.0.1 hms_0.5.3 grid_4.0.1 [124] rpart_4.1-15 timeDate_3043.102 tidyr_1.1.0 [127] class_7.3-17 minqa_1.2.4 misc3d_0.8-4 [130] rmarkdown_2.2 parallelMap_1.5.0 pROC_1.16.2 [133] tidypredict_0.4.5 shiny_1.4.0.2 lubridate_1.7.9 [136] base64enc_0.1-3 dygraphs_1.1.1.6

**leave a comment**for the author, please follow the link and comment on their blog:

**Modeling with R**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.