我如何在 R 中矢量化(自动化)绘图创建

how do i vectorise (automate) plot creation in R

编辑以包含示例数据: Sample data

我一直在尝试编写代码来从大型数据集中生成和保存多个图,但不得不承认失败。如果可能的话会喜欢一些帮助.. 我有 4 年每日监测数据的 df (dat)(采样年为 7 月至 6 月,因此 Sampling.Year 表示法为 YYYY-YYYY)。我想为每个 SITENAME 导出 jpg,带有 facet wrap/facet 网格,因此每个 Sampling.Year 都是垂直堆叠的。单个 Sampling.Year 图显示全年的时间序列数据(x=DATE,y = Daily.Ave.PAF)。最终结果应该是单独的 jpg 文件(SITENAME 保存在文件名中),采样年份堆叠但 DATE(x 轴)对齐。这样我们就可以快速了解一段时间内的差异。字符串在下面,我的(可能是蹩脚的)代码在它下面。该代码可以很好地导出图,但数据似乎混淆了 - 即 SITENAME 只有 2 Sampling.Years 的数据价值,jpg 中应该只有 2 个图,但此代码产生 4...这显然是错误的,但我不知道如何解决。提前致谢。

'data.frame':   521 obs. of  6 variables:
 $ STATION      : chr  "1240062" "125013A" "122013A" "126001A" ...
 $ SITENAME     : chr  "Oconnell River at Caravan Park" "Pioneer River at Dumbleton Weir Headwater" "Proserpine River at Glen Isla" "Sandy Creek at Homebush" ...
 $ Sampling.Year: chr  "2016-2017" "2018-2019" "2018-2019" "2018-2019" ...
 $ DATE         : Date, format: "2017-02-01" "2019-02-01" "2019-02-01" "2019-02-01" ...
 $ Daily.Ave.PAF: num  24.344 15.226 45.529 44.936 0.208 ...
 $ Site.Year    : chr  "Oconnell River at Caravan Park_2016-2017" "Pioneer River at Dumbleton Weir Headwater_2018-2019" "Proserpine River at Glen Isla_2018-2019" "Sandy Creek at Homebush_2018-2019" …

代码:

for(i in 1:length(dat)){
   png(filename = paste("N:/Projects and project proposals/", dat$SITENAME[i], ".png", sep=""), width = 1500, height = 1000)
   print({pesticidePlot <- ggplot(dat, aes(DATE, Daily.Ave.PAF)) +
     geom_point(aes(colour = Daily.Ave.PAF)) +
     scale_colour_gradientn(colours=c("dark green","yellow","orange", "red"), 
                            breaks=c(5,10,20), labels=format(c("5", "10", "20"))) +
     facet_wrap(~Sampling.Year, ncol = 1,scales="free") +
          labs(x = "Month", y = "Total PAF (% affected)") +
     scale_x_date(breaks = "1 month", labels = date_format("%B")) +
     theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))})
   dev.off()
 }

这段代码可以帮到你。我已经使用了你包含的数据(只需定义一个目录来保存图表):

library(tidyverse)
#Data
dat <- read.csv('Sample.csv',stringsAsFactors = F)
dat$DATE <- as.Date(dat$DATE,'%d/%m/%Y')
#Create a list
List <- split(dat,dat$SITENAME)
#Function for plots
myplot <- function(x)
{
  pesticidePlot <- ggplot(x, aes(DATE, Daily.Ave.PAF)) +
    geom_point(aes(colour = Daily.Ave.PAF)) +
    scale_colour_gradientn(colours=c("dark green","yellow","orange", "red"), 
                           breaks=c(5,10,20), labels=format(c("5", "10", "20"))) +
    facet_wrap(~Sampling.Year, ncol = 1,scales="free") +
    labs(x = "Month", y = "Total PAF (% affected)") +
    scale_x_date(breaks = "1 month", labels = scales::date_format("%B-%y")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
    ggtitle(unique(x$SITENAME))
  return(pesticidePlot)
}
#Create plots
List2 <- lapply(List,myplot)
#Export
namesvec <- paste0(names(List2),'.png')
mapply(ggsave, List2,filename=namesvec,width = 15,units = 'cm')

该代码将创建下一个地块:

如果您需要更个性化的绘图,您可以修改myplot

这是一个解决方案,可以保存在 lapply 循环中创建的绘图。然后在另一个循环中写入文件,这次使用 mapply.

下例中文件保存在工作目录下,随意更改。

library(ggplot2)

SITENAME_plot <- function(X){
  ggplot(X, aes(DATE, Daily.Ave.PAF)) +
    geom_point(aes(colour = Daily.Ave.PAF)) +
    scale_colour_gradientn(colours=c("dark green","yellow","orange", "red"), 
                           breaks=c(5,10,20), labels=format(c("5", "10", "20"))) +
    labs(x = "Month", y = "Total PAF (% affected)") +
    scale_x_date(breaks = "1 month", labels = scales::date_format("%B")) +
    facet_wrap(~Sampling.Year, ncol = 1, scales = "free") +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
}

SITENAME_plot_write <- function(name, g, dir = "N:/Projects and project proposals"){
  flname <- file.path(dir, name)
  flname <- paste0(flname, ".png")
  png(filename = flname, width = 1500, height = 1000)
  print(g)
  dev.off()
  flname
}

dat$DATE <- as.Date(dat$DATE, format = "%d/%m/%Y")

sp <- split(dat, dat$SITENAME)
gg_list <- sapply(sp, SITENAME_plot, simplify = FALSE)
mapply(SITENAME_plot_write, names(gg_list), gg_list, MoreArgs = list(dir = getwd()))

rm(sp)  # final clean-up