R/code.R

Defines functions conv_opt

Documented in conv_opt

#' Solver for Bayesian Predictive Stacking of Predictive densities convex optimization problem
#'
#' @param scores [matrix] \eqn{N \times K} of expected predictive density evaluations for the K models considered
#'
#' @return W [matrix] of Bayesian Predictive Stacking weights for the K models considered
#'
#' @importFrom CVXR Variable Maximize Problem solve
#'
#' @examples
#' ## Generate (randomly) K predictive scores for n observations
#' n <- 50
#' K <- 5
#' scores <- matrix(runif(n*K), nrow = n, ncol = K)
#'
#' ## Find Bayesian Predictive Stacking weights
#' opt_weights <- conv_opt(scores)
#'
#' @export
conv_opt <- function(scores) {
  # library(CVXR, quietly = T)

  # set up minimization problem and solve it
  weights <- Variable( ncol(scores) )
  constraints <- list(weights >= 0, sum(weights) == 1)

  # the constraint for sum up to 1 with positive weights
  f <- Maximize( mean( log( scores %*% weights ) ) )
  problem <- Problem(f, constraints)
  result <- solve(problem, solver = "ECOS_BB") # ECOS, SCS, OSQP

  # return the weights
  W <- if(result$status == "solver_error") {
    matrix(rep(1/ncol(scores), ncol(scores)))
  } else {
    result$getValue(weights)
  }
  return(W)
}

Try the spBPS package in your browser

Any scripts or data that you put into this service are public.

spBPS documentation built on Oct. 25, 2024, 5:07 p.m.