fix: Return grouped operations in the original order

Fixes #14
nathaneastwood · May 3, 2020 · 1d029c5 · 1d029c5
1 parent b62884b
commit 1d029c5
Show file tree

Hide file tree

Showing 9 changed files with 33 additions and 17 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: poorman
 Type: Package
 Title: A Poor Man's Base R Copy of 'dplyr' Verbs
-Version: 0.1.11.8
+Version: 0.1.11.9
 Authors@R: person("Nathan", "Eastwood", "", "nathan.eastwood@icloud.com",
     role = c("aut", "cre"))
 Maintainer: Nathan Eastwood <nathan.eastwood@icloud.com>

diff --git a/R/filter.R b/R/filter.R
@@ -38,5 +38,7 @@ filter.default <- function(.data, ...) {
 
 #' @export
 filter.grouped_data <- function(.data, ...) {
-  apply_grouped_function(.data, "filter", ...)
+  rows <- rownames(.data)
+  res <- apply_grouped_function(.data, "filter", ...)
+  res[rows[rows %in% rownames(res)], ]
 }
diff --git a/R/mutate.R b/R/mutate.R
@@ -44,5 +44,7 @@ mutate.default <- function(.data, ...) {
 
 #' @export
 mutate.grouped_data <- function(.data, ...) {
-  apply_grouped_function(.data, "mutate", ...)
+  rows <- rownames(.data)
+  res <- apply_grouped_function(.data, "mutate", ...)
+  res[rows, ]
 }
diff --git a/R/transmute.R b/R/transmute.R
@@ -24,5 +24,7 @@ transmute.default <- function(.data, ...) {
 
 #' @export
 transmute.grouped_data <- function(.data, ...) {
-  apply_grouped_function(.data, "transmute", ...)
+  rows <- rownames(.data)
+  res <- apply_grouped_function(.data, "transmute", ...)
+  res[rows, ]
 }
diff --git a/inst/tinytest/test_count_tally.R b/inst/tinytest/test_count_tally.R
@@ -83,10 +83,9 @@ expect_equal(
   mtcars %>% group_by(cyl) %>% add_tally(),
   {
     res <- mtcars
-    res <- res[order(mtcars$cyl), ]
     res[, "n"] <- c(
-      11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 14L, 14L, 14L, 14L, 14L, 14L,
-      14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L
+      7L, 7L, 11L, 7L, 14L, 7L, 14L, 11L, 11L, 7L, 7L, 14L, 14L, 14L, 14L, 14L, 14L, 11L, 11L, 11L, 11L, 14L, 14L, 14L,
+      14L, 11L, 11L, 11L, 14L, 7L, 14L, 11L
     )
     attr(res, "groups") <- "cyl"
     attr(res, "class") <- c("grouped_data", "data.frame")

diff --git a/inst/tinytest/test_filter.R b/inst/tinytest/test_filter.R
@@ -31,6 +31,10 @@ expect_equal(
 # Grouped Operations
 expect_equal(
   mtcars %>% group_by(carb) %>% filter(any(mpg > 28)) %>% ungroup(),
-  do.call(rbind, unname(lapply(split(mtcars, mtcars$carb), function(x) x[any(x$mpg > 28), ]))),
+  {
+    rows <- rownames(mtcars)
+    res <- do.call(rbind, unname(lapply(split(mtcars, mtcars$carb), function(x) x[any(x$mpg > 28), ])))
+    res[rows[rows %in% rownames(res)], ]
+  },
   info = "Test grouped filters"
 )
diff --git a/inst/tinytest/test_mutate.R b/inst/tinytest/test_mutate.R
@@ -55,13 +55,14 @@ expect_equal(
   mtcars %>% group_by(am, cyl) %>% mutate(mpg2 = mpg * 2) %>% ungroup(),
   {
     res <- mtcars
-    do.call(rbind, unname(lapply(
+    res <- do.call(rbind, unname(lapply(
       split(res, list(res$am , res$cyl)),
       function(x) {
         x[, "mpg2"] <- x$mpg * 2
         x
       }
     )))
+    res[rownames(mtcars), ]
   },
   info = "Test grouped mutations"
 )
diff --git a/inst/tinytest/test_n.R b/inst/tinytest/test_n.R
@@ -13,10 +13,12 @@ expect_equal(
 expect_equal(
   mt_gears %>% mutate(n = n()) %>% ungroup(),
   {
-    do.call(rbind, unname(lapply(split(mtcars, mtcars$gear), function(x) {
+    rows <- rownames(mtcars)
+    res <- do.call(rbind, unname(lapply(split(mtcars, mtcars$gear), function(x) {
       x$n <- nrow(x)
       x
     })))
+    res[rows[rows %in% rownames(res)], ]
   },
   info = "n() works within a grouped mutate()"
 )

diff --git a/inst/tinytest/test_transmute.R b/inst/tinytest/test_transmute.R
@@ -19,12 +19,16 @@ expect_equal(
 
 expect_equal(
   mtcars %>% group_by(am) %>% transmute(sumMpg = sum(mpg)),
-  do.call(rbind, unname(lapply(
-    split(mtcars, mtcars$am),
-    function(x) {
-      x[, "sumMpg"] <- sum(x$mpg)
-      x[, "sumMpg", drop = FALSE]
-    }
-  ))),
+  {
+    rows <- rownames(mtcars)
+    res <- do.call(rbind, unname(lapply(
+      split(mtcars, mtcars$am),
+      function(x) {
+        x[, "sumMpg"] <- sum(x$mpg)
+        x[, "sumMpg", drop = FALSE]
+      }
+    )))
+    res[rows[rows %in% rownames(res)], ]
+  },
   info = "Transmute grouped dataframe"
 )