fixed bug in rowsum() where the default argument was reorder = TRUE

Author: jhelvy

NEWS.md

@@ -1,15 +1,10 @@
 # logitr 0.1.2.9000
 
-## Summary of larger updates:
-
-
-## Summary of smaller updates:
-
-
 ## Bugs
 
 - Fixed bug where model with single variable would error due to a matrix being converted to a vector in the `standardDraws()` function
 - Fixed bug in `getCatVarDummyNames()` - previously used string matching, which can accidentally match with other similarly-named variables.
+- Fixed bug in `rowsum()` where the `reorder` argument was set to `TRUE`, which resulted in wrong logit calculations unless the `obsID` happened to be already sorted.
 
 # logitr 0.1.1
 

R/logit.R

@@ -21,7 +21,7 @@
 # Returns the logit fraction for mnl (homogeneous) models
 getMnlLogit <- function(V, obsID) {
   expV <- exp(V)
-  sumExpV <- rowsum(expV, group = obsID)
+  sumExpV <- rowsum(expV, group = obsID, reorder = FALSE)
   repTimes <- as.numeric(table(obsID))
   sumExpVMat <- matrix(rep(sumExpV, times = repTimes), ncol = 1)
   logit <- expV / sumExpVMat
@@ -90,7 +90,7 @@ getMnlHessLL <- function(pars, modelInputs) {
 getMxlLogit <- function(VDraws, obsID) {
   numDraws <- ncol(VDraws)
   expVDraws <- exp(VDraws)
-  sumExpVDraws <- rowsum(expVDraws, group = obsID)
+  sumExpVDraws <- rowsum(expVDraws, group = obsID, reorder = FALSE)
   repTimes <- rep(as.numeric(table(obsID)), each = numDraws)
   sumExpVDrawsMat <- matrix(rep(sumExpVDraws, times = repTimes),
     ncol = numDraws, byrow = FALSE
@@ -283,7 +283,7 @@ mxlNegGradLL_pref <- function(X, parSetup, obsID, choice, standardDraws,
     partial_mu <- Xtemp
     partial_sigma <- Xtemp * drawsMat
     partial <- cbind(partial_mu, partial_sigma)
-    temp <- rowsum(logitMat * partial, group = obsID)
+    temp <- rowsum(logitMat * partial, group = obsID, reorder = FALSE)
     tempMat <- matrix(rep(temp, times = repTimes),
       ncol = ncol(partial),
       byrow = F
@@ -426,7 +426,7 @@ mxlNegGradLL_wtp <- function(X, parSetup, obsID, choice, standardDraws,
     partial_mu <- cbind(lambda_partial_mu, gamma_partial_mu)
     partial_sigma <- cbind(lambda_partial_sigma, gamma_partial_sigma)
     partial <- cbind(partial_mu, partial_sigma)
-    temp <- rowsum(logitMat * partial, group = obsID)
+    temp <- rowsum(logitMat * partial, group = obsID, reorder = FALSE)
     tempMat <- matrix(rep(temp, times = repTimes),
       ncol = ncol(partial),
       byrow = F

foo.R

@@ -0,0 +1,61 @@
+
+library(logitr)
+library(tidyverse)
+
+obsIDs <- unique(yogurt$obsID)
+newIDs1 <- sample(seq(3000), length(obsIDs), replace = FALSE)
+
+yogurt_new <- yogurt %>%
+  left_join(
+    data.frame(
+      obsID = obsIDs,
+      newIDs = newIDs1
+    ), by = "obsID"
+  )
+
+model <- logitr(
+  data       = yogurt,
+  choiceName = 'choice',
+  obsIDName  = 'obsID',
+  parNames   = c('price', 'feat', 'hiland', 'yoplait', 'dannon')
+)
+
+model_new1 <- logitr(
+  data       = yogurt_new,
+  choiceName = 'choice',
+  obsIDName  = 'newIDs',
+  parNames   = c('price', 'feat', 'hiland', 'yoplait', 'dannon')
+)
+
+model_new2 <- logitr(
+  data       = yogurt_new %>% arrange(newIDs),
+  choiceName = 'choice',
+  obsIDName  = 'newIDs',
+  parNames   = c('price', 'feat', 'hiland', 'yoplait', 'dannon')
+)
+
+summary(model)
+summary(model_new1)
+summary(model_new2)
+
+cbind(coef(model), coef(model_new1), coef(model_new2))
+
+
+
+
+
+devtools::load_all()
+
+data       = yogurt_new1
+choiceName = 'choice'
+obsIDName  = 'newIDs'
+parNames   = c('price', 'feat', 'hiland', 'yoplait', 'dannon')
+priceName = NULL
+randPars = NULL
+randPrice = NULL
+modelSpace = "pref"
+weightsName = NULL
+options = list()
+
+
+

inst/CITATION

@@ -5,7 +5,7 @@ citEntry(
   title    = "logitr: Random Utility Logit Models with Preference and Willingness to Pay Space Parameterizations",
   author   = "John Paul Helveston",
   year     = "2020",
-  note     = "R package version 0.1.0",
+  note     = "R package version 0.1.2",
   url      = "https://jhelvy.github.io/logitr/",
-  textVersion = "John Paul Helveston (2021). logitr: Random utility logit models with preference and willingness to pay space parameterizations. R package version 0.1.0."
+  textVersion = "John Paul Helveston (2021). logitr: Random utility logit models with preference and willingness to pay space parameterizations. R package version 0.1.2."
 )