inst/doc/midf_apply_primer.R

In matsindf: Matrices in Data Frames

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(dplyr)
library(matsbyname)
library(matsindf)
library(tidyr)

## -----------------------------------------------------------------------------
example_fun <- function(a, b){
  return(list(c = matsbyname::sum_byname(a, b), 
              d = matsbyname::difference_byname(a, b)))
}

## -----------------------------------------------------------------------------
matsindf_apply(FUN = example_fun, a = 2, b = 1)

## -----------------------------------------------------------------------------
tryCatch(
  matsindf_apply(FUN = example_fun, a = 2, b = 1, z = 2),
  error = function(e){e}
)

## -----------------------------------------------------------------------------
tryCatch(
  matsindf_apply(FUN = example_fun, a = 2),
  error = function(e){e}
)

## -----------------------------------------------------------------------------
matsindf_apply(list(a = 2, b = 1), FUN = example_fun)

## -----------------------------------------------------------------------------
matsindf_apply(list(a = 2, b = 1, z = 42), FUN = example_fun)

## -----------------------------------------------------------------------------
matsindf_apply(list(a = 2, b = 1), FUN = example_fun, a = 10)

## -----------------------------------------------------------------------------
matsindf_apply(list(a = 2, b = 1, z = 42),
               FUN = example_fun, a = "z")

## -----------------------------------------------------------------------------
tryCatch(
  matsindf_apply(list(a = 2, b = 1, c = 42), FUN = example_fun),
  warning = function(w){w}
)

## -----------------------------------------------------------------------------
example_fun_with_string <- function(str_a, b) {
  a <- as.numeric(str_a)
  list(added = matsbyname::sum_byname(a, b), subtracted = matsbyname::difference_byname(a, b))
}

# Causes an error
tryCatch(
  matsindf_apply(FUN = example_fun_with_string, str_a = "1", b = 2),
  error = function(e){e}
)
# To solve the problem, wrap "1" in list().
matsindf_apply(FUN = example_fun_with_string, str_a = list("1"), b = 2)
matsindf_apply(FUN = example_fun_with_string, str_a = list("1"), b = list(2))
matsindf_apply(FUN = example_fun_with_string, 
               str_a = list("1", "3"), 
               b = list(2, 4))
matsindf_apply(.dat = list(str_a = list("1"), b = list(2)), FUN = example_fun_with_string)
matsindf_apply(.dat = list(m = list("1"), n = list(2)), FUN = example_fun_with_string, 
               str_a = "m", b = "n")

## -----------------------------------------------------------------------------
matsindf_apply(.dat = data.frame(str_a = c("1", "3"), b = c(2, 4)), 
               FUN = example_fun_with_string)
matsindf_apply(.dat = data.frame(str_a = c("1", "3"), b = c(2, 4)), 
               FUN = example_fun_with_string, 
               str_a = "str_a", b = "b")
matsindf_apply(.dat = data.frame(m = c("1", "3"), n = c(2, 4)), 
               FUN = example_fun_with_string, 
               str_a = "m", b = "n")

## -----------------------------------------------------------------------------
df <- data.frame(a = 2:4, b = 1:3)
matsindf_apply(df, FUN = example_fun)

## -----------------------------------------------------------------------------
# Create a tidy data frame containing data for matrices
tidy <- tibble::tibble(Year = rep(c(rep(2017, 4), rep(2018, 4)), 2),
                       matnames = c(rep("U", 8), rep("V", 8)),
                       matvals = c(1:4, 11:14, 21:24, 31:34),
                       rownames = c(rep(c(rep("p1", 2), rep("p2", 2)), 2), 
                                    rep(c(rep("i1", 2), rep("i2", 2)), 2)),
                       colnames = c(rep(c("i1", "i2"), 4), 
                                    rep(c("p1", "p2"), 4))) |>
  dplyr::mutate(
    rowtypes = case_when(
      matnames == "U" ~ "Product",
      matnames == "V" ~ "Industry", 
      TRUE ~ NA_character_
    ),
    coltypes = case_when(
      matnames == "U" ~ "Industry",
      matnames == "V" ~ "Product",
      TRUE ~ NA_character_
    )
  )

tidy

# Convert to a matsindf data frame
midf <- tidy |>  
  dplyr::group_by(Year, matnames) |> 
  collapse_to_matrices(rowtypes = "rowtypes", coltypes = "coltypes") |> 
  tidyr::pivot_wider(names_from = "matnames", values_from = "matvals")

# Take a look at the midf data frame and some of the matrices it contains.
midf
midf$U[[1]]
midf$V[[1]]

## -----------------------------------------------------------------------------
result <- midf |> 
  dplyr::mutate(
    W = difference_byname(transpose_byname(V), U)
  )
result
result$W[[1]]
result$W[[2]]

## -----------------------------------------------------------------------------
calc_W <- function(.DF = NULL, U = "U", V = "V", W = "W") {
  # The inner function does all the work.
  W_func <- function(U_mat, V_mat){
    # When we get here, U_mat and V_mat will be single matrices or single numbers, 
    # not a column in a data frame or an item in a list.
    if (length(U_mat) == 0 & length(V_mat == 0)) {
      # Tolerate zero-length arguments by returning a zero-length
      # a list with the correct name and return type.
      return(list(numeric()) |> magrittr::setnames(W))
    }
    # Calculate W_mat from the inputs U_mat and V_mat.
    W_mat <- matsbyname::difference_byname(
      matsbyname::transpose_byname(V_mat), 
      U_mat)
    # Return a named list.
    list(W_mat) |> magrittr::set_names(W)
  }
  # The body of the main function consists of a call to matsindf_apply
  # that specifies the inner function in the FUN argument.
  matsindf_apply(.DF, FUN = W_func, U_mat = U, V_mat = V)
}

## -----------------------------------------------------------------------------
midf |> calc_W()

## -----------------------------------------------------------------------------
midf |> calc_W(W = "W_prime")

## -----------------------------------------------------------------------------
midf |> 
  dplyr::rename(X = U, Y = V) |> 
  calc_W(U = "X", V = "Y")

## -----------------------------------------------------------------------------
calc_W(list(U = midf$U[[1]], V = midf$V[[1]]))

## -----------------------------------------------------------------------------
calc_W(U = midf$U[[1]], V = midf$V[[1]])

## -----------------------------------------------------------------------------
data.frame(U = c(1, 2), V = c(3, 4)) |> calc_W()

## -----------------------------------------------------------------------------
calc_W(U = 2, V = 3)

## -----------------------------------------------------------------------------
calc_W(U = numeric(), V = numeric())
calc_W(list(U = numeric(), V = numeric()))

res <- calc_W(list(U = c(2, 3, 4, 5), V = c(3, 4, 5, 6)))
res0 <- calc_W(list(U = numeric(), V = numeric()))
dplyr::bind_rows(res, res0)