ApolloChoiceModelling forum

Code: Select all

library(apollo)
library(haven)
library(plyr)
library(dplyr)
library(labelled)
library(tidyverse)

randstad <- c(
  #b_randstad_is = 0,
  b_randstad_not = 0,
  b_randstad_to = 0,
  b_randstad_from = 0
)

wdist <- c(
  b_weekdist_dec    = 0,
  b_weekdist_inc    = 0,
  b_weekdist_same         = 0,
  #b_weekdist_nojob              = 0,
  b_weekdist_lostjob             = 0,
  b_weekdist_gotjob              = 0,
  b_weekdist_alwayswfh  = 0,
  b_weekdist_wfhtocommuting = 0,
  b_weekdist_commutingtowfh = 0,
  b_weekdist_differingaddresses  = 0
)

spec1 <- c(
  randstad,
  wdist
)

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

### Clear memory
s12 <- read_csv("discretechoice.csv")

### Load Apollo library
library(apollo)

### Initialise code
apollo_initialise()

### Set core controls
apollo_control = list(
  modelName       = "1_OLnautos",
  modelDescr      = "Ordered logit model fitted to MOCOLODO questionnaire",
  indivID         = "uuid2",
  outputDirectory = "output"
)

# ################################################################# #
#### 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 = s12
### for data dictionary, use ?apollo_drugChoiceData

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

#ref cat strategy: don't use one that is too small and think of what you want to explore. Otherwise choose the middle or extremes.

### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(spec1,
                tau_nautos_change_1                = 0,
                tau_nautos_change_2                = 1)

### 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()

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

apollo_inputs = apollo_validateInputs()

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

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()
  
  ### Calculate probabilities using Ordered Logit model
  ol_settings = list(outcomeOrdered = nautos_change,
                     utility        =   
  #b_randstad_is*randstad_change_randstad + 
  b_randstad_not*randstad_change_notrandstad + 
  b_randstad_to*randstad_change_torandstad + 
  b_randstad_from*randstad_change_fromrandstad +
  b_weekdist_dec*weekdist_woonwerk_changecat_decreasedcommute +
  b_weekdist_inc*weekdist_woonwerk_changecat_increasedcommute +
  b_weekdist_same*weekdist_woonwerk_changecat_samecommute +
  #b_weekdist_nojob*weekdist_woonwerk_changecat_nojob +
  b_weekdist_lostjob*weekdist_woonwerk_changecat_lostjob +
  b_weekdist_gotjob*weekdist_woonwerk_changecat_gotjob +
  b_weekdist_alwayswfh*weekdist_woonwerk_changecat_alwaysworkfromhome +
  b_weekdist_wfhtocommuting*weekdist_woonwerk_changecat_workfromhometocommuting +
  b_weekdist_commutingtowfh*weekdist_woonwerk_changecat_commutingtoworkfromhome +
  b_weekdist_differingaddresses*weekdist_woonwerk_changecat_differingaddresses,
                     tau            = list(tau_nautos_change_1, tau_nautos_change_2))
  #rows           = (task==1))
  
  P[["model"]] = apollo_ol(ol_settings, functionality)
  
  ### Take product across observation for same individual
  #P = apollo_panelProd(P, apollo_inputs, functionality)
  
  ### Prepare and return outputs of function
  P = apollo_prepareProb(P, apollo_inputs, functionality)
  return(P)
}

# ################################################################# #
#### MODEL ESTIMATION                                            ####
# ################################################################# #

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

# ################################################################# #
#### MODEL OUTPUTS                                               ####
# ################################################################# #

# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO SCREEN)                               ----
# ----------------------------------------------------------------- #

apollo_modelOutput(model)

# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO FILE, using model name)               ----
# ----------------------------------------------------------------- #

apollo_saveOutput(model)

Code: Select all

uspec1 <- quote(
  #b_randstad_is*randstad_change_randstad + 
  b_randstad_not*randstad_change_notrandstad + 
  b_randstad_to*randstad_change_torandstad + 
  b_randstad_from*randstad_change_fromrandstad +
  b_weekdist_dec*weekdist_woonwerk_changecat_decreasedcommute +
  b_weekdist_inc*weekdist_woonwerk_changecat_increasedcommute +
  b_weekdist_same*weekdist_woonwerk_changecat_samecommute +
  #b_weekdist_nojob*weekdist_woonwerk_changecat_nojob +
  b_weekdist_lostjob*weekdist_woonwerk_changecat_lostjob +
  b_weekdist_gotjob*weekdist_woonwerk_changecat_gotjob +
  b_weekdist_alwayswfh*weekdist_woonwerk_changecat_alwaysworkfromhome +
  b_weekdist_wfhtocommuting*weekdist_woonwerk_changecat_workfromhometocommuting +
  b_weekdist_commutingtowfh*weekdist_woonwerk_changecat_commutingtoworkfromhome +
  b_weekdist_differingaddresses*weekdist_woonwerk_changecat_differingaddresses
)

Code: Select all

  ### Calculate probabilities using Ordered Logit model
  ol_settings = list(outcomeOrdered = nautos_change,
                     utility        =   
  #b_randstad_is*randstad_change_randstad + 
  b_randstad_not*randstad_change_notrandstad + 
  b_randstad_to*randstad_change_torandstad + 
  b_randstad_from*randstad_change_fromrandstad +
  b_weekdist_dec*weekdist_woonwerk_changecat_decreasedcommute +
  b_weekdist_inc*weekdist_woonwerk_changecat_increasedcommute +
  b_weekdist_same*weekdist_woonwerk_changecat_samecommute +
  #b_weekdist_nojob*weekdist_woonwerk_changecat_nojob +
  b_weekdist_lostjob*weekdist_woonwerk_changecat_lostjob +
  b_weekdist_gotjob*weekdist_woonwerk_changecat_gotjob +
  b_weekdist_alwayswfh*weekdist_woonwerk_changecat_alwaysworkfromhome +
  b_weekdist_wfhtocommuting*weekdist_woonwerk_changecat_workfromhometocommuting +
  b_weekdist_commutingtowfh*weekdist_woonwerk_changecat_commutingtoworkfromhome +
  b_weekdist_differingaddresses*weekdist_woonwerk_changecat_differingaddresses,
                     tau            = list(tau_nautos_change_1, tau_nautos_change_2))
  #rows           = (task==1))

Code: Select all

  ### Calculate probabilities using Ordered Logit model
  ol_settings = list(outcomeOrdered = nautos_change,
                     utility        =   
                                         uspec1,
                     tau            = list(tau_nautos_change_1, tau_nautos_change_2))
  #rows           = (task==1))