Small ggplots on a ggmap - a purrr map version

Based on Small ggplot2 plots placed on coordinates on a ggmap I would like to have the same solution, but with ggplot function outside the pipeline, applied with purrr::map().

The data for small bar subplots indicating 2 values, may contain lon, lat, id, valueA, valueB, After tidyr::gather operation it may look like:

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

Current working solution is to use do() to generate sublopts and then ggplotGrob to generate a column with objects "grobs" to be placed at lon,lat locations on a 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 is a ggmap object, map of Poland, on which I would like to place small plots:

# 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))
#

How to translate this solution to the syntax nest - apply -unnest so that the ggplot part should be outside of the piped expression as a function.

In other words. How to replace do() with map(parameters, GGPlot_function) and then plot grobs on a ggmap .

What I did so far was I tried to write a ggplot function

#----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)
}

And got totaly confused trying to apply it like this (I am a constant beginner unfortunately)... this is not working, showing

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)))

I get errors indicating I do not know what I am doing, ie lengths of arguments are incorrect and something else is expected.

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(...)

Solution

data

First let's build some sample data close to yours but reproducible without the need for an api key.

As a starting point we have a plot of a country map stored in p, and some data in long form to build the charts stored in 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

define a plotting function

we isolate the plotting code in a separate function

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)
}

build a wrapper

This function takes a data set, some coordinates and the plotting function as parameters, to annotate at the right spot.

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)
}

The final code

The the code becomes simple, using nest and pmap

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

p + subgrobs