More broadly speaking, what I'm trying to do is use a combination of apply functions and for loops to create a code I can use to run a latent class model of an arbitrary number of classes on the same dataset, with the same utility functions but varying beta & delta constants, by only changing one variable (below, kgroups) at the top of the file to specify how many classes I want to fit the model to.
My initial instinct was to use as.name(paste0(...)) calls to create the symbols for the coefficients that apollo will fit. apollo_validateInputs() kept erroring out when it was trying to find the object delta_c, since apollo_attach() is only called inside of apollo_probabilities() and won't actually run before I create apollo_inputs, which is the output of apollo_validateInputs().
By switching to the syntax used in the FAQ, which uses get(paste0(...)), I'm able to get apollo_validateInputs() to run but then apollo_estimate() makes calls to apollo_insertScaling(), which gives me the error "Error in apollo_insertScaling(e[], sca) : Argument "e" must be a function, a call, a symbol, or a value". This does make sense, since get() will return an object, not a symbol, but trying to use as.name() or as.symbol() instead causes an error with apollo_validateInputs().
The data is resulting from a choice experiment: 500 panelists each saw 10 choice questions, which had 2 alternatives with synthetic descriptions (containing 5 of 10 possible flavor terms) and one of 5 possible prices (A and B). There was also a no preference option (C). So the data has Participant (numeric ID) and Choice (all values A, B, or C) columns, plus binary columns for flavor terms (banana_A, banana_B, banana_C, oak_A...) and 3 columns for price (Price_A, Price_B, Price_C).
Let me know if some synthetic data would be helpful.
Code: Select all
### Load Apollo library
library(apollo)
### Initialise code
apollo_initialise()
### Set core controls
apollo_control <- list(
modelName ="Apollo_LC_Whiskey",
modelDescr ="Simple LC model on Whiskey",
indivID ="Participant",
nCores = 3,
noDiagnostics = TRUE
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
database <- read.csv("whiskey_choice_tidy_responses_ABC_binary.csv",header=TRUE)
database$Choice <- ifelse(database$Choice == "A", 1, ifelse(database$Choice == "B", 2, 3))
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
starting_coeffecients <- c(b_chocolate = 0.7179,
b_caramel = 0.8968,
b_tobacco = 0.3757,
b_leather = 0.2507,
b_sultanas = 0.4376,
b_oak = 0.6574,
b_banana = 0.5521,
b_corn = 0.4352,
b_grass = 0.4763,
b_mint = 0.3535,
b_price = -0.0141)
kgroups <- 2
### Results from Dr. Neill's Matlab running
#overall intercept set = 0, and we should also fix one class to be the reference
apollo_beta <- c(intercept = 0)
for (k in 1:kgroups) {
for (b in 1:length(starting_coeffecients)) {
apollo_beta[paste0(names(starting_coeffecients[b]), "_c", k)] <- starting_coeffecients[b]
}
apollo_beta[paste0("delta_c", k)] <- 0 #class-specific intercept/offset
}
### 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("intercept","delta_c1")
# ################################################################# #
#### DEFINE LATENT CLASS COMPONENTS ####
# ################################################################# #
apollo_lcPars <- function(apollo_beta, apollo_inputs){
lcpars <- sapply(setNames(nm = names(starting_coeffecients)),
function(t) {
lapply(1:kgroups, function(k) {
get(paste0(t, "_c", k))
})
})
V <- lapply(setNames(1:kgroups, paste0("class_", 1:kgroups)), function(k) {
get(paste0("delta_c", k))
})
mnl_settings <- list(
alternatives = setNames(1:kgroups, paste0("class_", 1:kgroups)),
avail = 1,
choiceVar = NA,
V = V
)
lcpars[["pi_values"]] = apollo_mnl(mnl_settings, functionality="raw")
lcpars[["pi_values"]] = apollo_firstRow(lcpars[["pi_values"]], apollo_inputs)
return(lcpars)
}
# ################################################################# #
#### 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()
### Define settings for MNL model component that are generic across classes
mnl_settings = list(
alternatives = c(A=1, B=2, C=3),
avail = list(A=1, B=1, C=1),
choiceVar = Choice
)
### Loop over classes
for (k in 1:kgroups){
### Compute class-specific utilities
V=list()
V[['A']] <- intercept +
b_chocolate[[k]] * chocolate_A +
b_tobacco[[k]] * tobacco_A +
b_caramel[[k]] * caramel_A +
b_sultanas[[k]] * sultanas_A +
b_grass[[k]] * grass_A +
b_mint[[k]] * mint_A +
b_oak[[k]] * oak_A +
b_leather[[k]] * leather_A +
b_corn[[k]] * corn_A +
b_banana[[k]] * banana_A +
b_price[[k]] * Price_A
V[['B']] <- intercept +
b_chocolate[[k]] * chocolate_B +
b_tobacco[[k]] * tobacco_B +
b_caramel[[k]] * caramel_B +
b_sultanas[[k]] * sultanas_B +
b_grass[[k]] * grass_B +
b_mint[[k]] * mint_B +
b_oak[[k]] * oak_B +
b_leather[[k]] * leather_B +
b_corn[[k]] * corn_B +
b_banana[[k]] * banana_B +
b_price[[k]] * Price_B
V[['C']] <- intercept
mnl_settings$V <- V
mnl_settings$componentName <- paste0("Class_", k)
### Compute within-class choice probabilities using MNL model
P[[paste0("Class_",k)]] <- apollo_mnl(mnl_settings, functionality)
### Take product across observation for same individual
P[[paste0("Class_",k)]] <- apollo_panelProd(P[[paste0("Class_",k)]], apollo_inputs, functionality)
}
### Compute latent class model probabilities
lc_settings = list(inClassProb = P, 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 ####
# ################################################################# #
### Optional starting values search
# apollo_beta=apollo_searchStart(apollo_beta, apollo_fixed,apollo_probabilities, apollo_inputs)
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
Code: Select all
Error in apollo_insertScaling(e[[i]], sca) :
Argument "e" must be a function, a call, a symbol, or a value
> traceback()
7: stop("Argument \"e\" must be a function, a call, a symbol, or a value")
6: apollo_insertScaling(e[[i]], sca)
5: apollo_insertScaling(e[[i]], sca)
4: apollo_insertScaling(e[[3]], sca)
3: apollo_insertScaling(e[[i]], sca)
2: apollo_insertScaling(apollo_inputs$apollo_lcPars, apollo_inputs$apollo_scaling)
1: apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities,
apollo_inputs)