Libraries

library(cgraph)

Xavier initialization

  xavier_init <- function(n.rows, n.cols)
  {
    matrix(runif(
        n.rows * n.cols,
        min = -sqrt(6 / (n.rows + n.cols)),
        max = sqrt(6 / (n.rows + n.cols))
      ), n.rows, n.cols
    )
  }

Fit function

ae <- function(x, n_hidden = 1, batch_size = 1, eta = 0.05, n_epochs = 1)
{
  x <- as.matrix(x)
  
  graph <- cg_graph()
  
  input <- cg_input("input")
  
  parms <- list(
    w1 = cg_parameter(xavier_init(n_hidden, ncol(x)), "w1"),
    w2 = cg_parameter(xavier_init(ncol(x), n_hidden), "w2"),
    b1 = cg_parameter(matrix(0, n_hidden), "b1"),
    b2 = cg_parameter(matrix(0, ncol(x)), "b2")
  )
  
  hidden <- cg_sigmoid(cg_linear(parms$w1, input, parms$b1), "hidden")
        
  output <- cg_sigmoid(cg_linear(parms$w2, hidden, parms$b2), "output")
        
  loss <- cg_mean(cg_colsums((output - input)^2), "loss")
  
  error <- rep(0, n_epochs)
  
  n_batches <- ceiling(nrow(x) / batch_size)
  
  for(i in 1:n_epochs)
  {
    batch_error <- rep(0, n_batches)
    
    batches <- split(sample(nrow(x)),
                     rep(1:n_batches, length.out = nrow(x))
    )
    
    for(j in 1:n_batches)
    {
      batch <- batches[[j]]
      
      values <- cg_graph_run(graph, loss, list(
        input = t(x[batch,, drop = FALSE])
      ))
      
      grads <- cg_graph_gradients(graph, loss, values)
      
      for(parm in parms)
      {
        parm$value <- parm$value - eta * grads[[parm$name]]
      }
      
      batch_error[j] <- values$loss
    }
    
    error[i] <- mean(batch_error)
  }
  
  structure(list(graph = graph, loss = loss, error = error), class = "ae")
}

Predict function

predict.ae <- function(model, x)
{
  x <- as.matrix(x)
        
  values <- cg_graph_run(model$graph, model$loss, list(
    input = t(x)
  ))
        
  t(values$output)
}

Example

Let us apply the autoencoder to encode a set of images. First, we load the icons dataset.

  icons <- read.csv("data/icons.csv")

The icons dataset consists of 1800 grayscale images (20 by 20 pixels) displaying various web icons. You can download the icons dataset in the downloads section below. Accordingly, the data frame is converted to a matrix.

  icons <- as.matrix(icons)

Here, icons is a 1800 by 400 matrix of pixel values. The rows of the matrix are the images and columns are the individual pixel values of the images. Each pixel takes values between 0 (black) and 1 (white). The first eight images look as follows:

  par(mfrow = c(2,4))
  
  col = gray.colors(32, 0, 1)
  
  for(i in 1:8)
  {
    icon <- t(matrix(icons[i,], 20, 20))[,20:1]
  
    image(icon, col = col)
  }

We apply the autoencoder to compress the images from a 400-dimensional space to a 40-dimensional space.

  x <- ae(icons, n_hidden = 40, batch_size = 20, n_epochs = 400)

We can visualize the Mean Squared Error (MSE) at each epoch during the model fitting.

  plot(x$error, type = "l", xlab = "Epoch", ylab = "MRE")

The autoencoder compresses the images resonablly well. If we compare the first image in the dataset with the corresponding reconstruction by the autoencoder, we can clearly recognize the reconstructed image.

  par(mfrow = c(1,2))
  
  image <- t(matrix(icons[1,], 20, 20))[,20:1]
  output <- t(matrix(predict(x, icons[1,, drop = F]), 20, 20))[,20:1]
  
  image(image, col = col, main = "Original")
  image(output, col = col, main = "Reconstructed")

Downloads

  1. Icons dataset.