compatibility with apollo package function "apollo_modeloutput()"

[valmtoledo]

Hi I used apollo very often and it would be great if your package could help to make pretty tables for their output. It would be great if this can be added in the future! Thanks

[sagebiej]

Hey, I have written a small function that makes apollo models into texreg formats. This is certainly just a workaround, and a proper extract method would be much better, but it serves its purpose. It also allows you to get WTP tables, if you have a proper WTP object. Additionally, I have written a function that makes it easy to calculate WTP for all attributes.

Function to get it to texreg:

quicktexregapollo <- function(model =model, wtpest=NULL) {

  modelOutput_settings = list(printPVal=T) 

  if (is.null(wtpest)) {  estimated <- janitor::clean_names(as.data.frame(apollo_modelOutput(model, modelOutput_settings)))
  } else{
    estimated <- wtpest
    colnames(estimated)<- c("estimate", "rob_s_e", "robt", "p_1_sided_2")

  }

  coefnames <- gsub(pattern = "_[a-z]$", "" ,rownames(estimated))

  texout <- createTexreg(coef.names = coefnames , coef = estimated[["estimate"]] , se = estimated[["rob_s_e"]] , pvalues = estimated$p_1_sided_2,
                         gof.names = c("No Observations" , "No Respondents" , "Log Likelihood (Null)" , "Log Likelihood (Converged)") ,
                         gof = c(model[["nObsTot"]] , model[["nIndivs"]], model[["LL0"]][[1]] , model[["LLout"]][[1]] ) ,
                         gof.decimal = c(FALSE,FALSE,TRUE,TRUE)
  )

  return(texout)

}

You can use it like this

model_texreg <- quicktexregapollo(modelname)
texreg(model_texreg)

Function to get willingness to pay (WTP) values with standard errors, which can then be used with the function above to create WTP tables.

wtp <- function(cost, attr, modelname) {

  wtp_values =data.frame(wtp =numeric(), robse=numeric() , robt= numeric() ) 
  attr <- attr[-which(attr==cost)]

  for (a in attr) {

    deltaMethod_settings=list(operation="ratio", parName1=a, parName2=cost)
    wtp_values[which(attr==a),]<- apollo_deltaMethod(modelname, deltaMethod_settings)

  }
  wtp_values$wtp <- wtp_values$wtp*-1
  wtp_values$robse <- wtp_values$robse*1
  wtp_values$robt <- wtp_values$robt*-1
  wtp_values$pVal <- (1-pnorm((abs(wtp_values$robt))))*2

  rownames(wtp_values) <- attr
  return(wtp_values) 

}

WTP table can be created like this:

WTPvalues <- wtp(costparameter, c(att1, att2, att3, att4), modelname)

WTPtable <- quickapollotexreg(modelname, WTPvalues)

texreg(modelname, WTPtable)

If there is still interest, I can give more details and examples.