ApolloChoiceModelling forum

Hello,
I need help with the specification of my model. I would like to analyze my data by age groups, gender, income and area character (Gebietstyp). However, I need help to integrate them in the code. So far I have always received errors.

I already tried to integrate the age. Alter = age

Can you please help me to find the problem?

Thank you very much,

Nina

choiceAnalysis_settings <- list(
alternatives = c(altA=1, altB=2, statusquo=3),
avail = list(altA = 1, altB = 1, statusquo = 1),
choiceVar = database$choice,
explanators = database[, c("Gebietstyp")]
)
apollo_choiceAnalysis(choiceAnalysis_settings, apollo_control, database)

## Parameter
apollo_beta <- c(
b10 = 0,
b11 = 0,
b12 = 0,
b10_shift_Alter = 0,
b11_shift_Alter = 0,
b12_shift_Alter = 0,
b20 = 0,
b21 = 0,
b22 = 0,
b23 = 0,
b20_shift_Alter = 0,
b21_shift_Alter = 0,
b22_shift_Alter = 0,
b23_shift_Alter = 0,
b30 = 0,
b30_shift_Alter = 0,
b40 = 0,
b41 = 0,
b42 = 0,
b40_shift_Alter = 0,
b41_shift_Alter = 0,
b42_shift_Alter = 0,
b50 = 0,
b50_shift_Alter = 0,
b60 = 0)
apollo_fixed = c("b12", "b23", "b42")

apollo_inputs <- apollo_validateInputs()


apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality="estimate"){
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))


## Modell
P <- list()

b10_value = b10 + b10_shift_Alter * Alter
b11_value = b11 + b11_shift_Alter * Alter
b12_value = b12 + b12_shift_Alter * Alter
b20_value = b20 + b20_shift_Alter * Alter
b21_value = b21 + b21_shift_Alter * Alter
b22_value = b22 + b22_shift_Alter * Alter
b23_value = b23 + b23_shift_Alter * Alter
b30_value = b30 + b30_shift_Alter * Alter
b40_value = b40 + b40_shift_Alter * Alter
b41_value = b41 + b41_shift_Alter * Alter
b42_value = b42 + b42_shift_Alter * Alter
b50_value = b50 + b50_shift_Alter * Alter


V <- list()
V[["altA"]] = (b10_value*(Parkraumangebot_1==0) + b11_value*(Parkraumangebot_1==1) + b12_value*(Parkraumangebot_1==2) +
b20_value*(Alternativnutzung_1==0) + b21_value*(Alternativnutzung_1==1) + b22_value*(Alternativnutzung_1==2) + b23_value*(Alternativnutzung_1==3) +
b30_value*Entfernung_1 +
b40_value*(Verkehrsberuhigung_1==0) + b41_value*(Verkehrsberuhigung_1==1) + b42_value*(Verkehrsberuhigung_1==2) +
b50_value*(Stellplatzreduktion_1)
)
V[["altB"]] = (b10_value*(Parkraumangebot_2==0) + b11_value*(Parkraumangebot_2==1) + b12_value*(Parkraumangebot_2==2) +
b20_value*(Alternativnutzung_2==0) + b21_Value*(Alternativnutzung_2==1) + b22_value*(Alternativnutzung_2==2) + b23_value*(Alternativnutzung_2==3) +
b30_value*Entfernung_2 +
b40_value*(Verkehrsberuhigung_2==0) + b41_value*(Verkehrsberuhigung_2==1) + b42_value*(Verkehrsberuhigung_2==2) +
b50_value*(Stellplatzreduktion_2)
)
V[["statusquo"]] = b60

mnl_settings = list(
alternatives = c(altA = 1, altB = 2, statusquo = 3),
avail = 1,
choiceVar = choice,
V = V
)

P[["model"]] <- apollo_mnl(mnl_settings, functionality)
P <- apollo_panelProd(P, apollo_inputs, functionality)
P <- apollo_prepareProb(P, apollo_inputs, functionality)

return (P)
}

#### Modell Schaetzung
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
apollo_modelOutput(model, list(printPVal = TRUE))


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

apollo_saveOutput(model)




Error:
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
Error in apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, :
object 'apollo_inputs' not found
> apollo_modelOutput(model, list(printPVal = TRUE))
Error in apollo_modelOutput(model, list(printPVal = TRUE)) :
object 'model' not found

Hi

Can you please post your entire code? Also, it looks like the error message
is not the first error message you get as it can't find apollo_inputs so you likely have an error message earlier on to

Stephane

Hi Stephan,

thank you very much for your quick response.
My entire code ist:

rm(list = ls())

library(data.table)
library(gsubfn)
library(tidyverse)

modelData <- fread("daten_erhebung.csv", na ="NA")
modelData <- data.table(modelData)
modelData <- modelData[ , .(lfdn,
PkwFahrer,
PkwMitfahrer,
Carsharing,
Motorrad,
ÖV,
Fahrrad,
Fuß,
PkwVerf,
PkwimHH,
Garage,
EigStellpl,
Tiefgarage,
Anwohnerparkhaus,
Straßenraum,
Sonstiges,
DauerSuche,
EntfernungStellw,
Zufriedenheit,
Einordnung,
ProbAnzahlStell,
ProbAufenthalt,
ProbKfz,
ProbRadFuß,
ProbSonstiges,
KommSonstiges,
keineProb,
Stadttyp,
Gebietstyp,
cs1,
cs1pkw,
cs1carsharing,
cs2,
cs2pkw,
cs2carsharing,
cs3,
cs3pkw,
cs3carsharing,
cs4,
cs4pkw,
cs4carsharing,
cs5,
cs5pkw,
cs5carsharing,
cs6,
cs6pkw,
cs6carsharing,
cs7,
cs7pkw,
cs7carsharing,
cs8,
cs8pkw,
cs8carsharing,
cs9,
cs9pkw,
cs9carsharing,
v_91,
v_92,
v_93,
v_94,
v_95,
v_96,
v_97,
v_130,
v_123,
v_124,
v_125,
v_126,
v_129,
v_208,
v_209,
Alter,
Geschlecht,
Bildungsabschluss,
Erwerbstätigkeit,
Erwerbst_sonstiges,
AnzahlPimHH,
KinderimHH,
Einkommen,
Bundesland)]

attributlevel <- read.csv2("Attributlevel_Hauptbefragung.csv")
attributlevel <- data.table(attributlevel)
attributlevel <- attributlevel[, choice_situtation:= as.factor(Frage)]


#Interne testlaeufe ausfiltern

#modelData <- modelData[v_312 != -77]

#from wide to long

modelData <- melt(modelData, measure.vars = c("cs1",
"cs2",
"cs3",
"cs4",
"cs5",
"cs6",
"cs7",
"cs8",
"cs9"),
variable.name = "choice_situation", value.name = "choice")

modelData <- modelData[choice != -77]


modelData <- data.table(modelData)


modelData[ , choice_situation_int := as.integer(ifelse(choice_situation == "cs1" , 1,
ifelse(choice_situation == "cs2" , 2,
ifelse(choice_situation == "cs3" , 3,
ifelse(choice_situation == "cs4" , 4,
ifelse(choice_situation == "cs5" , 5,
ifelse(choice_situation == "cs6" , 6,
ifelse(choice_situation == "cs7" , 7,
ifelse(choice_situation == "cs8" , 8,
ifelse(choice_situation == "cs9" , 9,0))))))))))]


modelData <- merge(modelData, attributlevel, by.x = c("choice_situation_int"), by.y = c("Frage"), all.x = TRUE)

write.csv(modelData, "daten_erhebung_prepared.csv")

###################################### Modelschätzung ############################################

library(apollo)
apollo_initialise()
apollo_control = list(
modelName ="MNL_heterogeneity_level_1",
modelDescr ="MNL model with socio-demographics on choice data",
indivID ="lfdn"
)
## Daten
database = read.csv("daten_erhebung.csv", header = TRUE)
database <- database %>% arrange(lfdn)
#database = subset(database,database$RP==1)


## Choice Analyse
choiceAnalysis_settings <- list(
alternatives = c(altA=1, altB=2, statusquo=3),
avail = list(altA = 1, altB = 1, statusquo = 1),
choiceVar = database$choice,
explanators = database[, c("Alter")]
)
apollo_choiceAnalysis(choiceAnalysis_settings, apollo_control, database)

## Parameter
apollo_beta <- c(
b10 = 0,
b11 = 0,
b12 = 0,
b10_shift_Alter = 0,
b11_shift_Alter = 0,
b12_shift_Alter = 0,
b20 = 0,
b21 = 0,
b22 = 0,
b23 = 0,
b20_shift_Alter = 0,
b21_shift_Alter = 0,
b22_shift_Alter = 0,
b23_shift_Alter = 0,
b30 = 0,
b30_shift_Alter = 0,
b40 = 0,
b41 = 0,
b42 = 0,
b40_shift_Alter = 0,
b41_shift_Alter = 0,
b42_shift_Alter = 0,
b50 = 0,
b50_shift_Alter = 0,
b60 = 0)
apollo_fixed = c("b12", "b23", "b42")

apollo_inputs <- apollo_validateInputs()

apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality="estimate"){
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))

## Modell
P <- list()

b10_value = b10 + b10_shift_Alter * Alter
b11_value = b11 + b11_shift_Alter * Alter
b12_value = b12 + b12_shift_Alter * Alter
b20_value = b20 + b20_shift_Alter * Alter
b21_value = b21 + b21_shift_Alter * Alter
b22_value = b22 + b22_shift_Alter * Alter
b23_value = b23 + b23_shift_Alter * Alter
b30_value = b30 + b30_shift_Alter * Alter
b40_value = b40 + b40_shift_Alter * Alter
b41_value = b41 + b41_shift_Alter * Alter
b42_value = b42 + b42_shift_Alter * Alter
b50_value = b50 + b50_shift_Alter * Alter


V <- list()
V[["altA"]] = (b10_value*(Parkraumangebot_1==0) + b11_value*(Parkraumangebot_1==1) + b12_value*(Parkraumangebot_1==2) +
b20_value*(Alternativnutzung_1==0) + b21_value*(Alternativnutzung_1==1) + b22_value*(Alternativnutzung_1==2) + b23_value*(Alternativnutzung_1==3) +
b30_value*Entfernung_1 +
b40_value*(Verkehrsberuhigung_1==0) + b41_value*(Verkehrsberuhigung_1==1) + b42_value*(Verkehrsberuhigung_1==2) +
b50_value*(Stellplatzreduktion_1)
)
V[["altB"]] = (b10_value*(Parkraumangebot_2==0) + b11_value*(Parkraumangebot_2==1) + b12_value*(Parkraumangebot_2==2) +
b20_value*(Alternativnutzung_2==0) + b21_Value*(Alternativnutzung_2==1) + b22_value*(Alternativnutzung_2==2) + b23_value*(Alternativnutzung_2==3) +
b30_value*Entfernung_2 +
b40_value*(Verkehrsberuhigung_2==0) + b41_value*(Verkehrsberuhigung_2==1) + b42_value*(Verkehrsberuhigung_2==2) +
b50_value*(Stellplatzreduktion_2)
)
V[["statusquo"]] = b60

mnl_settings = list(
alternatives = c(altA = 1, altB = 2, statusquo = 3),
avail = 1,
choiceVar = choice,
V = V
)

P[["model"]] <- apollo_mnl(mnl_settings, functionality)
P <- apollo_panelProd(P, apollo_inputs, functionality)
P <- apollo_prepareProb(P, apollo_inputs, functionality)

return (P)
}

#### Modell Schaetzung
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
apollo_modelOutput(model, list(printPVal = TRUE))


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

apollo_saveOutput(model)

Hi

so what happens if you run this in segments, i.e. do you get errors already after
or after
Stephane

I get this error after > apollo_inputs <- apollo_validateInputs()

Error in do.call("cbind", lapply(x, "is.na")) :
variable names are limited to 10000 bytes

How can I solve this Error?

Best regards,
Nina

this is not a problem we've ever encountered before and would seem to have to do with your data. Are you able to share your files with me via e-mail and I'll look into it for you

Thank you very much for your offer to view my data.
I just send you my data via email

It looks like this issue arise as the names in the header where not separated into individual names when the file was being read in by R.

Nina

related to my earlier comment about column names, what do you see if you use

colnames(database)

after reading in your database?

Thanks

Stephane