Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

compatibility with apollo package function "apollo_modeloutput()" #179

Open
valmtoledo opened this issue May 7, 2021 · 1 comment
Open

Comments

@valmtoledo
Copy link

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
Copy link

sagebiej commented Jan 6, 2022

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

3 participants