ApolloChoiceModelling forum

Code: Select all

# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS                       ####
# ################################################################# #

### Initialise
rm(list = ls())
library(apollo)
apollo_initialise()

### Set core controls
apollo_control = list(
  modelName       = "LC_twoChoices",
  modelDescr      = "LC models with 2 classes and two choices inside each",
  indivID         = "indivID"
)

# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS                     ####
# ################################################################# #

### Loading data from package
### if data is to be loaded from a file (e.g. called data.csv), 
### the code would be: database = read.csv("data.csv",header=TRUE)
database = apollo_timeUseData
### for data dictionary, use ?apollo_timeUseData
# outside good: time spent at home and travelling
database$t_outs = rowSums(database[,c("t_a01", "t_a06", "t_a10", "t_a11", "t_a12")])/60 
database$t_leis = rowSums(database[,c("t_a07", "t_a08", "t_a09")])/60
database$t_work = database$t_a02/60
database$t_scho = database$t_a03/60
database$t_shop = database$t_a04/60
database$t_priv = database$t_a05/60
database$doesLeisure <- database$t_leis > 0
database$doesWork    <- database$t_work > 0

# ################################################################# #
#### DEFINE MODEL PARAMETERS                                     ####
# ################################################################# #

### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(ascL_1 = 0, ascL_2 = 0, 
                bFeL_1 = 0, bFeL_2 = 0, 
                bAgL_1 = 0, bAgL_2 = 0, 
                bFTL_1 = 0, bFTL_2 = 0, 
                bWkL_1 = 0, bWkL_2 = 0, 
                ascW_1 = 0, ascW_2 = 0, 
                bFeW_1 = 0, bFeW_2 = 0, 
                bAgW_1 = 0, bAgW_2 = 0, 
                bFTW_1 = 0, bFTW_2 = 0, 
                bWkW_1 = 0, bWkW_2 = 0, 
                delt_1 = 0, delt_2 = 0)

### Vector with names (in quotes) of parameters to be kept fixed at their
### starting value in apollo_beta, use apollo_beta_fixed = c() if none.
apollo_fixed = c("delt_2")

# ################################################################# #
#### DEFINE LATENT CLASS COMPONENTS                              ####
# ################################################################# #

apollo_lcPars=function(apollo_beta, apollo_inputs){
  lcpars = list()
  lcpars[["ascL"]] = list(ascL_1, ascL_2)
  lcpars[["bFeL"]] = list(bFeL_1, bFeL_2)
  lcpars[["bAgL"]] = list(bAgL_1, bAgL_2)
  lcpars[["bFTL"]] = list(bFTL_1, bFTL_2)
  lcpars[["bWkL"]] = list(bWkL_1, bWkL_2)
  lcpars[["ascW"]] = list(ascW_1, ascW_2)
  lcpars[["bFeW"]] = list(bFeW_1, bFeW_2)
  lcpars[["bAgW"]] = list(bAgW_1, bAgW_2)
  lcpars[["bFTW"]] = list(bFTW_1, bFTW_2)
  lcpars[["bWkW"]] = list(bWkW_1, bWkW_2)
  
  classAlloc_settings = list(
    utilities = list(class_1 = delt_1, 
                     class_2 = delt_2)
  )
  
  lcpars[["pi_values"]] = apollo_classAlloc(classAlloc_settings)
  
  return(lcpars)
}

# ################################################################# #
#### GROUP AND VALIDATE INPUTS                                   ####
# ################################################################# #

apollo_inputs = apollo_validateInputs()

# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION                        ####
# ################################################################# #

apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
  
  ### Initialise
  apollo_attach(apollo_beta, apollo_inputs)
  on.exit(apollo_detach(apollo_beta, apollo_inputs))
  P = list()
  
  ### Define settings for MNL model component that are generic across classes
  mnl_leisure_settings = list(
    alternatives = c(no=0, yes=1),
    choiceVar    = doesLeisure
  )
  mnl_work_settings = list(
    alternatives = c(no=0, yes=1),
    choiceVar    = doesWork
  )
  
  ### Loop over classes
  for(s in 1:2){
    
    ### Leisure decision within class s
    mnl_leisure_settings$utilities = list(
      no  = 0, 
      yes = ascL[[s]] + bFeL[[s]]*female + bAgL[[s]]*age + bFTL[[s]]*occ_full_time + bWkL[[s]]*weekend
    )
    P[[paste0("Class_",s,"_leisure")]] = apollo_mnl(mnl_leisure_settings, functionality)
    
    ### Work decision within class s
    mnl_work_settings$utilities = list(
      no  = 0, 
      yes = ascW[[s]] + bFeW[[s]]*female + bAgW[[s]]*age + bFTW[[s]]*occ_full_time + bWkW[[s]]*weekend
    )
    P[[paste0("Class_",s,"_work")]] = apollo_mnl(mnl_work_settings, functionality)
    
    ### Take product of both decisions
    P[[paste0("Class_",s)]] = P[[paste0("Class_",s,"_leisure")]]*P[[paste0("Class_",s,"_work")]]
    
    ### Take product across observation for same individual
    P[[paste0("Class_",s)]] = apollo_panelProd(P[[paste0("Class_",s)]], apollo_inputs ,functionality)
  }
  
  ### Compute latent class model probabilities
  lc_settings  = list(inClassProb = P[paste0("Class_",1:2)], classProb=pi_values)
  P[["model"]] = apollo_lc(lc_settings, apollo_inputs, functionality)
  
  ### Prepare and return outputs of function
  P = apollo_prepareProb(P, apollo_inputs, functionality)
  return(P)
}

# ################################################################# #
#### MODEL ESTIMATION AND OUTPUT                                 ####
# ################################################################# #

### Estimation
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, 
                        apollo_inputs)

### Output to screen
apollo_modelOutput(model)

### Output to file
apollo_saveOutput(model)