really fix 'match_response'

paul-buerkner · Apr 18, 2016 · 6ef6d78 · 6ef6d78
1 parent ebb5ca4
commit 6ef6d78
Showing 1 changed file with 7 additions and 3 deletions.
diff --git a/R/brmsfit-helpers.R b/R/brmsfit-helpers.R
@@ -536,9 +536,13 @@ match_response <- function(models) {
     # Args:
     #   x, y: named lists as returned by standata
     to_match <- c("Y", "se", "weights", "cens", "trunc")
-    all(ulapply(to_match, function(v) 
-      is_equal(as.vector(x[[v]])[attr(x, "old_order")], 
-               as.vector(y[[v]])[attr(y, "old_order")])))
+    all(ulapply(to_match, function(v) {
+      a <- if (is.null(attr(x, "old_order"))) as.vector(x[[v]])
+           else as.vector(x[[v]])[attr(x, "old_order")]
+      b <- if (is.null(attr(y, "old_order"))) as.vector(y[[v]])
+           else as.vector(y[[v]])[attr(y, "old_order")]
+      is_equal(a, b)
+    }))
   } 
   standatas <- lapply(models, standata, control = list(save_order = TRUE))
   matches <- ulapply(standatas[-1], .match_fun, y = standatas[[1]])