Есть ли способ нанести ggplots на листовки, не сохраняя их на диске? - PullRequest
0 голосов
/ 24 декабря 2018

У меня есть регион с субрегионами.Для каждого субрегиона у меня есть простой ggplot, который я хочу поместить в центр каждого региона.Я использую пакет листовки, поэтому мой код выглядит следующим образом:

employees_spdf <- structure(list(ID = structure(c(7L, 8L, 4L, 3L, 10L, 1L,  9L, 
6L, 2L, 5L), .Label = c("75006", "78280", "91370", "92110", "92420", 
"93270", "93440", "95000", "95330", "95400"), class = "factor"), 
n = c(10L, 79L, 99L, 16L, 55L, 94L, 25L, 40L, 51L, 44L), 
geometry = structure(list(structure(c(2.423864, 48.95034085
), class = c("XY", "POINT", "sfg")), structure(c(2.05650642, 
49.0277569), class = c("XY", "POINT", "sfg")), structure(c(2.30575224, 
48.90353573), class = c("XY", "POINT", "sfg")), structure(c(2.25171264, 
48.75044317), class = c("XY", "POINT", "sfg")), structure(c(2.4076232, 
49.00203584), class = c("XY", "POINT", "sfg")), structure(c(2.33267081, 
48.84896818), class = c("XY", "POINT", "sfg")), structure(c(2.32290084, 
49.02966528), class = c("XY", "POINT", "sfg")), structure(c(2.53124065, 
48.938607), class = c("XY", "POINT", "sfg")), structure(c(2.07605224, 
48.77307843), class = c("XY", "POINT", "sfg")), structure(c(2.16026445, 
48.84105162), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT", 
"sfc"), precision = 0, bbox = structure(c(xmin = 2.05650642, 
ymin = 48.75044317, xmax = 2.53124065, ymax = 49.02966528
), class = "bbox"), crs = structure(list(epsg = 4326L, proj4string = "+proj=longlat 
+datum=WGS84 +no_defs"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr 
= structure(c(ID = NA_integer_, 
n = NA_integer_), .Label = c("constant", "aggregate", "identity"
), class = "factor"), row.names = c(380L, 433L, 312L, 257L, 464L, 
6L, 457L, 364L, 156L, 341L), class = c("sf", "data.frame"))

getImage <- function(n, ncol=10, proba = 1) {
    require(ggthemes)
    require(ggplot2)
    require(dplyr)
    num <- 1:n
    x <- num%%ncol
    y <- num%/%ncol
    df <- data.frame(x=x,y=y)
    df[nrow(df),] <- c(0,0)
    df <- df %>% arrange(y,x)
    df$dispo <- as.factor(c(rep(1,round(n*proba)),rep(0,(n-round(n*proba)))))

    ymax <- ifelse(n>ncol*10,n/ncol+1,ncol+1)

    #if we have a few points, let's center them
    if (n< ncol*10) df$y <- df$y + (ncol-(max(df$y)))/2

    g<- ggplot(df,aes(x=x,y=y, color=dispo))+
        # geom_point(shape="\UC6C3", colour="red",size=5)+
        geom_point(size=10,show.legend = F)+
        xlim(-1,ncol+1) + ylim(-1,ymax)+
        theme_void()+
        scale_fill_manual(values = c("green", "red"))
    g
}

plots <- lapply(employees_spdf$n,function(x) getImage(x,proba = .66))

for (i in 1:nrow(employees_spdf)) {
    filename <- paste("./tmp/",employees_spdf[i,]$ID,".png",sep="")
    ggsave(filename = filename,
           plot = plots[[i]],
           device = "png",
           width = 5, height = 5,
           units = "in", bg="transparent")}

filenames <- unlist(lapply(employees_spdf$ID, function(x) paste(paste("./tmp/",x,".png",sep=""))))
empIcons <- icons(
    iconUrl = filenames,
    iconWidth = 128,
    iconHeight = 128
)
leaflet() %>% 
    addTiles() %>% 
    addMarkers(data=employees_spdf,
               icons=empIcons)

Узким местом здесь в конечном итоге является необходимость сохранить каждый ggplot в виде файла, прочитать его, а затем использовать его в качестве значка.Для 500+ субрегионов загрузка занимает довольно много времени ... Суть проблемы, насколько я понимаю, заключается в том, что функция листовки MakeIcon может работать только с файлами, и я не могу передать ей список объектов ggplot.Таким образом, он бы работал намного быстрее, я полагаю ...

Решением здесь может быть сохранение ggplot для каждого региона перед загрузкой приложения и его чтение на лету, однако я подумал, что может быть более элегантновариант.Вы знаете один?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...