resolves #36

NEWS.md

@@ -27,6 +27,7 @@
 * correction to error message in `limit()`
 * adds missing `sort` argument to `props()`
 * `pseudo_id.factor()` no longer returns `NA_integer` when a value is `NA` or a level is `NA` and correctly resets the order of the levels from the factor to their order of appearance
+* `flip.data.frame()` no longer coerces single column data.frames [#36](https://github.com/jmbarbone/mark/issues/36)
 
 ## New features
 
@@ -94,7 +95,7 @@ The previous name `jordan` was conflicting with recent package on CRAN.
   * removes `jordan.note.fun` option for printing -- this was too complicated and doesn't seem to work too well without too many adjustments
   * `note<-` now appends the class `noted` to the object so that a `print.noted` method is dispatched so the note will be printed when called
   * `print.note` note defaults to a colorful _message_ called with `cat()`
-  * Startup related functions moved to [`jordanExtra`](https://github.com/jmbarbone/jordanExtra); these were a bit _wild_, dynamic, and not well tested.  The **.Rprofile** template also exists in the separate package.
+  * Startup related functions moved to [`jordanExtra`](https://github.com/jmbarbone/markExtra); these were a bit _wild_, dynamic, and not well tested.  The **.Rprofile** template also exists in the separate package.
 
 ## Improvements
 
@@ -207,7 +208,7 @@ Major cleanup for documenting, reviewing, removing, relocating, and testing func
 
 ## Moved to `jordanExtra`
 
-Some miscellaneous, less controlled functions have been moved to [jordanExtra](https://github.com/jmbarbone/jordanExtra).
+Some miscellaneous, less controlled functions have been moved to [jordanExtra](https://github.com/jmbarbone/markExtra).
 
 * Functions for Rust `set_rust_engine()`, `engine_rust()`
 * Functions for [openxlsx](https://github.com/ycphs/openxlsx): `add_data_sheet()`, `add_image_sheet()`

R/flip.R

@@ -45,7 +45,7 @@ flip.matrix <- function(x, by_row = TRUE, keep_rownames = NULL, ...) {
       return(x)
     }
 
-    out <- x[rows:1, ]
+    out <- x[rows:1, , drop = FALSE]
     rn <- dims[[1]]
 
     if (is.null(keep_rownames)) {
@@ -63,7 +63,7 @@ flip.matrix <- function(x, by_row = TRUE, keep_rownames = NULL, ...) {
       return(x)
     }
 
-    out <- x[, cols:1L]
+    out <- x[, cols:1L, drop = FALSE]
   }
 
   out
@@ -79,7 +79,7 @@ flip.data.frame <- function(x, by_row = TRUE, keep_rownames = NULL, ...) {
       return(x)
     }
 
-    out <- x[rows:1, ]
+    out <- x[rows:1, , drop = FALSE]
     rn <- attr(x, "row.names")
 
     if (is.null(keep_rownames)) {
@@ -96,7 +96,7 @@ flip.data.frame <- function(x, by_row = TRUE, keep_rownames = NULL, ...) {
       return(x)
     }
 
-    out <- x[, cols:1L]
+    out <- x[, cols:1L, drop = FALSE]
   }
 
   out

tests/testthat/test-flip.R

@@ -32,3 +32,13 @@ test_that("flip.matrix", {
   res3 <- mat2[5:1, ]
   expect_equal(flip(mat2), res3)
 })
+
+test_that("flip doesn't coerce into lower object [36]", {
+  x <- data.frame(x = 1)
+  expect_identical(x, flip(x))
+  expect_identical(x, flip(x, by_row = FALSE))
+
+  x <- matrix(1:4, nrow = 2)
+  expect_identical(dim(flip(x)), c(2L, 2L))
+  expect_identical(dim(flip(x, by_row = FALSE)), c(2L, 2L))
+})