ggmap 上的小 ggplots - purrr 地图版本

Question

基于我想要相同的解决方案，但在管道外使用 ggplot 函数，应用 purrr::map().

指示 2 个值的小条形子图的数据可能包含 lon, lat, id, valueA, valueB, tidyr::gather 操作后它可能看起来像：

Town, Potential_Sum, lon, lat, component , sales 
Aaa, 9.00, 20.80, 54.25, A, 5.000 
Aaa, 9.00, 20.80, 54.25, B, 4.000  
Bbb, 5.00, 19.60, 50.50, A, 3.000  
Bbb, 5.00, 19.60, 50.50, B, 2.000

当前的工作解决方案是使用 do() 生成 sublopts，然后 ggplotGrob 生成一个包含对象的列 "grobs" 放置在 ggmap 的 lon,lat 位置。

maxSales <- max(df$sales)

df.grobs <- df %>% 
  do(subplots = ggplot(., aes(1, sales, fill = component)) + 
       geom_col(position = "dodge", alpha = 0.50, colour = "white") +
       coord_cartesian(ylim = c(0, maxSales)) +
       scale_fill_manual(values = c("green", "red"))+
       geom_text(aes(label=if_else(sales>0,round(sales),  NULL)), vjust=0.35,hjust=1.1, colour="black",
                 position=position_dodge(.9), size=2.5, angle=90)+
       theme_void()+ guides(fill = F)) %>% 
  mutate(subgrobs = list(annotation_custom(ggplotGrob(subplots), 
                                           x = lon-0.14, y = lat-0.20, 
                                           xmax = lon+0.14, ymax = lat+1.2))) 

df.grobs %>%
  {p +  geom_label(aes(x = 15, y = 49.8, label = "A"), colour = c("black"),fill = "green", size=3)+
      geom_label(aes(x = 15, y = 5.01, label = "B"), colour = c("black"),fill = "red", size=3)+
      .$subgrobs + 
      geom_text(data=df, aes(label = Miasto), vjust = 3.5,nudge_x = 0.05, size=2.5) + 
      geom_col(data = df,
               aes(0,0, fill = component), 
               colour = "white")}

p 是一个 ggmap 对象，波兰地图，我想在其上放置小地块：

# p <-
#   get_googlemap(
#     "Poland",
#     maptype = "roadmap",
#     zoom = 6,
#     color = "bw",
#     crop = T,
#     style = "feature:all|element:labels|visibility:off" # 'feature:administrative.country|element:labels|visibility:off' 
#   ) %>%                                                 # or 'feature:all|element:labels|visibility:off'
#   ggmap() + coord_cartesian() +
#   scale_x_continuous(limits = c(14, 24.3), expand = c(0, 0)) +
#   scale_y_continuous(limits = c(48.8, 55.5), expand = c(0, 0))
#

如何将此解决方案转换为语法 nest - apply -unnest，以便 ggplot 部分应该作为函数位于管道表达式之外。

也就是说。 如何用 map(parameters, GGPlot_function) 替换 do() 然后在 ggmap 上绘制 grobs。

到目前为止我所做的是尝试编写一个 ggplot 函数

#----barplots----

maxSales <- max(df$sales)

fn_ggplot <- function (df, x, component, maxX) { 

  x <- enquo(x)
  component <-enquo(component)
  maxX <-enquo(maxX)

  p <- ggplot(df, aes(1, !!x, fill = !!component)) + 
    geom_col(position = "dodge", alpha = 0.50, colour = "white") +
    coord_cartesian(ylim = c(0, !!maxX)) +
    scale_fill_manual(values = c("green", "red"))+
    geom_text(aes(label=if_else(x>0,round(!!x),  NULL)), vjust=0.35,hjust=1.1, colour="black",
              position=position_dodge(.9), size=2.5, angle=90)+
    theme_void()+ guides(fill = F)

  return(p)
}

尝试像这样应用它时完全感到困惑（不幸的是我一直是初学者）...这不起作用，显示

df.grobs <- df %>% 
  mutate(subplots = pmap(list(.,sales,component,Potential_Sum),fn_ggplot)) %>% 
  mutate(subgrobs = list(annotation_custom(ggplotGrob(subplots), 
                                           x = lon-0.14, y = lat-0.20, 
                                           xmax = lon+0.14, ymax = lat+1.2)))

我收到错误消息，表明我不知道自己在做什么，即参数长度不正确，并且需要其他内容。

message: Element 2 of `.l` must have length 1 or 7, not 2
class:   `purrr_error_bad_element_length`
backtrace:
  1. dplyr::mutate(...)
 12. purrr:::stop_bad_length(...)
 13. dplyr::mutate(...)
Call `rlang::last_trace()` to see the full backtrace
> rlang::last_trace()
     x
  1. +-`%>%`(...)
  2. | +-base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
  3. | \-base::eval(quote(`_fseq`(`_lhs`)), env, env)
  4. |   \-base::eval(quote(`_fseq`(`_lhs`)), env, env)
  5. |     \-global::`_fseq`(`_lhs`)
  6. |       \-magrittr::freduce(value, `_function_list`)
  7. |         \-function_list[[i]](value)
  8. |           +-dplyr::mutate(...)
  9. |           \-dplyr:::mutate.tbl_df(...)
 10. |             \-dplyr:::mutate_impl(.data, dots, caller_env())
 11. +-purrr::pmap(list(., sales, component, Potential_Sum), fn_ggplot)
 12. \-purrr:::stop_bad_element_length(...)
 13.   \-purrr:::stop_bad_length(...)

Answer 1

数据

首先，让我们构建一些与您的数据接近但无需 api 密钥即可重现的示例数据。

作为起点，我们在 p 中存储了一张国家地图，并在 plot_data 中存储了一些用于构建图表的长格式数据。

library(maps)
library(tidyverse)

p <- ggplot(map_data("france"), aes(long,lat,group=group)) +
  geom_polygon(fill = "lightgrey") +
  theme_void()

set.seed(1)
plot_data <- tibble(lon = c(0,2,5), lat = c(44,48,46)) %>% 
  group_by(lon, lat) %>%
  do(tibble(component = LETTERS[1:3], value = runif(3,min=1,max=5))) %>% 
  mutate(total = sum(value)) %>%
  ungroup()
plot_data
# # A tibble: 9 x 5
#     lon   lat component value total
#   <dbl> <dbl> <chr>     <dbl> <dbl>
# 1     0    44 A          2.06  7.84
# 2     0    44 B          2.49  7.84
# 3     0    44 C          3.29  7.84
# 4     2    48 A          4.63 11.0 
# 5     2    48 B          1.81 11.0 
# 6     2    48 C          4.59 11.0 
# 7     5    46 A          4.78 11.9 
# 8     5    46 B          3.64 11.9 
# 9     5    46 C          3.52 11.9

定义绘图函数

我们将绘图代码隔离在一个单独的函数中

my_plot_fun <- function(data){
  ggplot(data, aes(1, value, fill = component)) + 
    geom_col(position = position_dodge(width = 1), 
             alpha = 0.75, colour = "white") +
    geom_text(aes(label = round(value, 1), group = component), 
              position = position_dodge(width = 1),
              size = 3) +
    theme_void()+ guides(fill = F)
}

构建包装器

这个函数以数据集、一些坐标和绘图函数作为参数，在正确的位置进行注释。

annotation_fun <- function(data, lat,lon, plot_fun) {
  subplot = plot_fun(data)
  sub_grob <- annotation_custom(ggplotGrob(subplot), 
                                x = lon-0.5, y = lat-0.5, 
                                xmax = lon+0.5, ymax = lat+0.5)
}

最终代码

代码变得简单，使用nest和pmap

subgrobs <- plot_data %>% 
  nest(-lon,-lat)  %>%
  pmap(annotation_fun,plot_fun = my_plot_fun)

p + subgrobs

ggmap 上的小 ggplots - purrr 地图版本

Small ggplots on a ggmap - a purrr map version

r

ggplot2

purrr

tidyverse

tidyeval