Маленькие ggplots на ggmap - версия карты purrr

Question

На основе небольших графиков ggplot2, размещенных по координатам на ggmap Я хотел бы иметь такое же решение, но с функцией ggplot вне конвейера, примененной с помощью purrr :: map ().

Данные для маленьких графиков, показывающих 2 значения, могут содержать lon, lat, id, valueA, valueB, после операции tidyr :: collect это может выглядеть следующим образом:

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() для генерации подлогов и затем ggplotGrob для генерации столбца с объектами "grobs" для размещения в lon, lat местоположениях на ggmap.

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 находилась за пределами конвейерного выражения как функции.

Другими словами. Как заменить do () на map (параметры, GGPlot_function), а затем нанести гроб на ggmap.

Пока я пытался написать функцию 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

data

Сначала давайте построим некоторые образцы данных, близкие к вашим, но воспроизводимые без необходимости использования ключа 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