Error when running Mixed Logit model in Apollo

[Nang]

Hello everyone,
I am trying to estimate a Mixed Logit model in Apollo. My MNL models run smoothly, but when I switch to Mixed Logit I get the following error:

Error in test && (as.character(e[[3]][[1]]) %in% c("apollo_mnl", "apollo_el", :
'length = 3' in coercion to 'logical(1)'.


I use the following code for analyse:

database <- choice_socio
# ============================================================
# 03_RPL_main_FIXED.R — Model only (no MWTP)
# Env attrs random (Normal); payments & interactions fixed; 2000 Sobol
# ============================================================

## 0) Clean + load Apollo + guard against any 'test' collisions
rm(list = setdiff(ls(), "choice_socio")); gc()
suppressPackageStartupMessages(library(apollo))
if ("test" %in% names(choice_socio)) choice_socio$test <- NULL
if (exists("test", envir = .GlobalEnv, inherits = FALSE)) rm("test", envir = .GlobalEnv)

## 1) Ensure choice (from choice1/2/3)
if (!("choice" %in% names(choice_socio))) {
stopifnot(all(c("choice1","choice2","choice3") %in% names(choice_socio)))
choice_socio$choice <- 1L*(choice_socio$choice1==1) +
2L*(choice_socio$choice2==1) +
3L*(choice_socio$choice3==1)
}

## 2) Apollo init + control
apollo_initialise()
database <- choice_socio
apollo_control <- list(
modelName = "RPL_effCont_interactions_moneyk_2000D",
modelDescr = "RPL: env random (Normal); payments & interactions fixed; 2000 Sobol",
indivID = "id",
panelData = TRUE,
mixing = TRUE,
nCores = 7
)

## 3) Draws (2000 Sobol)
apollo_draws <- list(
interDrawsType = "sobol",
interNDraws = 2000,
interNormDraws = c("d_wq_md","d_wq_lg","d_cul","d_fg","d_bio")
)

## 4) Parameters
apollo_beta <- c(
asc_sq = 0,
b_wq_md_mean = 0, b_wq_md_sd = 0.5,
b_wq_lg_mean = 0, b_wq_lg_sd = 0.5,
b_cul_mean = 0, b_cul_sd = 0.5,
b_fg_mean = 0, b_fg_sd = 0.5,
b_bio_mean = 0, b_bio_sd = 0.5,
b_time = 0, b_moneyk = 0,
b_only_time = 0, b_only_money = 0,
b_time_occ = 0,
b_moneyk_female = 0,
b_moneyk_inc_q2 = 0, b_moneyk_inc_q3 = 0, b_moneyk_inc_q4 = 0
)
apollo_fixed <- c()

## 5) Random coefficients (explicit named list + return)
apollo_randCoeff <- function(apollo_beta, apollo_inputs){
randCoeff <- list()
randCoeff[["b_wq_md"]] <- b_wq_md_mean + b_wq_md_sd * d_wq_md
randCoeff[["b_wq_lg"]] <- b_wq_lg_mean + b_wq_lg_sd * d_wq_lg
randCoeff[["b_cul"]] <- b_cul_mean + b_cul_sd * d_cul
randCoeff[["b_fg"]] <- b_fg_mean + b_fg_sd * d_fg
randCoeff[["b_bio"]] <- b_bio_mean + b_bio_sd * d_bio
return(randCoeff)
}

## 6) Likelihood (single-component pipeline; no list wrapper)
apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality = "estimate"){
apollo_attach(apollo_beta, apollo_inputs); on.exit(apollo_detach(apollo_inputs), add=TRUE)
rcoefs <- apollo_inputs$apollo_randCoeff(apollo_beta, apollo_inputs)

# interactions per alt (wide)
time_occ_1 <- time1*occ_lake; time_occ_2 <- time2*occ_lake; time_occ_3 <- time3*occ_lake
money_f_1 <- money1_k*female; money_f_2 <- money2_k*female; money_f_3 <- money3_k*female
money_q2_1 <- money1_k*inc_q2; money_q2_2<- money2_k*inc_q2; money_q2_3<- money3_k*inc_q2
money_q3_1 <- money1_k*inc_q3; money_q3_2<- money2_k*inc_q3; money_q3_3<- money3_k*inc_q3
money_q4_1 <- money1_k*inc_q4; money_q4_2<- money2_k*inc_q4; money_q4_3<- money3_k*inc_q4

V <- list(
alt1 = rcoefs$b_wq_md*wq_md_eff1 + rcoefs$b_wq_lg*wq_lg_eff1 + rcoefs$b_cul*cul_imp_eff1 +
rcoefs$b_fg*fg_cont1 + rcoefs$b_bio*bio_cont1 +
b_time*time1 + b_moneyk*money1_k +
b_only_time*only_time1 + b_only_money*only_money1 +
b_time_occ*time_occ_1 + b_moneyk_female*money_f_1 +
b_moneyk_inc_q2*money_q2_1 + b_moneyk_inc_q3*money_q3_1 + b_moneyk_inc_q4*money_q4_1,
alt2 = rcoefs$b_wq_md*wq_md_eff2 + rcoefs$b_wq_lg*wq_lg_eff2 + rcoefs$b_cul*cul_imp_eff2 +
rcoefs$b_fg*fg_cont2 + rcoefs$b_bio*bio_cont2 +
b_time*time2 + b_moneyk*money2_k +
b_only_time*only_time2 + b_only_money*only_money2 +
b_time_occ*time_occ_2 + b_moneyk_female*money_f_2 +
b_moneyk_inc_q2*money_q2_2 + b_moneyk_inc_q3*money_q3_2 + b_moneyk_inc_q4*money_q4_2,
sq = asc_sq +
rcoefs$b_wq_md*wq_md_eff3 + rcoefs$b_wq_lg*wq_lg_eff3 + rcoefs$b_cul*cul_imp_eff3 +
rcoefs$b_fg*fg_cont3 + rcoefs$b_bio*bio_cont3 +
b_time*time3 + b_moneyk*money3_k +
b_only_time*only_time3 + b_only_money*only_money3 +
b_time_occ*time_occ_3 + b_moneyk_female*money_f_3 +
b_moneyk_inc_q2*money_q2_3 + b_moneyk_inc_q3*money_q3_3 + b_moneyk_inc_q4*money_q4_3
)

mnl_settings <- list(
alternatives = c(alt1=1, alt2=2, sq=3),
avail = c(alt1=1, alt2=1, sq=1),
choiceVar = choice,
V = V
)

# === single-component pipeline ===
P <- apollo_mnl(mnl_settings, functionality)
P <- apollo_panelProd(P, apollo_inputs, functionality)
if (isTRUE(apollo_inputs$apollo_control$mixing)) {
P <- apollo_avgInterDraws(P, apollo_inputs, functionality)
}
P <- apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}

## 7) Validate & estimate
apollo_inputs <- apollo_validateInputs()
model_rpl <- apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)

## 8) Output (model only)
invisible(try(apollo_modelOutput(model_rpl), silent = TRUE))
invisible(try(apollo_saveOutput(model_rpl), silent = TRUE))


Thank you very much in advance.

[stephanehess]

Hi

1. which version of Apollo are you using?
2. the code is not standard, where did you get it from. E.g. you should not need this:

rcoefs <- apollo_inputs$apollo_randCoeff(apollo_beta, apollo_inputs)

Stephane

[Nang]

Hi Stephane

Thank you very much for the quick response.
I’m using Apollo version 0.3.5.
I realise now that my earlier script had a non-standard line. I was troubleshooting and mixed in pieces from older scripts.

It looks like the problem was related to stray objects and column creation in the global environment.

After I:
standardised money scaling (money1_k, money2_k, money3_k),
ensured only_time{1:3} and only_money{1:3} dummies exist, and
cleaned the global environment so no conflicting names remained,
the Mixed Logit ran fine.

For completeness, here’s a minimal working example I’m running now (wide data; environmental attributes random ~ Normal; payments fixed). If you notice anything non-standard, I’d appreciate any pointers. I suspect I may still have a few extra lines (e.g., some global-environment checks). I’m now extending the analysis to include interaction terms and increasing the number of draws.

Thank you very much for your kind guidance.
With best regards,
Nang

choice_socio <- choice_wide_with_socio
database <-choice_socio
# ---- Payment dummies: ensure columns exist (0 if missing) ----
for (nm in c(paste0("only_time",1:3), paste0("only_money",1:3))) {
if (!nm %in% names(database)) database[[nm]] <- 0L
}
# =========================
# Apollo Random Parameters Logit
# =========================
library(apollo)
apollo_initialise()

# ---- Load Data____
# database <-choice_wide_with_socio
stopifnot(exists("database"))

# ---- Reserve parameter names & purge collisions ----
param_names <- c(
"asc_sq","b_wq_md_mean","b_wq_md_sd","b_wq_lg_mean","b_wq_lg_sd",
"b_cul_mean","b_cul_sd","b_fg_mean","b_fg_sd","b_bio_mean","b_bio_sd",
"b_time","b_moneyk","b_only_money","b_only_time"
)
to_rm <- intersect(ls(envir = .GlobalEnv), param_names)
if (length(to_rm)) rm(list = to_rm, envir = .GlobalEnv)

# ---- Correct money scaling ----

mx <- max(database$money1, database$money2, database$money3, na.rm = TRUE)
for (i in 1:3) {
src <- paste0("money", i)
dst <- paste0("money", i, "k")
if (mx > 100) {
database[[dst]] <- database[[src]]/1000
} else {
database[[dst]] <- database[[src]]
}
}

# safe to check column name
if ("b_moneyk" %in% names(database)) stop("Rename column 'b_moneyk' in your data.")

database$choice <- as.integer(database$choice)
database$id <- as.integer(database$id)

###########################
# Drop rows with any NA in needed vars
vars_needed <- c("id","choice",
paste0("wq_md_eff",1:3), paste0("wq_lg_eff",1:3), paste0("cul_imp_eff",1:3),
paste0("fg_cont",1:3), paste0("bio_cont",1:3),
paste0("time",1:3), paste0("money",1:3,"k"),
paste0("only_time",1:3), paste0("only_money",1:3)
)

database <- database[complete.cases(database[, vars_needed]), ]
# ---- Control ----
out_dir <- file.path(getwd(), "apollo_out_RPL_moneyPer1k")
if (!dir.exists(out_dir)) dir.create(out_dir, recursive = TRUE)

apollo_control <- list(
modelName = "RPL_env_payments_Fixed_payment dummies",
modelDescr = "RPL with env attrs random (normal); time fixed; payment dummies",
indivID = "id",
panelData = TRUE,
mixing = TRUE,
nCores = 7,
outputDirectory = out_dir,
seed = 12345
)

# ---- Draws ----
apollo_draws <- list(
interDrawsType = "halton",
interNDraws = 1000,
interNormDraws = c("d_wq_md","d_wq_lg","d_cul","d_fg","d_bio")
)


# ---- Parameters ----
apollo_beta <- c(
asc_sq = 0,
b_wq_md_mean = 0, b_wq_md_sd = 0.1,
b_wq_lg_mean = 0, b_wq_lg_sd = 0.1,
b_cul_mean = 0, b_cul_sd = 0.1,
b_fg_mean = 0, b_fg_sd = 0.1,
b_bio_mean = 0, b_bio_sd = 0.1,
b_time = 0,
b_moneyk = 0,
b_only_time = 0, # <— new
b_only_money = 0 # <— new
)
apollo_fixed <- c()


# ---- Random coeffs ----
apollo_randCoeff <- function(apollo_beta, apollo_inputs){
b <- as.list(apollo_beta)
list(
b_wq_md = b$b_wq_md_mean + b$b_wq_md_sd * d_wq_md,
b_wq_lg = b$b_wq_lg_mean + b$b_wq_lg_sd * d_wq_lg,
b_cul = b$b_cul_mean + b$b_cul_sd * d_cul,
b_fg = b$b_fg_mean + b$b_fg_sd * d_fg,
b_bio = b$b_bio_mean + b$b_bio_sd * d_bio
)
}

# ---- Validate ----

# Load Apollo
if (!requireNamespace("apollo", quietly = TRUE)) install.packages("apollo")
library(apollo)
apollo_initialise()

if ("apollo_validateInputs" %in% ls()) rm(apollo_validateInputs)
if ("apollo" %in% ls()) rm(apollo)

apollo_inputs <- apollo::apollo_validateInputs()


# ---- Probabilities ----
apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality="estimate"){
apollo_attach(apollo_beta, apollo_inputs); on.exit(apollo_detach(apollo_inputs), add=TRUE)

V <- list(
alt1 = b_wq_md*wq_md_eff1 + b_wq_lg*wq_lg_eff1 +
b_cul*cul_imp_eff1 + b_fg*fg_cont1 + b_bio*bio_cont1 +
b_time*time1 + b_moneyk*money1k +
b_only_time*only_time1 + b_only_money*only_money1,

alt2 = b_wq_md*wq_md_eff2 + b_wq_lg*wq_lg_eff2 +
b_cul*cul_imp_eff2 + b_fg*fg_cont2 + b_bio*bio_cont2 +
b_time*time2 + b_moneyk*money2k +
b_only_time*only_time2 + b_only_money*only_money2,

sq = asc_sq +
b_wq_md*wq_md_eff3 + b_wq_lg*wq_lg_eff3 +
b_cul*cul_imp_eff3 + b_fg*fg_cont3 + b_bio*bio_cont3 +
b_time*time3 + b_moneyk*money3k +
b_only_time*only_time3 + b_only_money*only_money3
)

mnl_settings <- list(
alternatives = c(alt1=1, alt2=2, sq=3),
avail = list(alt1=1, alt2=1, sq=1),
choiceVar = choice,
V = V
)

P <- list()
P[["model"]] <- apollo_mnl(mnl_settings, functionality)
P <- apollo_panelProd(P, apollo_inputs, functionality)
P <- apollo_avgInterDraws(P, apollo_inputs, functionality)
P <- apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ---- Estimate & Output ----
model_rpl <- apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
apollo_modelOutput(model_rpl)
apollo_saveOutput(model_rpl)
##############################################################################

[stephanehess]

can you share the code and data with me outside the forum and I'll have a look