From dd26978f2d53cd18b70474cceaae8e073a8ae04e Mon Sep 17 00:00:00 2001
From: John Helveston <john.helveston@gmail.com>
Date: Fri, 19 Mar 2021 13:46:14 -0400
Subject: [PATCH] fixed bug in rowsum() where the default argument was reorder
 = TRUE

---
 NEWS.md       |  7 +-----
 R/logit.R     |  8 +++----
 foo.R         | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++
 inst/CITATION |  4 ++--
 4 files changed, 68 insertions(+), 12 deletions(-)
 create mode 100644 foo.R

diff --git a/NEWS.md b/NEWS.md
index c2182627..42acdf49 100644
--- a/NEWS.md
+++ b/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
 
diff --git a/R/logit.R b/R/logit.R
index f1225ccc..562d2afd 100644
--- a/R/logit.R
+++ b/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
diff --git a/foo.R b/foo.R
new file mode 100644
index 00000000..fdf7042c
--- /dev/null
+++ b/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()
+
+
+
diff --git a/inst/CITATION b/inst/CITATION
index 7a199da0..f88a0072 100644
--- a/inst/CITATION
+++ b/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."
 )