Skip to content
Snippets Groups Projects
Commit 7d27f59a authored by dj44vuri's avatar dj44vuri
Browse files

improved quicktexregapollo and added tests and functionality

parent 243baaa8
Branches
No related tags found
No related merge requests found
...@@ -4,18 +4,55 @@ ...@@ -4,18 +4,55 @@
#' Make your apollo object readable with texreg #' Make your apollo object readable with texreg
#' #'
#' @param model the name of the apollo model object #' @param model the name of the apollo model object
#' @param wtpest if you want to display wtp instead of beta coefficients provide a dataframe with the wtp values and standard errors #' @param wtpest if you want to display wtp instead of beta coefficients provide a data.frame with the wtp values and standard errors
#' @param se Which standard errors should be used. Either rob for robust, normal for normal standard error or bs for bootstrapped standard errors.
#' #'
#' @return a list opject for texreg #' @return a list object to be easily used in texreg. It makes it easy to create tables usind different standard errors (including robust and bootstrapped) and to display WTP instead of beta coefficients.
#' @export #' @export
#' #'
#' @examples #' @examples \dontrun{quicktexregapollo(model1)}
quicktexregapollo <- function(model = model, wtpest = NULL, se="rob") { quicktexregapollo <- function(model = model, wtpest = NULL, se="rob") {
if (!se %in% c("rob", "normal", "bs")) {
stop("Invalid value for 'se'. Please use one of 'rob', 'normal', or 'bs'.")
}
if (!all(c("apollo", "maxLik", "maxim") %in% class(model))) {
stop("Invalid model class. The model must be of classes 'apollo', 'maxLik', and 'maxim'.")
}
if (se == "bs" && !"bootse" %in% names(model)) {
stop(" It seems you did not do bootstrapping. Thus, I cannot report bootstrapped se. The 'model' object must contain an element named 'bootse' when 'se' is 'bs'.")
}
browser()
modelOutput_settings = list(printPVal=T) modelOutput_settings = list(printPVal=T)
if (is.null(wtpest)) { estimated <- janitor::clean_names(as.data.frame(apollo_modelOutput(model, modelOutput_settings))) if (is.null(wtpest)) {
} else{
estimated <- janitor::clean_names(as.data.frame(apollo::apollo_modelOutput(model, modelOutput_settings)))
switch(se,
rob = { estimated$se <- estimated$rob_s_e
estimated$pv <- estimated$p_1_sided_2
},
bs = {
estimated$se <- estimated$bootstrap_s_e
estimated$pv <- estimated$p_1_sided_3
},
normal = {
estimated$se <- estimated$s_e
estimated$pv <- estimated$p_1_sided
},
{
# Default case if no match is found
stop("Invalid value for 'se'. Please use a valid value.")
}
)
} else{
estimated <- wtpest estimated <- wtpest
colnames(estimated)<- c("estimate", "rob_s_e", "robt", "p_1_sided_2") colnames(estimated)<- c("estimate", "rob_s_e", "robt", "p_1_sided_2")
...@@ -24,9 +61,10 @@ quicktexregapollo <- function(model = model, wtpest = NULL, se="rob") { ...@@ -24,9 +61,10 @@ quicktexregapollo <- function(model = model, wtpest = NULL, se="rob") {
coefnames <- gsub(pattern = "_[a-z]$", "" ,rownames(estimated)) coefnames <- gsub(pattern = "_[a-z]$", "" ,rownames(estimated))
texout <- texreg::createTexreg(coef.names = coefnames , coef = estimated[["estimate"]] , se = estimated[["rob_s_e"]] , pvalues = estimated$p_1_sided_2, texout <- texreg::createTexreg(coef.names = coefnames , coef = estimated[["estimate"]] , se = estimated[["se"]] , pvalues = estimated$pv,
gof.names = c("No Observations" , "No Respondents" , "Log Likelihood (Null)" , "Log Likelihood (Converged)") , 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 = c(model[["nObsTot"]] , model[["nIndivs"]], model[["LL0"]][[1]] , model[["LLout"]][[1]] ) ,
gof.decimal = c(FALSE,FALSE,TRUE,TRUE) gof.decimal = c(FALSE,FALSE,TRUE,TRUE)
......
File added
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/quicktexregapollo.R
\name{quicktexregapollo}
\alias{quicktexregapollo}
\title{Make your apollo object readable with texreg}
\usage{
quicktexregapollo(model = model, wtpest = NULL, se = "rob")
}
\arguments{
\item{model}{the name of the apollo model object}
\item{wtpest}{if you want to display wtp instead of beta coefficients provide a data.frame with the wtp values and standard errors}
\item{se}{Which standard errors should be used. Either rob for robust, normal for normal standard error or bs for bootstrapped standard errors.}
}
\value{
a list object to be easily used in texreg. It makes it easy to create tables usind different standard errors (including robust and bootstrapped) and to display WTP instead of beta coefficients.
}
\description{
Make your apollo object readable with texreg
}
\examples{
\dontrun{quicktexregapollo(model1)}
}
rm(list = ls())
devtools::load_all()
model_path <- system.file("extdata", "mixlogitInt_bootstrap.RDS", package = "choiceTools")
est_model <- readRDS(model_path)
different_se <-list()
different_se[["normalse"]] <- quicktexregapollo(est_model, se="normal")
different_se[["robustse"]] <- quicktexregapollo(est_model, se="rob")
different_se[["bootstrapse"]] <- quicktexregapollo(est_model, se="bs")
texreg::screenreg(different_se)
janitor::clean_names(apollo::apollo_modelOutput(est_model))
# This file is part of the standard setup for testthat.
# It is recommended that you do not modify it.
#
# Where should you do additional test configuration?
# Learn more about the roles of various files in:
# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
# * https://testthat.r-lib.org/articles/special-files.html
library(testthat)
library(choiceTools)
test_check("choiceTools")
test_that("quicktexregapollo function handles invalid model class", {
invalid_model <- list()
class(invalid_model) <- c("invalidClass")
expect_error(
quicktexregapollo(model = invalid_model, se = "rob"),
"Invalid model class. The model must be of classes 'apollo', 'maxLik', and 'maxim'."
)
})
test_that("quicktexregapollo function handles invalid 'se' argument", {
model_path <- system.file("extdata", "mixlogitInt_bootstrap.RDS", package = "choiceTools")
est_model <- readRDS(model_path)
expect_error(
quicktexregapollo(model = est_model, se = "invalid"),
"Invalid value for 'se'. Please use one of 'rob', 'normal', or 'bs'."
)
})
test_that("quicktexregapollo function checks for 'bootse' element when se is 'bs'", {
model_path <- system.file("extdata", "mixlogitInt_bootstrap.RDS", package = "choiceTools")
est_model <- readRDS(model_path)
est_model$bootse <- NULL # Remove 'bootse' element
expect_error(
quicktexregapollo(model = est_model, se = "bs"),
"It seems you did not do bootstrapping. Thus, I cannot report bootstrapped se. The 'model' object must contain an element named 'bootse' when 'se' is 'bs'."
)
})
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment