1#' Lift the domain of a function 2#' 3#' `lift_xy()` is a composition helper. It helps you compose 4#' functions by lifting their domain from a kind of input to another 5#' kind. The domain can be changed from and to a list (l), a vector 6#' (v) and dots (d). For example, `lift_ld(fun)` transforms a 7#' function taking a list to a function taking dots. 8#' 9#' The most important of those helpers is probably `lift_dl()` 10#' because it allows you to transform a regular function to one that 11#' takes a list. This is often essential for composition with purrr 12#' functional tools. Since this is such a common function, 13#' `lift()` is provided as an alias for that operation. 14#' 15#' @inheritParams as_vector 16#' @param ..f A function to lift. 17#' @param ... Default arguments for `..f`. These will be 18#' evaluated only once, when the lifting factory is called. 19#' @return A function. 20#' @name lift 21#' @seealso [invoke()] 22NULL 23 24#' @rdname lift 25#' @section from ... to `list(...)` or `c(...)`: 26#' Here dots should be taken here in a figurative way. The lifted 27#' functions does not need to take dots per se. The function is 28#' simply wrapped a function in [do.call()], so instead 29#' of taking multiple arguments, it takes a single named list or 30#' vector which will be interpreted as its arguments. This is 31#' particularly useful when you want to pass a row of a data frame 32#' or a list to a function and don't want to manually pull it apart 33#' in your function. 34#' @param .unnamed If `TRUE`, `ld` or `lv` will not 35#' name the parameters in the lifted function signature. This 36#' prevents matching of arguments by name and match by position 37#' instead. 38#' @export 39#' @examples 40#' ### Lifting from ... to list(...) or c(...) 41#' 42#' x <- list(x = c(1:100, NA, 1000), na.rm = TRUE, trim = 0.9) 43#' lift_dl(mean)(x) 44#' 45#' # Or in a pipe: 46#' mean %>% lift_dl() %>% invoke(x) 47#' 48#' # You can also use the lift() alias for this common operation: 49#' lift(mean)(x) 50#' 51#' # Default arguments can also be specified directly in lift_dl() 52#' list(c(1:100, NA, 1000)) %>% lift_dl(mean, na.rm = TRUE)() 53#' 54#' # lift_dl() and lift_ld() are inverse of each other. 55#' # Here we transform sum() so that it takes a list 56#' fun <- sum %>% lift_dl() 57#' fun(list(3, NA, 4, na.rm = TRUE)) 58#' 59#' # Now we transform it back to a variadic function 60#' fun2 <- fun %>% lift_ld() 61#' fun2(3, NA, 4, na.rm = TRUE) 62#' 63#' # It can sometimes be useful to make sure the lifted function's 64#' # signature has no named parameters, as would be the case for a 65#' # function taking only dots. The lifted function will take a list 66#' # or vector but will not match its arguments to the names of the 67#' # input. For instance, if you give a data frame as input to your 68#' # lifted function, the names of the columns are probably not 69#' # related to the function signature and should be discarded. 70#' lifted_identical <- lift_dl(identical, .unnamed = TRUE) 71#' mtcars[c(1, 1)] %>% lifted_identical() 72#' mtcars[c(1, 2)] %>% lifted_identical() 73lift <- function(..f, ..., .unnamed = FALSE) { 74 force(..f) 75 defaults <- list(...) 76 function(.x = list(), ...) { 77 if (.unnamed) { 78 .x <- unname(.x) 79 } 80 do.call("..f", c(.x, defaults, list(...))) 81 } 82} 83 84#' @rdname lift 85#' @export 86lift_dl <- lift 87 88#' @rdname lift 89#' @export 90lift_dv <- function(..f, ..., .unnamed = FALSE) { 91 force(..f) 92 defaults <- list(...) 93 94 function(.x, ...) { 95 if (.unnamed) { 96 .x <- unname(.x) 97 } 98 .x <- as.list(.x) 99 do.call("..f", c(.x, defaults, list(...))) 100 } 101} 102 103#' @rdname lift 104#' @section from `c(...)` to `list(...)` or `...`: 105#' These factories allow a function taking a vector to take a list 106#' or dots instead. The lifted function internally transforms its 107#' inputs back to an atomic vector. purrr does not obey the usual R 108#' casting rules (e.g., `c(1, "2")` produces a character 109#' vector) and will produce an error if the types are not 110#' compatible. Additionally, you can enforce a particular vector 111#' type by supplying `.type`. 112#' @export 113#' @examples 114#' # 115#' 116#' 117#' ### Lifting from c(...) to list(...) or ... 118#' 119#' # In other situations we need the vector-valued function to take a 120#' # variable number of arguments as with pmap(). This is a job for 121#' # lift_vd(): 122#' pmap(mtcars, lift_vd(mean)) 123#' 124#' # lift_vd() will collect the arguments and concatenate them to a 125#' # vector before passing them to ..f. You can add a check to assert 126#' # the type of vector you expect: 127#' lift_vd(tolower, .type = character(1))("this", "is", "ok") 128lift_vl <- function(..f, ..., .type) { 129 force(..f) 130 defaults <- list(...) 131 if (missing(.type)) .type <- NULL 132 133 function(.x = list(), ...) { 134 x <- as_vector(.x, .type) 135 do.call("..f", c(list(x), defaults, list(...))) 136 } 137} 138 139#' @rdname lift 140#' @export 141lift_vd <- function(..f, ..., .type) { 142 force(..f) 143 defaults <- list(...) 144 if (missing(.type)) .type <- NULL 145 146 function(...) { 147 x <- as_vector(list(...), .type) 148 do.call("..f", c(list(x), defaults)) 149 } 150} 151 152#' @rdname lift 153#' @section from list(...) to c(...) or ...: 154#' `lift_ld()` turns a function that takes a list into a 155#' function that takes dots. `lift_vd()` does the same with a 156#' function that takes an atomic vector. These factory functions are 157#' the inverse operations of `lift_dl()` and `lift_dv()`. 158#' 159#' `lift_vd()` internally coerces the inputs of `..f` to 160#' an atomic vector. The details of this coercion can be controlled 161#' with `.type`. 162#' 163#' @export 164#' @examples 165#' # 166#' 167#' 168#' ### Lifting from list(...) to c(...) or ... 169#' 170#' # cross() normally takes a list of elements and returns their 171#' # cartesian product. By lifting it you can supply the arguments as 172#' # if it was a function taking dots: 173#' cross_dots <- lift_ld(cross) 174#' out1 <- cross(list(a = 1:2, b = c("a", "b", "c"))) 175#' out2 <- cross_dots(a = 1:2, b = c("a", "b", "c")) 176#' identical(out1, out2) 177#' 178#' # This kind of lifting is sometimes needed for function 179#' # composition. An example would be to use pmap() with a function 180#' # that takes a list. In the following, we use some() on each row of 181#' # a data frame to check they each contain at least one element 182#' # satisfying a condition: 183#' mtcars %>% pmap(lift_ld(some, partial(`<`, 200))) 184#' 185#' # Default arguments for ..f can be specified in the call to 186#' # lift_ld() 187#' lift_ld(cross, .filter = `==`)(1:3, 1:3) %>% str() 188#' 189#' 190#' # Here is another function taking a list and that we can update to 191#' # take a vector: 192#' glue <- function(l) { 193#' if (!is.list(l)) stop("not a list") 194#' l %>% invoke(paste, .) 195#' } 196#' 197#' \dontrun{ 198#' letters %>% glue() # fails because glue() expects a list} 199#' 200#' letters %>% lift_lv(glue)() # succeeds 201lift_ld <- function(..f, ...) { 202 force(..f) 203 defaults <- list(...) 204 function(...) { 205 do.call("..f", c(list(list(...)), defaults)) 206 } 207} 208 209#' @rdname lift 210#' @export 211lift_lv <- function(..f, ...) { 212 force(..f) 213 defaults <- list(...) 214 function(.x, ...) { 215 do.call("..f", c(list(as.list(.x)), defaults, list(...))) 216 } 217} 218