This page describes the implementation of a simple recurrent neural network to predict the temperature in the Netherlands one month ahead. We will perform this task on the knmi dataset (link). The recurrent neural network has a single recurrent layer with tanh activations. It is trained by gradient descent for 100 epochs with a fixed learning rate of 0.0001.

  # Load cgraph package
  library(cgraph)
  
  # Set seed for reproducible results
  set.seed(6)
  
  # Xavier initialization
  xavier_init <- function(n_rows, n_cols)
  {
    sd <- sqrt(2 / (n_rows + n_cols))
    matrix(rnorm(n_rows * n_cols, mean = 0, sd = sd), n_rows, n_cols)
  }
  
  # Build a traditional recurrent neural network
  build_model <- function(x, y, n_hidden = 1, parms = NULL)
  {
    # Initialize graph
    graph <- cg_graph(eager = FALSE)
  
    # Create parameters
    if(is.null(parms))
    {
      parms <- list(
        w1 = cg_parameter(xavier_init(n_hidden, nrow(x)), "w1"),
        w2 = cg_parameter(xavier_init(nrow(y), n_hidden), "w2"),
        u  = cg_parameter(xavier_init(n_hidden, n_hidden), "u"),
        b1 = cg_parameter(matrix(0, n_hidden), "b1"),
        b2 = cg_parameter(matrix(0, nrow(y)), "b2")
      )
    }
  
    # Initial loss
    loss <- cg_constant(0)
  
    # Initial state of the hidden layer
    hidden <- cg_constant(matrix(0, n_hidden))
  
    # Keep track of the outputs
    outputs <- vector("list", ncol(x))
  
    # Unroll recurrent layer
    for(i in 1:ncol(x))
    {
      # Get input
      input <- x[,i, drop = FALSE]
  
      # Get target
      target <- y[,i, drop = FALSE]
  
      # Calculate hidden recurrent activations
      hidden <- cg_tanh(cg_linear(parms$w1, input, cg_linear(parms$u, hidden, parms$b1)))
  
      # Calculate output
      output <- cg_linear(parms$w2, hidden, parms$b2)
  
      # Calculate squared loss
      loss <- loss + (output - target)^2
      
      # Store the output
      outputs[[i]] <- output
    }
  
    # Create model object
    model <- list(
      graph = graph, n_hidden = n_hidden, parms = parms,
      outputs = outputs, loss = loss, error = NULL
    )
  
    # Set class attribute
    class(model) <- "rnn"
  
    # Return model
    model
  }
  
  # Basic recurrent neural network with a single hidden layer with tanh activations
  rnn <- function(x, y, n_hidden = 1, eta = 0.01, n_epochs = 1)
  {
    # Transform to a matrix and transpose
    x <- t(as.matrix(x))
  
    # Transform to a matrix and transpose
    y <- t(as.matrix(y))
  
    # Build model
    model <- build_model(x, y, n_hidden)
  
    # Keep track of loss
    model$error <- rep(0, n_epochs)
  
    # Optimize by gradient descent
    for(i in 1:n_epochs)
    {
      # Perform forward pass
      cg_graph_forward(model$graph, model$loss)
  
      # Perform backward pass
      cg_graph_backward(model$graph, model$loss)
  
      # Update the parameters
      for(parm in model$parms)
      {
        # Gradient descent update rule
        parm$value <- parm$value - eta * parm$grad
      }
  
      # Store the current loss
      model$error[i] <- model$loss$value
    }
  
    # Return model
    model
  }
  
  # Apply a fitted recurrent neural network on new data
  predict.rnn <- function(model, x, y)
  {
    # Transform to a matrix and transpose
    x <- t(as.matrix(x))
  
    # Transform to a matrix and transpose
    y <- t(as.matrix(y))
  
    # Build network
    model <- build_model(x, y, model$n_hidden, model$parms)
  
    # Perform forward pass
    cg_graph_forward(model$graph, model$loss)
    
    # Retrieve outputs and return
    sapply(model$outputs, function(x) x$value)
  }
  
  # Load knmi data from disk
  knmi <- read.csv("data/knmi.csv", comment.char = "#")
  
  # Print the first few rows of the knmi data
  head(knmi)
##   year month     temp
## 1 1906     1  3.32429
## 2 1906     2  2.29741
## 3 1906     3  3.78348
## 4 1906     4  7.65619
## 5 1906     5 12.42970
## 6 1906     6 14.19980
  # Normalize temperature
  knmi$temp <- scale(knmi$temp)
  
  # Create training set consisting of the first 1000 obs.
  x_train <- knmi$temp[1:999]
  y_train <- knmi$temp[2:1000]
  
  # Create test set consisting of the next 60 obs.
  x_test <- knmi$temp[1000:1059]
  y_test <- knmi$temp[1001:1060]
  
  # Train a recurrent neural network to predict the temperature one month ahead
  model <- rnn(x_train, y_train, n_hidden = 2, eta = 1e-4, n_epochs = 100)
  
  # Plot the squared error during model fitting
  plot(model$error, type = "l", xlab = "Epoch", ylab = "Squared Error")

  # Predict the temperature in the test set
  y_pred <- predict(model, x_test, y_test)
  
  # Plot the test set
  plot(y_test, type = "l", xlab = "Time", ylab = "Temperature (Normalized)")
  
  # Add the predicted temperature (red)
  lines(y_pred, col = 2)