如何使用 purrr:map() 和 rlang 来模拟管道链

Question

有几个软件包，例如 leaflet 或 magick 可以接收特殊对象（分别是地图或图像），并允许它们 modified/added 使用管链。

我想使用带有函数参数的 tibbles 列表来获得相同的行为，但我正在努力解决如何做到这一点，因为 purrr::map() 的输出是一个列表（或 dfr 等），但不是传单地图或图像）。

（请注意，稍后我在 magick 中找到了一种方法，但它仅在 magick 中有效，因为以不应该使用的方式使用了一些特殊功能，所以我仍在为 leaflet)

等其他软件包寻找此问题的一般答案

代表：

suppressPackageStartupMessages(require(tidyverse))
suppressPackageStartupMessages(require(magick))
suppressPackageStartupMessages(require(rlang))


x <- image_blank(100, 100, "yellow")

blackbox <- image_blank(10, 10, "black")
redbox <- image_blank(10, 10, "red")

locations <- tribble(~box, ~offset,
                      "redbox", "+0+0",
                      "redbox", "+90+0",
                      "redbox", "+0+90",
                      "redbox", "+90+90",
                      "blackbox", "+40+40",
                      "blackbox", "+50+50",
                      "blackbox", "+30+60",
                      "blackbox", "+60+30")

#preferred method:
locations %>% 
  mutate(row = row_number()) %>% 
  split(.$row) %>% 
  map(function(location) {
    x <- x %>% image_composite(eval_tidy(sym(location$box)), offset = location$offset, operator = "over")
  })
#> $`1`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`2`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`3`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`4`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`5`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`6`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`7`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72  
#> 
#> $`8`
#> # A tibble: 1 x 7
#>   format width height colorspace matte filesize density
#>   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
#> 1 png      100    100 sRGB       FALSE        0 72x72




#desired result I'm trying to emulate:
x %>% 
  image_composite(redbox, offset = "+0+0", operator = "over") %>% 
  image_composite(redbox, offset = "+90+0", operator = "over") %>% 
  image_composite(redbox, offset = "+0+90", operator = "over") %>% 
  image_composite(redbox, offset = "+90+90", operator = "over") %>% 
  image_composite(blackbox, offset = "+40+40", operator = "over") %>% 
  image_composite(blackbox, offset = "+50+50", operator = "over") %>% 
  image_composite(blackbox, offset = "+30+60", operator = "over") %>% 
  image_composite(blackbox, offset = "+60+30", operator = "over")

#as an aside, i figured out to do it part of the way with magick, but does not apply to the general question and doesn't fully emulate the above.
y <- image_blank(100, 100, "transparent")

locations %>% 
  mutate(row = row_number()) %>% 
  split(.$row) %>% 
  map(function(location) {
    y %>% image_composite(eval_tidy(sym(location$box)), offset = location$offset, operator = "over")
  }) %>% 
  reduce(c) %>% 
  image_flatten() %>% 
  image_background(color = "yellow") #also having to flatten an animation loses the transparency, so you can't add it on top of the background.

^{由 reprex package (v0.2.1)}

于 2019-01-27 创建

Answer 1

您可以使用 purrr::partial 为 offset、operator 等生成具有预先指定值的函数列表。然后可以通过以下方式将这些函数聚合到一个操作中purrr::compose:

funs <- map2( locations$box, locations$offset,
         ~partial(image_composite, composite_image=get(.x), 
                  offset=.y, operator="over") )

## Equivalent to x %>% funs[[1]]() %>% funs[[2]]() %>% ...
compose(!!!funs)(x)

Answer 2

你可以使用 purrr::reduce2 :

library(purrr)
reduce2(locations$box, locations$offset,
    ~image_composite(., get(..2), offset = ..3, operator = "over"), .init = x)

如何使用 purrr:map() 和 rlang 来模拟管道链

How to use purrr:map() and rlang to emulate a pipe chain

r

purrr

r-leaflet

rlang

magick-r-package