UPDATE - edits with my code progress are added at the end of this post.
I'm trying to create a neural network in R based on the bayes-by-backprop model as described in this paper. As inspiration for the code i'm using the python description on this website. However, in this paper they use an autograd function and i'm trying to calculate the gradient manually. The important algorithm from the paper is this one:
I think i've got most of the code ready, but i'm getting stuck on calculating the partial derivatives needed to calculate the gradients for mu (mean) and rho (parameter of the standard deviation).
This is the backpropagation function that i'm trying to make. I'm trying to adapt it from a regular neural network that i created before. The parameters are:
- y = ground truth
- Wn = list, every entry represents a layer of the network, containing a sample of the probability distributions in that layor
- Un = list similar to Wn, the mus (mean) of the probability distributions in the posterior
- Rn = list similar to Wn, the rhos (parameter used to define the standard deviation)
- sigma = list similar to Wn, the standard deviation
- eps = list similar to Wn, the random variable that is used for the reparametrization trick
- ff = a list of the outputs of each feedforward layer, the last output is the model prediction.
backpropagate <- function(y, Wn, Un, Rn, sigma, ff, eps, learn_rate = 0.01) {
y_hat <- ff[[3]]
loss <- list()
dWn <- list()
loss[[2]] <- loss_function(y_hat, y, Wn, Un, sigma)
dUn[[2]] <- ???
dRn[[2]] <- ???
loss[[1]] <- ???
dUn[[1]] <- ???
dRn[[1]] <- ???
Un[[1]] <- Un[[1]] - learn_rate * dUn[[1]]
Un[[2]] <- Un[[2]] - learn_rate * dUn[[2]]
Rn[[1]] <- Rn[[1]] - learn_rate * dRn[[1]]
Rn[[2]] <- Rn[[2]] - learn_rate * dRn[[2]]
return(list(Un, Rn))
}
How do i calculate the gradients of mu and rho? I can do partial derivatives on polynomial and exponential functions but mu and rho are defined here only as probability distributions. The loss function is defined as the $$posterior - prior * likelihood$$ but how do i take the derivative w.r.t. mu and rho of those?
$$posterior = \log(P(w)) = \sum_i \log(N(w_i | \mu, \sigma^2)) $$ $$prior = \log(q(w|\theta)) = \sum_i \log(N(w_i | 0, 1)) $$ $$likelihood = \log(P(D|w)) = y * log(softmax(\hat{y})) $$
For reference:
My main training function looks like this:
train <- function(x, y, neurons = 32, layers = 3, rate = 0.01, iterations = 10000) {
d <- ncol(x) + 1
Un <- list()
Rn <- list()
Un[[1]] <- matrix(rnorm(d * neurons), d, neurons) # generate mus for the gaussian distribution of each neuron. matrix d (rows) x neurons (columns)
Un[[2]] <- matrix(rnorm(neurons + 1), neurons + 1, 1)
Rn[[1]] <- matrix(-3, d, neurons) # generate the rhos to calculate the standard deviation later
Rn[[2]] <- matrix(-3, neurons + 1, 1)
for (i in 1:iterations) {
Wn <- list()
sigma <- list()
eps <- list()
sigma[[1]] <- log(1 + exp(Rn[[1]])) # calculate the standard deviation from rho
sigma[[2]] <- log(1 + exp(Rn[[2]]))
eps[[1]] <- matrix(rnorm(d * neurons, 0, 0.1), nrow = d, ncol = neurons) # generate a random number epsilon for every neuron
eps[[2]] <- matrix(rnorm(neurons + 1, 0, 0.1), neurons + 1, 1)
Wn[[1]] <- Un[[1]] + sigma[[1]] * eps[[1]] # take one sample of the posterior
Wn[[2]] <- Un[[2]] + sigma[[2]] * eps[[2]]
ff <- feedforward(x, Wn)
backlist <- backpropagate(y, Wn, Un, Rn, sigma, ff, eps, learn_rate = rate)
Un <- backlist[[1]]
Rn <- backlist[[2]]
}
return(Wn)
}
And then my feedforward plus helper functions:
feedforward <- function(x, Wn) {
ff <- list(x)
Zn <- cbind(1, ff[[1]]) %*% Wn[[1]]
ff[[2]] <- sigmoid::relu(Zn)
Zn <- cbind(1, ff[[2]]) %*% Wn[[2]]
ff[[3]] <- Zn
return(ff)
}
log_softmax <- function(y_hat, y){
y * log(exp(y_hat) / sum(exp(y_hat)))
}
log_gaussian <- function(x, mu, sigma){
return(-0.5 * log(2*pi) - log(sigma) - (x - mu)**2 / (2 * sigma**2))
}
loss_function <- function(y_hat, y, Wn, Un, sigma){
posterior <- sum(log_gaussian(Wn[[i]], Un[[i]], sigma[[i]]))
prior <- sum(log_gaussian(Wn[[i]], 0, 1))
likelihood <- log_softmax(y_hat, y)
return(posterior - prior * likelihood)
}
EDIT: here's the code that i've tried in Torch for R so far. I think i have everything correct up to the point where i need to calculate the posterior and prior for the loss function. I don't know how i can call the gaussian function in torch to generate the distributions for the posterior and the prior.
For the posterior, i need to generate a distribution for every neuron with mean $\mu$ and standard deviation $\sigma$, which are the parameters for each neuron.
For the prior, i need to generate a distribution for every neuron with mean $0$ and standard deviation $1$.
The code is basically adapted from this page on the torch website.
library(torch)
### generate training data -----------------------------------------------------
# input dimensionality (number of input features)
d_in <- 3
# output dimensionality (number of predicted features)
d_out <- 1
# number of observations in training set
n <- 100
# create random data
x <- torch_randn(n, d_in)
y <- x[, 1, NULL] * 0.2 - x[, 2, NULL] * 1.3 - x[, 3, NULL] * 0.5 + torch_randn(n, 1)
### initialize weights ---------------------------------------------------------
# dimensionality of hidden layer
d_hidden <- 32
# mean values of the neurons in the first layer
mu1 <- torch_randn(d_in, d_hidden, requires_grad = TRUE)
# mean values of the neurons in the second layer
mu2 <- torch_randn(d_hidden, d_out, requires_grad = TRUE)
# rho values (parameters for the standard deviation) for the first layer
rho1 <- torch_randn(d_in, d_hidden, requires_grad = TRUE)
# rho values for the second layer
rho2 <- torch_randn(d_hidden, d_out, requires_grad = TRUE)
### network parameters ---------------------------------------------------------
learning_rate <- 1e-4
### training loop --------------------------------------------------------------
for (t in 1:200) {
# random error
eps1 <- torch_randn(d_in, d_hidden, requires_grad = TRUE)
eps2 <- torch_randn(d_hidden, d_out, requires_grad = TRUE)
### -------- Sample variational posterior --------
w1 <- torch_add(mu1, torch_multiply(torch_log(torch_add(torch_exp(rho1), 1))), eps1)
w2 <- torch_add(mu2, torch_multiply(torch_log(torch_add(torch_exp(rho2), 1))), eps2)
### -------- Forward pass --------
y_pred <- x$mm(w1)$clamp(min = 0)$mm(w2)$clamp(min = 0)
### -------- Likelihood --------
likelihood <- torch_multiply(y, nnf_log_softmax(y_hat))
### -------- Prior --------
### -------- Posterior --------
### -------- compute loss --------
loss <- (posterior - prior * likelihood)$sum()
if (t %% 10 == 0)
cat("Epoch: ", t, " Loss: ", loss$item(), "\n")
### -------- Backpropagation --------
# compute gradient of loss w.r.t. all tensors with requires_grad = TRUE
loss$backward()
### -------- Update weights --------
# Wrap in with_no_grad() because this is a part we DON'T
# want to record for automatic gradient computation
with_no_grad({
mu1 <- mu1$sub_(learning_rate * mu1$grad)
mu2 <- mu2$sub_(learning_rate * mu2$grad)
rho1 <- rho1$sub_(learning_rate * rho1$grad)
rho2 <- rho2$sub_(learning_rate * rho2$grad)
# Zero gradients after every pass
mu1$grad$zero_()
mu2$grad$zero_()
rho1$grad$zero_()
rho2$grad$zero_()
})
}
EDIT2: This is the R code that i have right now, using torch.
the log_gaussian
function is copied directly from this website.
I create 100 observations with 3 features, with a hidden layer of 32 neurons and a single output. the output is either 1 or 0.
It seems to be working, but after 20 or so iterations the loss suddenly returns NaN and the network stops learning. I have some debugging still to do.
library(torch)
library(Rlab)
### generate training data -----------------------------------------------------
# input dimensionality (number of input features)
d_in <- 3
# output dimensionality (number of predicted features)
d_out <- 1
# number of observations in training set
n <- 100
# create random data
x <- torch_randn(n, d_in)
y <- torch_tensor(rbern(n, 0.6))
### initialize weights ---------------------------------------------------------
# dimensionality of hidden layer
d_hidden <- 32
# mean values of the neurons in the first and second layers
mu1 <- torch_randn(d_in, d_hidden, requires_grad = TRUE)
mu2 <- torch_randn(d_hidden, d_out, requires_grad = TRUE)
bmu1 <- torch_randn(1, d_hidden, requires_grad = TRUE)
bmu2 <- torch_randn(1, d_out, requires_grad = TRUE)
# rho values (parameters for the standard deviation) for the first and second layers
rho1 <- torch_randn(d_in, d_hidden, requires_grad = TRUE)
rho2 <- torch_randn(d_hidden, d_out, requires_grad = TRUE)
brho1 <- torch_randn(1, d_hidden, requires_grad = TRUE)
brho2 <- torch_randn(1, d_out, requires_grad = TRUE)
### network parameters ---------------------------------------------------------
learning_rate <- 1e-11
### training loop --------------------------------------------------------------
for (t in 1:200) {
# random error
eps1 <- torch_randn(d_in, d_hidden)
eps2 <- torch_randn(d_hidden, d_out)
eps3 <- torch_randn(d_in, d_hidden)
eps4 <- torch_randn(d_hidden, d_out)
beps1 <- torch_randn(1, d_hidden)
beps2 <- torch_randn(1, d_out)
beps3 <- torch_randn(1, d_hidden)
beps4 <- torch_randn(1, d_out)
s1 <- torch_log(torch_add(torch_exp(rho1), 1))
s2 <- torch_log(torch_add(torch_exp(rho2), 1))
bs1 <- torch_log(torch_add(torch_exp(brho1), 1))
bs2 <- torch_log(torch_add(torch_exp(brho2), 1))
### -------- Sample variational posterior --------
w1 <- rho1$exp()$add(1)$log()$multiply(eps1)$add(mu1)
w12 <- rho1$exp()$add(1)$log()$multiply(eps3)$add(mu1)
w2 <- rho2$exp()$add(1)$log()$multiply(eps2)$add(mu2)
w22 <- rho2$exp()$add(1)$log()$multiply(eps4)$add(mu2)
b1 <- brho1$exp()$add(1)$log()$multiply(beps1)$add(bmu1)
b12 <- brho1$exp()$add(1)$log()$multiply(beps3)$add(bmu1)
b2 <- brho2$exp()$add(1)$log()$multiply(beps2)$add(bmu2)
b22 <- brho2$exp()$add(1)$log()$multiply(beps4)$add(bmu2)
### -------- Forward pass --------
softmax <- nn_softmax(1)
y_hat <- softmax(x$mm(w1)$add(b1)$clamp(min = 0)$mm(w2)$add(b2))
y_hat2 <- softmax(x$mm(w12)$add(b12)$clamp(min = 0)$mm(w22)$add(b22))
### -------- Likelihood --------
likelihood <- y_hat$log()$multiply(y)$sum()
likelihood2 <- y_hat2$log()$multiply(y)$sum()
### -------- Prior --------
prior1 <- torch_tensor(0)$subtract(w1)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior2 <- torch_tensor(0)$subtract(w2)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior3 <- torch_tensor(0)$subtract(b1)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior4 <- torch_tensor(0)$subtract(b2)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior <- prior1$add(prior2)$add(prior3)$add(prior4)
prior12 <- torch_tensor(0)$subtract(w12)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior22 <- torch_tensor(0)$subtract(w22)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior32 <- torch_tensor(0)$subtract(b12)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
prior42 <- torch_tensor(0)$subtract(b22)$square()$divide(2)$subtract(torch_log(2*pi))$sum()
priort2 <- prior12$add(prior22)$add(prior32)$add(prior42)
### -------- Posterior --------
posterior1 <- w1$subtract(mu1)$square()$divide(s1$square()$multiply(2))$subtract(s1$log())$subtract(torch_log(2*pi))$sum()
posterior2 <- w2$subtract(mu2)$square()$divide(s2$square()$multiply(2))$subtract(s2$log())$subtract(torch_log(2*pi))$sum()
posterior3 <- b1$subtract(bmu1)$square()$divide(bs1$square()$multiply(2))$subtract(bs1$log())$subtract(torch_log(2*pi))$sum()
posterior4 <- b2$subtract(bmu2)$square()$divide(bs2$square()$multiply(2))$subtract(bs2$log())$subtract(torch_log(2*pi))$sum()
posterior <- posterior1$add(posterior2)$add(posterior3)$add(posterior4)
posterior12 <- w12$subtract(mu1)$square()$divide(s1$square()$multiply(2))$subtract(s1$log())$subtract(torch_log(2*pi))$sum()
posterior22 <- w22$subtract(mu2)$square()$divide(s2$square()$multiply(2))$subtract(s2$log())$subtract(torch_log(2*pi))$sum()
posterior32 <- b12$subtract(bmu1)$square()$divide(bs1$square()$multiply(2))$subtract(bs1$log())$subtract(torch_log(2*pi))$sum()
posterior42 <- b22$subtract(bmu2)$square()$divide(bs2$square()$multiply(2))$subtract(bs2$log())$subtract(torch_log(2*pi))$sum()
posteriort2 <- posterior12$add(posterior22)$add(posterior32)$add(posterior42)
### -------- compute loss --------
loss <- posterior$subtract(prior)$subtract(likelihood)$add(posteriort2$subtract(priort2)$subtract(likelihood2))
if (t %% 10 == 0 | t < 10)
cat("Epoch: ", t, " Loss: ", loss$item(), "\n")
### -------- Backpropagation --------
# compute gradient of loss w.r.t. all tensors with requires_grad = TRUE
loss$backward()
### -------- Update weights --------
# Wrap in with_no_grad() because this is a part we DON'T
# want to record for automatic gradient computation
with_no_grad({
mu1 <- mu1$sub_(learning_rate * mu1$grad)
mu2 <- mu2$sub_(learning_rate * mu2$grad)
rho1 <- rho1$sub_(learning_rate * rho1$grad)
rho2 <- rho2$sub_(learning_rate * rho2$grad)
bmu1 <- bmu1$sub_(learning_rate * bmu1$grad)
bmu2 <- bmu2$sub_(learning_rate * bmu2$grad)
brho1 <- brho1$sub_(learning_rate * brho1$grad)
brho2 <- brho2$sub_(learning_rate * brho2$grad)
# Zero gradients after every pass
mu1$grad$zero_()
mu2$grad$zero_()
rho1$grad$zero_()
rho2$grad$zero_()
bmu1$grad$zero_()
bmu2$grad$zero_()
brho1$grad$zero_()
brho2$grad$zero_()
})