Question

我有一个带有子区域的区域。对于每个子区域，我都有一个简单的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并即时读取它们，但是我认为可能会有一个更优雅的选择。你认识一个吗？

有没有办法将ggplots绘制在传单上而不将其保存在光盘上？

0 个答案: