R/setup.R

In dfcorbin/npbanditC: (Contextual) Multi-Armed Bandit Simulations

## THIS SOURCE FILE CONTAINS FUNCTIONS ASSOCIATED WITH SETTING UP THE OBJECTS
## REQUIRED TO RUN AN MAB SIMULATION E.G. PRIOR DISTRIBUIONS, MEAN-REWARD
## FUNCTIONS.


#' Generate a list of functions from the fourier basis
#' 
#' Orthogonal on [-pi,pi].
#'
#' @param J The number of basis functions to be used in the model. This must be
#' an even number.
#'
#' @return A list of functions.
#'
fourier_basis <- function(J){
   if ( J %% 2 != 0) stop("J must be even!")
   basis <- list() ; basis[[1]] <- function(x) return(1)
   index <- 1:(J+1)
   create_fun <- function(j){
      if (j == 1) fun <- function(x) return(1)
      else if (j %% 2 == 0) fun <- function(x) sqrt(2) * sin(2*(j-1)*pi*x)
      else fun <- function(x) sqrt(2) * cos(2*(j-2)*pi*x)
      return(fun)
   }
   
   basis <- lapply(index,create_fun)
   return(basis)
}

#' Generate Legendre Polynomials
#'
#' @param J An integer representing the number of basis functions to 
#' generate (NOT INCLUDING THE INTERCEPT!).
#'
#' @return A list of polynomial functions.
#' @export
#'
legendre_basis <- function(J){
   return(orthopolynom::polynomial.functions(orthopolynom::legendre.polynomials(J)))
}


#' Generate Prior Distribution on Bandit Parameters
#'
#' @param nlevers An integer representing the number of levers to choose from.
#' @param J An integer representing the number coefficients that are being used
#' in the non-parametric model.
#' #' @param bas_type Either "fourier" or "poly".
#' @param alpha Scaling parameter to tune the prior variances.
#' @param b Hyperparameter for the inverse gamma distribution. Directly related to 
#' the rate of exploration.
#'
#' @return A list containing a prior distribution for the parameters
#' associated with each lever. Each prior distribution is itself a
#' a list containing the hyperparameters.
#' @export
#'
gen_priors <- function(nlevers,J,bas_type = "poly",alpha = 1,b = 1){
  #THIS FUNCTION CAN BE CHANGED LATER ALLOW FOR MORE DETAILED
  #PRIORS.
  prior <- list()
  if (bas_type == "poly") Sigma <- c( 1 , ( 1:J )^(-alpha) )
  else if (J %% 2 != 0) stop("J must be even in the fourier basis!")
  else{
     Sigma <- c(1)
     for (j in 1:(J/2) ){
        Sigma <- c(Sigma, j^(-alpha),j^(-alpha))
     }
  }
  for (i in 1:nlevers){
    prior[[i]] <- list(
      "beta" = rep(0,J+1),
      "covar"  = diag(Sigma),
      "a" = 2,
      "b" = b
    )
  }
  return(prior)
}


#' Generate mean-reward functions from the true prior distribution
#'
#' The levers can be constructed using either the legendre polynomial or fourier basis functions.
#' 
#' @param nlevers The number of levers to construct. 
#' @param J The number of basis functions in each lever.
#' @param bas_type The type of basis to use (either "fourier" or "poly").
#'
rand_levers <- function(nlevers,J,bas_type){
   prior <- gen_priors(nlevers,J,bas_type)
   beta <- sim_params(prior)
   if (bas_type == "fourier") basis <- fourier_basis(J)
   else basis <- legendre_basis(J)
   
   create_fun <- function(lever){
      fun <- function(x){
         out <- 0
         for (j in 1:length(basis) ){
            out <- out + beta[lever,j]*basis[[j]](x)
         } 
         return(out)
      }
      return(fun)
   }
   
   lever_list <- lapply(1:nlevers,create_fun)
   return(lever_list)
}