Function to calculate a gradient using a for loop in R - r

Question

I am trying to write a function to calculate a gradient in R. The function must specifically do so using a for loop. I am writing this function in order to illustrate how a for loop is less efficient than vectorized programming when trying to calculate the gradient.
The function takes in a design matrix X and a vector of coefficients beta in order to calculate the gradient of a cost function (The design matrix is a matrix of covariates with ones on the first column.)
The cost function is the MSE,
. I am calculating the gradient using an analytical solution, taking the partial derivative of the loss function. This gives us the partial derivative as ,
for the first coefficient $\beta_{0}$ and then similarly for all other coefficients $\beta_{j}$,
I managed to calculate the answer (implementing the above) using vectorized programming as the line of code below.
-2*t(X)%*%(y-X%*%beta)
My attempt at using a for loop, does not work but it looked like this,
# Initialize the matrix to hold gradient
gradient = matrix(0, nrow = nrow(beta))
for(i in 1:nrow(beta)){
if(i == 1){
gradient[i] = -2*sum(y - X%*%beta) # first value
}else if(i>1){
gradient[i] = -2*sum( t(X)%*%(y - X%*%beta) ) * apply(X[,-1],2,sum)[i-1]
} }
Below is the code to generate data to use and the two implementations that I tried in R. The code generates the data and can be used to test fixing the for loop if copied into R.
# Values
# Random data Generated
n = 4
p = 3
beta_0 = 2
beta = matrix(c(beta_0,3,1,4), nrow= (p+1) ) # coefficients
X = runif(n=(n*p), min=-5,max= 5) # covariates
X = matrix(X, nrow = n, ncol = p)
X = cbind(1, X) # make a design matrix
y = apply(X[,-1],1,mean) # Response (Some function) #
# Print all to show all initial values
print(list("Initial Values:"="","n:"=n," p:" = p, "beta_0:" = beta_0," beta:"=beta,
" X:"=X," y:" = y))
# Function 1
# Find the gradient (using a for loop)
# The partial derivative of the loss function
df_ols = function(beta,X,y){
begin.time <- proc.time()
# Initialize the matrix to hold gradient
gradient = matrix(0, nrow = nrow(beta))
for(i in 1:nrow(beta)){
if(i == 1){
gradient[i] = -2*sum(y - X%*%beta) # first value
}else if(i>1){
gradient[i] = -2*sum( t(X)%*%(y - X%*%beta) ) * apply(X[,-1],2,sum)[i-1]
} }
end.time <- proc.time()
time <- (end.time-begin.time)[3]
print(list("gradient 1"=gradient,"time"=time))
}
df_ols(beta,X,y)
# Function 2
# Find the gradient Approach 2 using vectorized programming
gradient_3 <- function(X, beta){
begin.time <- proc.time()
# Finding the gradient
grad_3 <- -2*t(X)%*%(y-X%*%beta)
grad_3 <- matrix(grad_3, ncol = 1,nrow = ncol(X)) # Turn into a column matrix
end.time <- proc.time()
time <- (end.time-begin.time)[3]
print(list("gradient 3"= grad_3 ,"time"=time))
}
gradient_3(X, beta) # Assumed Correct
I apologize if I was not too wordy. Any help would be appreciated.

Answer 1

I managed to get the for loop to work, below you'll see the answer.
# Find the gradient (using a for loop) explicit, element-wise formulations
# The partial derivative of the loss function
df_ols = function(beta,X,y){
begin.time <- proc.time()
# Initialize the matrix to hold gradient
gradient = matrix(0, nrow = nrow(beta))
for(i in 1:nrow(beta)){
if(i == 1){
gradient[i] = -2*sum(y - X%*%beta) # first value
}else if(i>1){
gradient[i] = -2*t(X[,i])%*%(y-X%*%beta)
#gradient[i] = -2*sum( t(X)%*%(y - X%*%beta) ) * apply(X[,-1],2,sum)[i-1]
} }
end.time <- proc.time()
time <- (end.time-begin.time)[3]
print(list("gradient 1"=gradient,"time"=time))
}
df_ols(beta,X,y)
, running both the vectorized and elementwise formations we find the vectorized process is much faster. We implement the full process below.
# Random data Generated
n = 100000*12
p = 3
beta_0 = 2
beta = matrix(c(beta_0,3,1,4), nrow= (p+1) ) # coefficients
X = runif(n=(n*p), min=-5,max= 5) # covariates
X = matrix(X, nrow = n, ncol = p)
X = cbind(1, X) # make a design matrix
y = apply(X[,-1],1,mean) # Response (Some function)
# Print parameters. To show all initial values
print(list("Initial Values:" = '',"n:"=n," p:" = p, "beta_0:" = beta_0," beta:"=beta,
" X:"=round(X,digits=2)," y:" = round(y,digits=2)))
# Function 3
# Find the gradient Approach 3, using vectorized programming
gradient_3 <- function(X, beta,y){
begin.time <- proc.time()
# Find the partial derivative of the rest (j'th)
grad_3 <- -2*t(X)%*%(y-X%*%beta)
grad_3 <- matrix(grad_3, ncol = 1,nrow = ncol(X)) # Turn into a column matrix
end.time <- proc.time()
time <- (end.time-begin.time)[3]
print(list("gradient 3"= grad_3 ,"time"=time))
}
Showing the results
> df_ols(beta,X,y) # Elementwise
$`gradient 1`
[,1]
[1,] 4804829
[2,] 53311879
[3,] 13471077
[4,] 73259191
$time
elapsed
3.59
> gradient_3(X, beta,y) # Vectorized Programming solution
$`gradient 3`
[,1]
[1,] 4804829
[2,] 53311879
[3,] 13471077
[4,] 73259191
$time
elapsed
0.89