merged develjj with poetest exported

DESCRIPTION

 Package: choiceTools
 Type: Package
 Title: Various tools to work with choice experiment data in R
-Version: 0.3.0
+Version: 0.3.3
 Author: Julian Sagebiel
 Maintainer: Julian Sagebiel <julian.sagebiel@idiv.de>
 Description: This is a random set of functions that make your life as a choice modeller easier. Some functions are made for use with apollo so that you can more easily do choice modelling in apollo. The package includes some tests like Poetest and zTest and some functions to generate publication-ready tables.

NAMESPACE

@@ -2,6 +2,7 @@
 
 export("%>%")
 export(createSets)
+export(poetest)
 export(quicktexregapollo)
 export(remGOF)
 export(subcoef)

R/poetest.R

-
-
-## Extract relevant elements of models
-
-takedraws <-function(n=10000, beta,vc) {
-
-
-  k=length(beta)
-  cholesky = chol(vc)
-
-  draw=matrix(nrow = n, ncol=k)
-
-  colnames(draw) <-names(beta)
-
-  for (d in 1:n) {
-    draw[d,] <- beta +t(cholesky)%*%stats::rnorm(k)
+# This function lets us perform the Poe (2005) test on WTP values
+
+
+#' Perform the Poe (2005) test on different discrete choice models
+#'
+#' @param n number of draws
+#' @param model1 Model from which to take the first WTP values
+#' @param model2 Model from which to take the second WTP values
+#' @param att Vector of attributes whose WTP values you want to compare
+#' @param price name of the price coefficient
+#' @param vcov which variance-covariance matrix to use. Either normal for the normal one, or rob for the robust one.
+#'
+#' @return a p value associated with "WTP1>WTP2"
+#' @export
+#'
+#' @examples \dontrun{
+#' poeresults<-poetest(n=5000, model1 = clmodels[[model_1]],model2 = clmodels[[model_2]],
+#'  att=attr, price = "bcost", vcov = "normal")
+#' }
+poetest <- function(n, model1, model2, att, price, vcov){
+  
+  #stop command for invalid variance covariance matrix
+  if (!vcov %in% c("rob", "normal")) {
+    stop("Invalid value for 'vcov'. Please use one of 'rob' or 'normal'.")
   }
-
-
-
-  return(draw)
-}
-
-
-getalldraws <- function(n, model1, model2, att, price) {
-
-  allmodels <- list(model1,model2)
-
-  model_draws <- list()
-
-  for (m in 1:2) {
-
-  model_draws[[m]] <-takedraws(n,allmodels[[m]][["estimate"]],allmodels[[m]][["varcov"]])
-
-  model_draws[[m]] <-cbind(model_draws[[m]], wtp= model_draws[[m]][,att]/model_draws[[m]][,price])
-     }
-
-  return(model_draws)
+  
+  ## Extract relevant elements of models
+  
+  takedraws <-function(n=10000, beta,vc) {
+    
+    
+    k=length(beta)
+    cholesky = chol(vc)
+    
+    draw=matrix(nrow = n, ncol=k)
+    
+    colnames(draw) <-names(beta)
+    
+    for (d in 1:n) {
+      draw[d,] <- beta +t(cholesky)%*%stats::rnorm(k)
+    }
+    
+    
+    
+    return(draw)
   }
+  
+  getalldraws <- function(n, model1, model2, att, price, vcov) {
+    
+    allmodels <- list(model1,model2)
+    
+    model_draws <- list()
+    
+    for (m in 1:2) {
+      
+      #implement the option to choose between the robust or the normal variance covariance matrix
+      varcov_matrix <- switch(vcov,
+                              rob = allmodels[[m]][["robvarcov"]],
+                              normal = allmodels[[m]][["varcov"]],
+                              stop("Invalid value for 'vcov'. Please use one of 'rob' or 'normal'.")
+      )
+      
+      model_draws[[m]] <-takedraws(n,allmodels[[m]][["estimate"]],varcov_matrix)
+      
+      model_draws[[m]] <-cbind(model_draws[[m]], wtp= model_draws[[m]][,att]/model_draws[[m]][,price])
+    }
+    
+    return(model_draws)
+  }
+  
+  
+  draws<-getalldraws(n, model1, model2, att, price, vcov)
 
-poetest <- function(n, model1, model2, att, price){
-
-draws<-getalldraws(n, model1, model2, att, price)
-
-wtpvec <- cbind(wtp1= draws[[1]][,"wtp"], wtp2= draws[[2]][,"wtp"])
+  wtpvec <- cbind(wtp1= draws[[1]][,"wtp"], wtp2= draws[[2]][,"wtp"])
 
 
 

R/quicktexregapollo.R

@@ -17,9 +17,9 @@ quicktexregapollo <- function(model = model, wtpest = NULL, se="rob") {
     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 (!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)) {

man/poetest.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/poetest.R
+\name{poetest}
+\alias{poetest}
+\title{Perform the Poe (2005) test on different discrete choice models}
+\usage{
+poetest(n, model1, model2, att, price, vcov)
+}
+\arguments{
+\item{n}{number of draws}
+
+\item{model1}{Model from which to take the first WTP values}
+
+\item{model2}{Model from which to take the second WTP values}
+
+\item{att}{Vector of attributes whose WTP values you want to compare}
+
+\item{price}{name of the price coefficient}
+
+\item{vcov}{which variance-covariance matrix to use. Either normal for the normal one, or rob for the robust one.}
+}
+\value{
+a p value associated with "WTP1>WTP2"
+}
+\description{
+Perform the Poe (2005) test on different discrete choice models
+}
+\examples{
+\dontrun{
+poeresults<-poetest(n=5000, model1 = clmodels[[model_1]],model2 = clmodels[[model_2]],
+ att=attr, price = "bcost", vcov = "normal")
+}
+}