Merge branch 'release-0.2.5'

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: matsindf
 Type: Package
 Title: Work with matrices in data frames
-Version: 0.2.4
-Date: 2018-05-22
+Version: 0.2.5
+Date: 2018-05-23
 Authors@R: c(person("Matthew", "Heun", role = c("aut", "cre"),
                      email = "[email protected]"))
 Author: Matthew Heun [aut, cre]

NAMESPACE

@@ -6,6 +6,8 @@ export(mat_to_rowcolval)
 export(matsindf_apply)
 export(matsindf_apply_types)
 export(rowcolval_to_mat)
+importFrom(dplyr,bind_cols)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
@@ -19,7 +21,10 @@ importFrom(dplyr,ungroup)
 importFrom(magrittr,"%>%")
 importFrom(matsbyname,setcoltype)
 importFrom(matsbyname,setrowtype)
+importFrom(purrr,set_names)
+importFrom(purrr,transpose)
 importFrom(rlang,":=")
+importFrom(rlang,.data)
 importFrom(tibble,column_to_rownames)
 importFrom(tibble,remove_rownames)
 importFrom(tibble,rownames_to_column)

NEWS.md

@@ -1,5 +1,10 @@
 # News for `matsindf`
 
+## matsindf 0.2.5 (2018-05-23)
+
+* `expand_to_tidy` now accepts a named list of matrices as input.
+
+
 ## matsindf 0.2.4 (2018-05-22)
 
 * `matsindf_apply` now obtains named arguments from `.DF` 

R/collapse.R

@@ -63,6 +63,7 @@
 #' @importFrom dplyr ungroup
 #' @importFrom magrittr %>%
 #' @importFrom rlang :=
+#' @importFrom rlang .data
 #' @importFrom tibble column_to_rownames
 #' @importFrom tibble remove_rownames
 #' @importFrom tibble rownames_to_column

R/expand.R

@@ -10,17 +10,20 @@
 #' \code{rowtypes}, and \code{coltypes}, arguments.
 #' The entries of the \pkg{matsindf}-style matrices are stored in an output column named \code{values}.
 #'
-#' @param    .data the data frame containing \pkg{matsindf}-style matrices
-#' @param matnames name of the column in \code{.data} containing matrix names (a string)
-#' @param  matvals name of the column in \code{.data} containing IO-style matrices or constants (a string),
-#' This will also be the name of the column containing matrix entries in the output data frame.
+#' @param      .DF the data frame containing \pkg{matsindf}-style matrices.
+#'                 (\code{.DF} may also be a named list of matrices, in which case
+#'                 names of the matrices are taken from the names of items in the list and
+#'                 list items are expected to be matrices.)
+#' @param matnames name of the column in \code{.DF} containing matrix names (a string)
+#' @param  matvals name of the column in \code{.DF} containing IO-style matrices or constants (a string),
+#'                 This will also be the name of the column containing matrix entries in the output data frame.
 #' @param rownames name for the output column of row names (a string)
 #' @param colnames name for the output column of column names (a string)
 #' @param rowtypes optional name for the output column of row types (a string)
 #' @param coltypes optional name for the output column of column types (a string)
 #' @param     drop if specified, the value to be dropped from output,
-#' For example, \code{drop = 0} will cause \code{0} entries in the matrices to be deleted from output.
-#' If \code{NA}, no values are dropped from output.
+#'                 For example, \code{drop = 0} will cause \code{0} entries in the matrices to be deleted from output.
+#'                 If \code{NA}, no values are dropped from output.
 #'
 #' @return a tidy data frame containing expanded \pkg{matsindf}-style matrices
 #' @export
@@ -58,16 +61,25 @@
 #' expand_to_tidy(mats, matnames = "matrix", matvals = "vals",
 #'                      rownames = "rows", colnames = "cols",
 #'                      rowtypes = "rt",   coltypes = "ct", drop = 0)
-expand_to_tidy <- function(.data, matnames, matvals,
+expand_to_tidy <- function(.DF, matnames, matvals,
                            rownames, colnames,
                            rowtypes = NULL, coltypes = NULL,
                            drop = NA){
-  .data %>%
+  if (!is.data.frame(.DF) & is.list(.DF)) {
+    # Create an empty 1-row data frame with row names taken from .DF and promote to a column
+    tempDF <- matrix(NA, nrow = length(.DF), ncol = 1, dimnames = list(names(.DF), matvals)) %>%
+      as.data.frame() %>%
+      rownames_to_column(matnames)
+    # Set the matvals column to be the list of items in .DF
+    tempDF[[matvals]] <- I(.DF)
+    .DF <- tempDF
+  }
+  .DF %>%
     # group by everything except matvals column so that "do" will act as desired
-    group_by_at(setdiff(colnames(.data), matvals)) %>%
+    group_by_at(setdiff(colnames(.DF), matvals)) %>%
     dplyr::do(
       # Convert .data to row, col, val format
-      mat_to_rowcolval(.data[[matvals]][[1]], rownames = rownames, colnames = colnames,
+      mat_to_rowcolval(.data[[matvals]][[1L]], rownames = rownames, colnames = colnames,
                        rowtype = rowtypes, coltype = coltypes,
                        values = matvals, drop = drop)
     ) %>%

R/matsindf_apply.R

@@ -58,7 +58,14 @@
 #'
 #' @export
 #'
+#' @importFrom dplyr bind_cols
+#' @importFrom dplyr bind_rows
+#' @importFrom purrr transpose
+#' @importFrom purrr set_names
+#' @importFrom rlang .data
+#'
 #' @examples
+#' library(matsbyname)
 #' example_fun <- function(a, b){
 #'   return(list(c = sum_byname(a, b), d = difference_byname(a, b)))
 #' }
@@ -69,13 +76,15 @@
 #'               dimnames = list(c("r1", "r2"), c("c1", "c2")))
 #' b <- 0.5 * a
 #' matsindf_apply(FUN = example_fun, a = a, b = b)
-#' # Single values in lists
+#' # Single values in lists are treated like columns of a data frame
 #' matsindf_apply(FUN = example_fun, a = list(2, 2), b = list(1, 2))
-#' # Matrices in lists
+#' # Matrices in lists are treated like columns of a data frame
 #' matsindf_apply(FUN = example_fun, a = list(a, a), b = list(b, b))
 #' # Single numbers in a data frame
 #' DF <- data.frame(a = c(4, 4, 5), b = c(4, 4, 4))
 #' matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
+#' # By default, arguments to FUN come from DF
+#' matsindf_apply(DF, FUN = example_fun)
 #' # Matrices in data frames (matsindf)
 #' DF2 <- data.frame(a = I(list(a, a)), b = I(list(b,b)))
 #' matsindf_apply(DF2, FUN = example_fun, a = "a", b = "b")
@@ -134,9 +143,7 @@ matsindf_apply <- function(.DF = NULL, FUN, ...){
     # extract a column from .DF.
     # So, eliminate all NULLs from the ... strings.
     use_dots_not_null <- use_dots[which(!as.logical(lapply(use_dots, is.null)))]
-    arg_cols <- lapply(use_dots_not_null, FUN = function(colname){
-      return(.DF[[colname]])
-    })
+    arg_cols <- lapply(use_dots_not_null, FUN = function(colname){return(.DF[[colname]])})
     # If one of the ... strings is not a name of a column in .DF,
     # it is, practically speaking, a missing argument, and we should treat it as such.
     # If an arg is not present in .DF, it will be NULL in arg_cols.
@@ -148,13 +155,12 @@ matsindf_apply <- function(.DF = NULL, FUN, ...){
     result <- do.call(matsindf_apply, args = c(list(.DF = NULL, FUN = FUN), arg_cols))
     # Check to see if the names of result are the same as any names of .DF.
     # If so, emit a warning.
-    result_names <- names(result)
-    common_names <- intersect(result_names, names(.DF))
+    common_names <- intersect(names(.DF), names(result))
     if (length(common_names) > 0) {
       warning("name collision in matsindf_apply: ", common_names)
     }
     if (is.data.frame(.DF)) {
-      return(result %>% bind_rows() %>% bind_cols(.DF, .))
+      return(bind_cols(.DF, bind_rows(result)))
     }
     if (is.list(.DF)) {
       return(c(.DF, result))

tests/testthat/test_expand.R

@@ -110,7 +110,7 @@ test_that("expand_to_tidy works as expected without rowtype, coltype", {
   m2 <- m1*10
   df <- data.frame(matnames = c("m1", "m2"), m = I(list(m1, m2)))
   class(df$m) <- class(df$m)[-match("AsIs", class(df$m))]
-  tidy <- expand_to_tidy(df, matnames = "matrix", , matvals = "m", rownames = "row", colnames = "col") %>%
+  tidy <- expand_to_tidy(df, matnames = "matrix", matvals = "m", rownames = "row", colnames = "col") %>%
     as.data.frame()
   expected_df <- data.frame(
     matnames = c(rep("m1", 4), rep("m2", 4)),
@@ -124,3 +124,23 @@ test_that("expand_to_tidy works as expected without rowtype, coltype", {
     )
   expect_equal(tidy, expected_df)
 })
+
+test_that("expand_to_tidy works with a list of matrices", {
+  m1 <- matrix(c(1,2), nrow = 2, ncol = 1, dimnames = list(c("i1", "i2"), "p1")) %>%
+    setrowtype("industries") %>% setcoltype("products")
+  m2 <- transpose_byname(m1 * 10)
+  result <- expand_to_tidy(list(m1 = m1, m2 = m2),
+                           matnames = "matnames", matvals = "matvals",
+                           rownames = "rownames", colnames = "colnames",
+                           rowtypes = "rt", coltypes = "ct")
+  expected <- data.frame(
+    matnames = c("m1", "m1", "m2", "m2"),
+    rownames = c("i1", "i2", "p1", "p1"),
+    colnames = c("p1", "p1", "i1", "i2"),
+    matvals = c(1, 2, 10, 20),
+    rt = c("industries", "industries", "products", "products"),
+    ct = c("products", "products", "industries", "industries"),
+    stringsAsFactors = FALSE
+  )
+  expect_equal(result, expected)
+})

tests/testthat/test_matsindf_apply.R

@@ -131,3 +131,12 @@ test_that("matsindf_apply works when .DF supplies some or all argument names", {
                  "name collision in matsindf_apply: c") %>%
     expect_equal(c(list(a = 1, b = 2, c = 10), list(c = 12, d = 8)))
 })
+
+test_that("matsindf_apply works for single numbers in data frame columns", {
+  DF <- data.frame(a = c(4, 4, 5), b = c(4, 4, 4))
+  expected <- DF
+  expected$c <- c(8, 8, 9)
+  expected$d <- c(0, 0, 1)
+  expect_equal(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b"), expected)
+  expect_equal(matsindf_apply(DF, FUN = example_fun), expected)
+})