markfairbanks / tidytable

Tidy interface to 'data.table'
https://markfairbanks.github.io/tidytable/
Other
449 stars 33 forks source link

Support purrr::map_depth() #555

Closed AlbertoAlmuinha closed 2 years ago

AlbertoAlmuinha commented 2 years ago

Hi,

I would like to know if it would be possible to include a tidytable version of purrr::map_depth() function.

It would be useful.

Thanks,

markfairbanks commented 2 years ago

Thanks for the request, but unfortunately I don't think I'll be adding any more purrr functions to tidytable (except maybe imap.()). For more complicated use cases like map_depth() I typically recommend just using purrr.

markfairbanks commented 2 years ago

If you are trying to avoid a purrr dependency in a package, this is a quick implementation adapted from purrr that you can use internally.

library(tidytable, warn.conflicts = FALSE)
library(rlang)

map_depth. <- function(.x, .depth, .f, ..., .ragged = FALSE) {
  if (!is_integerish(.depth, n = 1, finite = TRUE)) {
    abort("`.depth` must be a single number")
  }
  if (.depth < 0) {
    .depth <- vec_depth.(.x) + .depth
  }

  .f <- as_function(.f)
  .map_depth_rec(.x, .depth, .f, ..., .ragged = .ragged, .atomic = FALSE)
}

# internal purrr helper
.map_depth_rec <- function(.x,
                          .depth,
                          .f,
                          ...,
                          .ragged,
                          .atomic) {
  if (.depth < 0) {
    abort("Invalid depth")
  }

  if (.atomic) {
    if (!.ragged) {
      abort("List not deep enough")
    }
    return(map.(.x, .f, ...))
  }

  if (.depth == 0) {
    return(.f(.x, ...))
  }

  if (.depth == 1) {
    return(map.(.x, .f, ...))
  }

  # Should this be replaced with a generic way of figuring out atomic
  # types?
  .atomic <- is_atomic(.x)

  map.(.x, function(x) {
    .map_depth_rec(x, .depth - 1, .f, ..., .ragged = .ragged, .atomic = .atomic)
  })
}

# See purrr::vec_depth
vec_depth. <- function(x) {
  if (is_null(x)) {
    0L
  } else if (is_atomic(x)) {
    1L
  } else if (is_list(x)) {
    depths <- map_int.(x, vec_depth.)
    1L + max(depths, 0L)
  } else {
    abort("`x` must be a vector")
  }
}

x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6))

map_depth.(x, 2, paste, collapse = "/")
#> $a
#> $a$foo
#> [1] "1/2"
#> 
#> $a$bar
#> [1] "3/4"
#> 
#> 
#> $b
#> $b$baz
#> [1] "5/6"
AlbertoAlmuinha commented 2 years ago

Thank you very much! That should work for me!