Calculating the posterior of linear prediction

Interfaces brms
1
  • Operating System: Windows 10
  • brms Version: 2.8.0

Dear all,

I had some trouble to find a place to ask this question, so I am sorry if it is not exactly appropriate. Let me know and I will be happy to move it.
I am fitting a linear Gaussian model with a specific library (ngspatial) which uses a bayesian framework. I would like to compute the bayes R2 as provided by rstan and brms (detailed here). To do this, I need to calculate the posterior of the linear prediction, but there is no function to do it in ngspatial.
I tried to build one by comparing my result with a simple model fitted with brms :

data(mtcars)
library(brms)

Model <- brm(mpg ~ wt + cyl + am,            
             data = mtcars,
             family = gaussian())

bayes_R2(Model)

The bayes R2 is really high (above 0.8)

Next, come my try to recode it

bayes_R2Adapted<- function(Posteriors,y,X,NDraws) {
  #based on : R-squared for Bayesian regression models
  ypred <- Sample_ypred(Posteriors,X,NDraws)
  e <- -1 * sweep(ypred, 2, y)
  var_ypred <- apply(ypred, 1, var)
  var_e <- apply(e, 1, var)
  R2 <- var_ypred / (var_ypred + var_e)
  print(quantile(R2,probs = c(0.005,0.5,0.95)))
  return(R2)
}

Sample_ypred <- function(Posteriors,X,NDraws){
  Samples <- list()
  #iterate for the number of draws required
  for (i in 1:NDraws){
    CoeffFixS <- apply(Posteriors,2,function(x){return(sample(x,size=nrow(X)))})
    Pred <- rowSums(X*CoeffFixS)
    Samples[[length(Samples)+1]]<-Pred
  }
  #Return the NDraws
  Preds <- do.call(cbind,Samples)
  return(Preds)
}

#get the posterior for betas
Post <- posterior_samples(Model)[1:4]
#get the data
X <- cbind(rep(1,nrow(mtcars)),mtcars$wt,mtcars$cyl,mtcars$am)
bayes_R2JG(Posteriors = Post,y = mtcars$mpg, X = X,NDraws = 3000)

The R2 I get here is very low, arround 0.3

I think that the mistake is somewhere in the Sample_ypred function that is supposed to mimic the posterior_linpred function.

Could someone help me with that problem ? Thank you !