Multi-output Regression Example with Keras Sequential Model in R

   We saw a multi-output regression prediction with Python in the previous post. The same analysis can be done with R too. In this tutorial, we'll learn how to fit and predict multi-output regression data with keras neural networks API in R. We can use Keras R interface to implement keras neural network API in R.
   Multi-output data contains more than one output for a given input data. By setting the appropriate input and output dimensions into the model, we can train and predict the test data with keras deep learning API in R. This tutorial explains how to implement it in the following steps:
  1. Preparing the data
  2. Defining the model
  3. Predicting and visualizing the result
  4. Source code listing
We'll start by loading the required packages of R.

library(keras)
library(caret)

Preparing the data

   We 'll create a multi-output dataset for this tutorial. It is randomly generated data with some rules. You can check the logic of data generation in the below function. There are three inputs and two outputs in this dataset. We'll plot the generated data to check it visually.

set.seed(123)

n = 400
s = seq(.1, n / 10, .1)
x1 = s * sin(s / 50) - rnorm(n) * 5 
x2 = s * sin(s) + rnorm(n) * 10
x3 = s * sin(s / 100) + 2 + rnorm(n) * 10
y1 = x1 + x2 + x3 + 2 + rnorm(n) * 2
y2 = x1 + x2 / 2 - x3 - 4 - rnorm(n)
 
df = data.frame(x1, x2, x3, y1, y2)
 
plot(s, df$y1, ylim = c(min(df), max(df)), type = "l", col = "blue")
lines(s, df$y2, type = "l", col = "red")
lines(s, df$x1, type = "l", col = "green")
lines(s, df$x2, type = "l", col = "yellow")
lines(s, df$x3, type = "l", col = "gray")
 

Next, we'll split the dataset into the train and test parts.

indexes = createDataPartition(df$x1, p = .85, list = F)
train = df[indexes,]
test = df[-indexes,]

Then, we'll convert the data into the matrix type.

xtrain = as.matrix(data.frame(train$x1, train$x2, train$x3))
ytrain = as.matrix(data.frame(train$y1, train$y2))
xtest = as.matrix(data.frame(test$x1, test$x2, test$x3))
ytest = as.matrix(data.frame(test$y1, test$y2))

Defining the model

   The important part of the model definition is the setting of the input dimension in the first layer and output dimension in the last layer. We can extract the input and output dimensions from the train data.

in_dim = dim(xtrain)[2]
out_dim = dim(ytrain)[2]

We 'll define a sequential model and fit it with the train data. The sequential model contains Dense layers with ReLU activations and Adam optimizer. 

model = keras_model_sequential() %>%
  layer_dense(units = 100, activation="relu", input_shape=in_dim) %>%
  layer_dense(units = 32, activation = "relu") %>%
  layer_dense(units = out_dim, activation = "linear")

model %>% compile(
  loss = "mse",
  optimizer = "adam")

model %>% summary()
 
________________________________________________________________________________
Layer (type)                         Output Shape                      Param #      
================================================================================
dense_4 (Dense)                      (None, 100)                       400          
________________________________________________________________________________
dense_5 (Dense)                      (None, 32)                        3232         
________________________________________________________________________________
dense_6 (Dense)                      (None, 2)                         66           
================================================================================
Total params: 3,698
Trainable params: 3,698
Non-trainable params: 0
________________________________________________________________________________

Now, we can fit the model with train data.

model %>% fit(xtrain, ytrain, epochs = 100, verbose = 0)
scores = model %>% evaluate(xtrain, ytrain, verbose = 0)
print(scores)
   loss 
2.05084 


Predicting and visualizing the result

We 'll predict test data and check to RMSE rate for y1 and y2.

cat("y1 RMSE:", RMSE(ytest[, 1], ypred[, 1]))
y1 RMSE: 2.230619 
 
cat("y2 RMSE:", RMSE(ytest[, 2], ypred[, 2]))
y2 RMSE: 1.205161

Finally, we'll plot the output and original values to check them visually.

x_axes = seq(1:length(ypred[, 1]))

plot(x_axes, ytest[, 1], ylim = c(min(ypred), max(ytest)),
     col = "burlywood", type = "l", lwd = 2)
lines(x_axes, ypred[, 1], col = "red", type = "l", lwd = 2)
lines(x_axes, ytest[, 2], col = "gray", type = "l", lwd = 2)
lines(x_axes, ypred[, 2], col = "blue", type = "l", lwd = 2)
legend("topleft", legend = c("y1-test", "y1-pred", "y2-test", "y2-pred"),
       col = c("burlywood", "red", "gray", "blue"),
       lty = 1, cex = 0.9, lwd = 2, bty = 'n')
 
   In this tutorial, we 've briefly learned how to fit and predict multi-output regression data with keras sequential model in R. The full source code is listed below.
 

Source code listing

library(keras)
library(caret)
 
set.seed(123)

n = 400
s = seq(.1, n / 10, .1)
x1 = s * sin(s / 50) - rnorm(n) * 5 
x2 = s * sin(s) + rnorm(n) * 10
x3 = s * sin(s / 100) + 2 + rnorm(n) * 10
y1 = x1 + x2 + x3 + 2 + rnorm(n) * 2
y2 = x1 + x2 / 2 - x3 - 4 - rnorm(n)

df = data.frame(x1, x2, x3, y1, y2)
 
plot(s, df$y1, ylim = c(min(df), max(df)), type = "l", col = "blue")
lines(s, df$y2, type = "l", col = "red")
lines(s, df$x1, type = "l", col = "green")
lines(s, df$x2, type = "l", col = "yellow")
lines(s, df$x3, type = "l", col = "gray")

indexes = createDataPartition(df$x1, p = .85, list = F)
train = df[indexes,]
test = df[-indexes,]

xtrain = as.matrix(data.frame(train$x1, train$x2, train$x3))
ytrain = as.matrix(data.frame(train$y1, train$y2))
xtest = as.matrix(data.frame(test$x1, test$x2, test$x3))
ytest = as.matrix(data.frame(test$y1, test$y2))
 
in_dim = dim(xtrain)[2]
out_dim = dim(ytrain)[2] 
 
model = keras_model_sequential() %>%
  layer_dense(units = 100, activation="relu", input_shape=in_dim) %>%
  layer_dense(units = 32, activation = "relu") %>%
  layer_dense(units = out_dim, activation = "linear")
 
model %>% compile(
  loss = "mse",
  optimizer = "adam")

model %>% summary()
 
model %>% fit(xtrain, ytrain, epochs = 100, verbose = 0)
scores = model %>% evaluate(xtrain, ytrain, verbose = 0)
print(scores)
 
ypred = model %>% predict(xtest)

cat("y1 RMSE:", RMSE(ytest[, 1], ypred[, 1]))
cat("y2 RMSE:", RMSE(ytest[, 2], ypred[, 2]))

x_axes = seq(1:length(ypred[, 1]))

plot(x_axes, ytest[, 1], ylim = c(min(ypred), max(ytest)),
     col = "burlywood", type = "l", lwd = 2)
lines(x_axes, ypred[, 1], col = "red", type = "l", lwd = 2)
lines(x_axes, ytest[, 2], col = "gray", type = "l", lwd = 2)
lines(x_axes, ypred[, 2], col = "blue", type = "l", lwd = 2)
legend("topleft", legend = c("y1-test", "y1-pred", "y2-test", "y2-pred"),
       col = c("burlywood", "red", "gray", "blue"),
       lty = 1, cex = 0.9, lwd = 2, bty = 'n')

2 comments:

  1. This code can run well, but no repeatability is the biggest problem. Do you have any solution?

    ReplyDelete