R/estimateGremlinsModelHelperFunctions.R

In RGremlinsConjoint: Estimate the "Gremlins in the Data" Model for Conjoint Studies

#' Convert a Sawtooth Software generated design file to a dummy coded design
#' file
#'
#' Take a design file such as those generated by the Sawtooth Software
#' 'Lighthouse Studio' and convert it into a dummy coded design file.  The last
#' level in the attribute is considered the reference level and will be dropped.
#'
#' This function is written to not require converting columns to be factors. All
#' variables should be numeric indexes for the levels of the attributes. If you
#' would like to manually code a attribute of the design, for example if you
#' have a price variable, you must manually code that attribute and then can
#' call the function with the optional columns to code parameter.
#'
#' @seealso
#' /url{http://www.sawtoothsoftware.com/help/lighthouse-studio/manual/index.html?hid_web_cbc_exporting.html}
#'
#'
#' Documentation for the Sawtooth Software Design file format can be found at
#' @param sawtooth_design A matrix that contains the Sawtooth design.  Can be
#'   loaded with read.csv.
#' @param columns_to_code (Optional, Default = all columns) A vector listing the
#'   numeric index of the columns to code. Note: The first column is column 4
#'   due to the control variables
#' @param include_none_option (Optional, Default = FALSE) A boolean value
#'   indicating whether to expand the task to include a none option
#' @return A matrix object chat contains the dummy coded design file.  The last
#'   attribute is considered the reference level
#'
#' @export
#' @examples
#' \dontrun{
#'  # Read in the Sawtooth Formatted data
#'  design <- read.csv("Design.csv")
#'  prices = c(0.79, 1.29, 1.79, 2.29, 2.79)
#'  design$price <- prices[design$price]
#'  codedDesign <- codeSawtoothDesignFile(design, c(4:9))
#' }
#'
#'
code_sawtooth_design <- function(sawtooth_design, columns_to_code = c(4:ncol(sawtooth_design)), include_none_option=FALSE) {
  dummyCode <- function(column) {
    nLevels <- max(column)
    dummy_code <- diag(nLevels)
    dummy_code <- dummy_code[,-nLevels, drop=FALSE]
    result_columns <- dummy_code[column[[1]],, drop=FALSE]
    colnames(result_columns) <- paste0(names(column), 1:(nLevels - 1))
    result_columns
  }

  dummy_coded_columns = list()
  for(i in 1:ncol(sawtooth_design)) {
    if(i %in% columns_to_code ) {
      dummy_coded_columns[[i]] <- dummyCode(sawtooth_design[i])
    } else {
      dummy_coded_columns[[i]] <- sawtooth_design[i]
    }
  }

  coded_design <- do.call("cbind", dummy_coded_columns)
  if(include_none_option) {
    nVersions <- max(coded_design[,1])
    nScenarios <- max(coded_design[,2])
    nConcepts <- max(coded_design[,3])
    versions <- rep(1:nVersions, each=nScenarios)
    scenarios <- rep(1:nScenarios, times=nVersions)
    none_design <- cbind(versions, scenarios, nConcepts+1, matrix(0, ncol=ncol(coded_design) - 3, nrow =length(versions)))
    colnames(none_design) <- colnames(coded_design)
    coded_design <- rbind(coded_design, none_design)
    coded_design <- coded_design[order(coded_design[,1], coded_design[,2], coded_design[,3]),]
  }

  return(coded_design)
}

#' Convert 'RGremlinsConjoint' formatted Data to 'bayesm' format
#'
#' Converts a data file and a coded design file from the format expected by the
#' package to a format appropriate for estimation in 'bayesm'
#' \code{\link[bayesm]{rhierMnlRwMixture}}
#'
#' @param data The data.frame or matrix that contains the respondents answers
#' @param design The data.frame or matrix that contains the coded design
#'
#' @return lgtdata The list data structure for use with 'bayesm'
#'
#' @seealso \code{\link{code_sawtooth_design}}
#' @export
#' @examples
#' \dontrun{
#'  data <- read.csv("data.csv")
#'  design <- read.csv("design.csv")
#'  design <- code_sawtooth_design(design)
#'  convert_to_bayesm(data, design)
#' }
convert_to_bayesm <- function(data, design) {
  # lgtdata - a nResp list with
  # lgtdata[[i]]$y - a vector of respondent choices (1,..., p) of length nTasks
  # lgtdata[[i]]$x - a matrix design matrix for the ith unit
  nResp <- nrow(data)
  nTasks <- max(design[,2])
  nConcepts <- max(design[,3])

  lgtdata <- list()
  for(i in seq_len(nResp)) {
    versionNumber <- data[i,2]
    y <- c(unlist(data[i,-c(1,2)]))
    X <- subset(design, design[,1] == versionNumber)

    X <- as.matrix(X[,-c(1:3)])
    lgtdata[[i]] <- list(y = y, X = X)
  }

  list(lgtdata = lgtdata, p = nConcepts)
}