inst/doc/about-vector-arguments.R

In matsbyname: An Implementation of Matrix Mathematics that Respects Row and Column Names

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, include = FALSE---------------------------------------------------
library(dplyr)
library(matsbyname)
library(tibble)

## -----------------------------------------------------------------------------
mysum <- function(a, margin = c(1, 2)) {
  sum_func <- function(a_mat, margin) {
    # When we get here, we will have a single matrix a
    if (1 %in% margin & 2 %in% margin) {
      return(sum(a_mat))
    }
    if (margin == 1) {
      return(rowSums(a_mat) %>% matrix(nrow = nrow(a_mat)))
    }
    if (margin == 2) {
      return(colSums(a_mat) %>% matrix(ncol = ncol(a_mat)))
    }
  }
  unaryapply_byname(sum_func, a, .FUNdots = list(margin = margin))
}

## -----------------------------------------------------------------------------
m <- matrix(1:4, nrow = 2, byrow = TRUE)
m
# Works for single matrices
mysum(m, margin = 1)
mysum(m, margin = 2)
mysum(m, margin = c(1, 2))

## -----------------------------------------------------------------------------
# Works for lists of matrices
mysum(list(one = m, two = m), margin = 1)
mysum(list(one = m, two = m), margin = 2)

## -----------------------------------------------------------------------------
# Works in data frames and tibbles
DF <- tibble::tibble(mcol = list(m, m, m))
res <- DF %>% 
  dplyr::mutate(
    rsums = mysum(mcol, margin = 1), 
    csums = mysum(mcol, margin = 2)
  )
res$rsums
res$csums

## -----------------------------------------------------------------------------
tryCatch(mysum(list(m, m, m), margin = c(1, 2)), 
         error = function(e) {strwrap(e, width = 60)})

## -----------------------------------------------------------------------------
mysum(list(m, m), margin = c(1, 2))

## -----------------------------------------------------------------------------
mysum(list(m, m, m), margin = list(c(1, 2)))

## -----------------------------------------------------------------------------
mysum(list(m, m, m), margin = list(1, 2, c(1, 2)))

## -----------------------------------------------------------------------------
tryCatch(mysum(list(m, m, m), margin = list(1, 2)), 
         error = function(e) {strwrap(e, width = 60)})

## -----------------------------------------------------------------------------
mysum2 <- function(a, margin = c(1, 2)) {
  margin <- prep_vector_arg(a, margin)
  sum_func <- function(a_mat, margin) {
    # When we get here, we will have a single matrix a
    if (1 %in% margin & 2 %in% margin) {
      return(sum(a_mat))
    }
    if (margin == 1) {
      return(rowSums(a_mat) %>% matrix(nrow = nrow(a_mat)))
    }
    if (margin == 2) {
      return(colSums(a_mat) %>% matrix(ncol = ncol(a_mat)))
    }
  }
  unaryapply_byname(sum_func, a, .FUNdots = list(margin = margin))
}

## -----------------------------------------------------------------------------
mysum2(list(m, m, m), margin = c(1, 2))

## -----------------------------------------------------------------------------
mysum2(list(m, m), margin = c(1, 2))

## -----------------------------------------------------------------------------
mysum2(list(m, m), margin = list(c(1, 2)))

## -----------------------------------------------------------------------------
DF2 <- tibble::tibble(mcol = list(m, m), margin = c(1, 2))
DF2
DF2$margin %>% class()

## -----------------------------------------------------------------------------
res2 <- DF2 %>% 
  dplyr::mutate(
    sums = mysum2(mcol, margin = margin)
  )
res2$sums

## -----------------------------------------------------------------------------
DF3 <- tibble::tibble(mcol = list(m, m, m), margin = list(1, c(1, 2), c(1, 2))) %>% 
  dplyr::mutate(
    sumcol = mysum2(mcol, margin = margin)
  )
DF3$sumcol