ApolloChoiceModelling forum

Code: Select all

### Clear memory
rm(list = ls())

### Load libraries
library(apollo)
#> Apollo 0.2.4
#> www.ApolloChoiceModelling.com
#> See url for a detailed manual, examples and a help forum.
#> Sign up to our mailing list for updates on new releases.

### Initialise code
apollo_initialise()

### Set core controls
apollo_control <- list(
  modelName = "MNL",
  modelDescr = "Adults' preferences for a vaccine product",
  indivID = "ID"
)
# ####################################################### #
#### 2. Data loading                                   ####
# ####################################################### #

database <- subset(model, select = c("ID","price.1","risk2.1","risk3.1","duration2.1",
                                     "duration3.1","efficacy2.1","efficacy3.1",
                                     "admin.1","doses2.1","doses3.1","origin.1",
                                     "price.2","risk2.2","risk3.2",
                                     "duration2.2","duration3.2","efficacy2.2",
                                     "efficacy3.2","admin.2","doses2.2",
                                     "doses3.2","origin.2","choice"))

database <- as.data.frame(database)

# ####################################################### #
#### 3. Parameter definition                           ####
# ####################################################### #

### Vector of parameters, including any that are kept fixed 
### during estimation

apollo_beta <- c(
  asc     = 0,
  b_price  = 0,
  b_risk2  = 0,
  b_risk3  = 0,
  b_duration2  = 0,
  b_duration3 = 0,
  b_efficacy2 = 0,
  b_efficacy3 = 0,
  b_oral = 0,
  b_dose2 = 0,
  b_dose3 = 0,
  b_imported = 0
)

### Vector with names (in quotes) of parameters to be
###  kept fixed at their starting value in apollo_beta.
### Use apollo_beta_fixed = c() for no fixed parameters.

apollo_fixed <- c() # no fixed parameters in our model

# ####################################################### #
#### 4. Input validation                               ####
# ####################################################### #

apollo_inputs = apollo_validateInputs()

# ####################################################### #
#### 5. Likelihood definition                          ####
# ####################################################### #

apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality = "estimate"){
  ### Attach inputs and detach after function exit
  apollo_attach(apollo_beta, apollo_inputs)
  on.exit(apollo_detach(apollo_beta, apollo_inputs))
  
  ### Create list of probabilities P
  P <- list()
  
  V <- list()
  
  ### List of utilities: these must use the same names as
  ### in mnl_settings, order is irrelevant.
  V[['alt1']] = asc + b_price*price.1 + b_risk2*risk2.1 + b_risk3*risk3.1 + 
    b_duration2*duration2.1 + b_duration3*duration3.1 + b_efficacy2*efficacy2.1 + 
    b_efficacy3*efficacy3.1 + b_oral*admin.1 + b_dose2*doses2.1 + 
    b_dose3*doses3.1 + b_imported*origin.1
  V[['alt2']] = asc + b_price*price.2 + b_risk2*risk2.2 + b_risk3*risk3.2 + 
    b_duration2*duration2.2 + b_duration3*duration3.2 + b_efficacy2*efficacy2.2 + 
    b_efficacy3*efficacy3.2 + b_oral*admin.2 + b_dose2*doses2.2 + 
    b_dose3*doses3.2 + b_imported*origin.2
  V[['alt3']] = 0
  
  ### Define settings for MNL model component
  mnl_settings <- list(
    alternatives = c(alt1 = 1, alt2 = 2, alt3 = 3),
    avail        = list(alt1 = 1, alt2 = 1, alt3 = 1),
    choiceVar    = choice,
    V            = V
  )
  
  ### Compute probabilities using MNL model
  P[['model']] = apollo_mnl(mnl_settings, functionality)
  
  ### Take product across observation for same individual
  P = apollo_panelProd(P, apollo_inputs, functionality)
  
  ### Prepare and return outputs of the function
  P = apollo_prepareProb(P, apollo_inputs, functionality)
  
  return(P)
}

# ####################################################### #
#### 6. Model estimation and reporting                 ####
# ####################################################### #
fit <- apollo_estimate(apollo_beta, apollo_fixed, 
                       apollo_probabilities, apollo_inputs)

apollo_modelOutput(fit, list(printPVal = TRUE))