Today, **give a try to Techtonique web app**, a tool designed to help you make informed, data-driven decisions using Mathematics, Statistics, Machine Learning, and Data Visualization

A few years ago in 2018, I discussed Boosted Configuration (*neural*) Networks (BCN for multivariate time series forecasting) in this document. Unlike Stochastic Configuration Networks from which they are inspired, BCNs aren’t **randomized**. Rather, they are closer to Gradient Boosting Machines and Matching Pursuit algorithms; with base learners being single-layered feedforward *neural* networks – that are actually optimized at each iteration of the algorithm.

The mathematician that you are has certainly been
asking himself questions about the convexity of the problem at line 4, algorithm 1 (in
the document). As of July 2022, there are unfortunately no answers to that question. BCNs works well **empirically**, as we’ll see, and finding the maximum at line 4 of the algorithm is achieved, by default, with R’s `stats::nlminb`

. Other derivative-free optimizers are available in R package `bcn`

.

As it will be shown in this document, BCNs can be used **for classification**. For this purpose, and as implemented in R package `bcn`

, the response (variable to be explained) containing the classes is one-hot encoded as a matrix of probabilities equal to 0 or 1. Then, the classification technique dealing with a one-hot encoded response matrix is similar to the one presented in this post.

6 *toy* datasets are used for this basic demo of R package `bcn`

: Iris, Wine, Ionosphere, Wisconsin Breast, Digits, Penguins.
For each dataset, hyperparameter tuning has already been done. Repeated 5-fold cross-validation was carried out on 80% of the data, for each dataset, and the accuracy reported in the table below is calculated on the remaining 20% of the data. BCN results are compared to Random Forest’s (with default parameters), in order to verify that BCN results are not absurd – it’s not a competition between Random Forest and BCN here.

In the examples, you’ll also notice that BCN’s adjustment to a dataset can be relatively slow when the number of explanatory variables is high (>30, see the `digits`

dataset example, initially with 64 covariates). This is because of line 4, algorithm 1, too: an optimization problem in a high dimensional space is repeated at each iteration of the algorithm.

The future for R package `bcn`

(in no particular order)?

- Implement BCN for regression (a continuous response)
- Improve the speed of execution for high dimensional problems
- Implement a Python version

Dataset | BCN test set Accuracy | Random Forest test set accuracy |
---|---|---|

iris | 100% |
93.33% |

Wine | 97.22% |
97.22% |

Ionosphere | 90.14% | 95.77% |

Breast cancer | 99.12% |
94.73% |

Digits | 97.5% | 98.61% |

Penguins | 100% |
100% |

**Content**

- 0 - Installing/Loading Packages
- 1 - iris dataset
- 2 - wine dataset
- 3 - Ionosphere dataset
- 4 - Breast Cancer dataset
- 5 - digits dataset
- 6 - Palmer Penguins dataset

# 0 - Installing and loading packages

Installing `bcn`

From Github:

```
devtools::install_github("Techtonique/bcn")
# Browse the bcn manual pages
help(package = 'bcn')
```

Installing `bcn`

from R universe:

```
# Enable repository from techtonique
options(repos = c(
techtonique = 'https://techtonique.r-universe.dev',
CRAN = 'https://cloud.r-project.org'))
# Download and install bcn in R
install.packages('bcn')
# Browse the bcn manual pages
help(package = 'bcn')
```

Loading packages:

```
library(bcn) # Boosted Configuration networks
library(mlbench) # Machine Learning Benchmark Problems
library(caret)
library(randomForest)
library(pROC)
```

# 1 - iris dataset

```
data("iris")
```

```
head(iris)
dim(iris)
set.seed(1234)
train_idx <- sample(nrow(iris), 0.8 * nrow(iris))
X_train <- as.matrix(iris[train_idx, -ncol(iris)])
X_test <- as.matrix(iris[-train_idx, -ncol(iris)])
y_train <- iris$Species[train_idx]
y_test <- iris$Species[-train_idx]
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train, y = y_train, B = 10L, nu = 0.335855,
lam = 10**0.7837525, r = 1 - 10**(-5.470031), tol = 10**-7,
activation = "tanh", type_optim = "nlminb", show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

# 2- wine dataset

```
data(wine)
```

```
head(wine)
dim(wine)
set.seed(1234)
train_idx <- sample(nrow(wine), 0.8 * nrow(wine))
X_train <- as.matrix(wine[train_idx, -ncol(wine)])
X_test <- as.matrix(wine[-train_idx, -ncol(wine)])
y_train <- as.factor(wine$target[train_idx])
y_test <- as.factor(wine$target[-train_idx])
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train, y = y_train, B = 6L, nu = 0.8715725,
lam = 10**0.2143678, r = 1 - 10**(-6.1072786),
tol = 10**-4.9605713, show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

# 3 - Ionosphere dataset

```
data("Ionosphere")
```

```
head(Ionosphere)
dim(Ionosphere)
Ionosphere$V1 <- as.numeric(Ionosphere$V1)
Ionosphere$V2 <- NULL
set.seed(1234)
train_idx <- sample(nrow(Ionosphere), 0.8 * nrow(Ionosphere))
X_train <- as.matrix(Ionosphere[train_idx, -ncol(Ionosphere)])
X_test <- as.matrix(Ionosphere[-train_idx, -ncol(Ionosphere)])
y_train <- as.factor(Ionosphere$Class[train_idx])
y_test <- as.factor(Ionosphere$Class[-train_idx])
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train,
y = y_train, B = 50L,
nu = 0.5182606,
lam = 10**1.323274,
r = 1 - 10**(-6.694688),
col_sample = 0.7956659,
tol = 10**-7,
verbose=FALSE,
show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

```
roc_obj <- pROC::roc(as.numeric(y_test), as.numeric(preds))
pROC::auc(roc_obj)
```

```
roc_obj_rf <- pROC::roc(as.numeric(y_test), as.numeric(predict(rf, newdata=as.matrix(X_test))))
pROC::auc(roc_obj_rf)
```

# 4 - breast cancer dataset

```
data("breast_cancer")
```

```
head(breast_cancer)
dim(breast_cancer)
set.seed(1234)
train_idx <- sample(nrow(breast_cancer), 0.8 * nrow(breast_cancer))
X_train <- as.matrix(breast_cancer[train_idx, -ncol(breast_cancer)])
X_test <- as.matrix(breast_cancer[-train_idx, -ncol(breast_cancer)])
y_train <- as.factor(breast_cancer$target[train_idx])
y_test <- as.factor(breast_cancer$target[-train_idx])
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train, y = y_train, B = 31L, nu = 0.4412851,
lam = 10**-0.2439358, r = 1 - 10**(-7), col_sample = 0.5, tol = 10**-2, show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

```
roc_obj <- pROC::roc(as.numeric(y_test), as.numeric(preds))
pROC::auc(roc_obj)
```

```
roc_obj_rf <- pROC::roc(as.numeric(y_test), as.numeric(predict(rf, newdata=as.matrix(X_test))))
pROC::auc(roc_obj_rf)
```

# 5 - digits dataset

```
data("digits")
```

```
head(digits)
dim(digits)
set.seed(1234)
train_idx <- sample(nrow(digits), 0.8 * nrow(digits))
X_train <- as.matrix(digits[train_idx, -ncol(digits)])
X_test <- as.matrix(digits[-train_idx, -ncol(digits)])
y_train <- as.factor(digits$target[train_idx])
X_train <- X_train[, -caret::nearZeroVar(X_train)]
y_test <- as.factor(digits$target[-train_idx])
X_test <- X_test[, colnames(X_train)]
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train,
y = y_train, B = 50L,
nu = 0.6549268,
lam = 10**0.4635435,
r = 1 - 10**(-7),
col_sample = 0.8928518,
tol = 10**-5.483609,
verbose=FALSE,
show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

# 6 - Penguins dataset

```
data("penguins")
```

```
penguins_ <- as.data.frame(penguins)
replacement <- median(penguins$bill_length_mm, na.rm = TRUE)
penguins_$bill_length_mm[is.na(penguins$bill_length_mm)] <- replacement
replacement <- median(penguins$bill_depth_mm, na.rm = TRUE)
penguins_$bill_depth_mm[is.na(penguins$bill_depth_mm)] <- replacement
replacement <- median(penguins$flipper_length_mm, na.rm = TRUE)
penguins_$flipper_length_mm[is.na(penguins$flipper_length_mm)] <- replacement
replacement <- median(penguins$body_mass_g, na.rm = TRUE)
penguins_$body_mass_g[is.na(penguins$body_mass_g)] <- replacement
# replacing NA's by the most frequent occurence
penguins_$sex[is.na(penguins$sex)] <- "male" # most frequent
print(summary(penguins_))
print(sum(is.na(penguins_)))
# one-hot encoding for covariates
penguins_mat <- model.matrix(species ~., data=penguins_)[,-1]
penguins_mat <- cbind(penguins_$species, penguins_mat)
penguins_mat <- as.data.frame(penguins_mat)
colnames(penguins_mat)[1] <- "species"
print(head(penguins_mat))
print(tail(penguins_mat))
y <- as.integer(penguins_mat$species)
X <- as.matrix(penguins_mat[,2:ncol(penguins_mat)])
n <- nrow(X)
p <- ncol(X)
set.seed(1234)
index_train <- sample(1:n, size=floor(0.8*n))
X_train <- X[index_train, ]
y_train <- factor(y[index_train])
X_test <- X[-index_train, ]
y_test <- factor(y[-index_train])
```

```
ptm <- proc.time()
fit_obj <- bcn::bcn(x = X_train, y = y_train, B = 23, nu = 0.470043,
lam = 10**-0.05766029, r = 1 - 10**(-7.905866), tol = 10**-7,
show_progress = TRUE)
cat("Elapsed: ", (proc.time() - ptm)[3])
```

```
plot(fit_obj$errors_norm, type='l')
```

```
preds <- predict(fit_obj, newx = X_test)
mean(preds == y_test)
table(y_test, preds)
```

```
set.seed(1234)
rf <- randomForest::randomForest(x = X_train, y = y_train)
mean(predict(rf, newdata=as.matrix(X_test)) == y_test)
```

```
print(head(predict(fit_obj, newx = X_test, type='probs')))
print(head(predict(rf, newdata=as.matrix(X_test), type='prob')))
```

Comments powered by Talkyard.