有几个包,例如leaflet
或magick
,它们分别采用特殊对象(地图或图像),并允许使用管道链进行修改/添加。
我想使用带有函数参数的元组列表来获得相同的行为,但我正在努力解决这个问题,因为purrr::map()
的输出是一个列表(或者dfr等,但不是传单映射或图像) 。
(请注意,我发现了一种方法可以在magick之后执行它,但它只适用于magick
,因为它们使用某些特殊功能并不打算使用它们,所以我仍然在寻找一般的答案对于像leaflet
这样的其他软件包的问题
Reprex:
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创建于2019-01-27(v0.2.1)
你可以使用purrr::reduce2
:
library(purrr)
reduce2(locations$box, locations$offset,
~image_composite(., get(..2), offset = ..3, operator = "over"), .init = x)
您可以使用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)