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

Question

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

我一直在尝试编写代码，从一个大型数据集中生成并保存多个绘图，并不得不承认失败。如果可能的话，我希望能得到一些帮助..我有一个4年的每日监测数据的df (dat) (采样年份是7-6月，所以Sampling.Year

表示法为YYYY-YYYY)。我想为每个SITENAME导出Sampling.Year，使用小平面包裹/小平面网格，以便每个jpgs垂直堆叠。单个Sampling.Year图显示了全年的时间序列数据(x=DATE，y= Daily.Ave.PAF)。最终结果应为单个jpg文件(SITENAME以文件名保存)，采样年份堆叠，但日期(x轴)对齐。这样，我们就可以快速了解随着时间的推移而产生的差异。字符串在下面，我的代码(可能很糟糕)在下面。代码可以很好地导出绘图，但数据似乎混淆了-例如，如果站点名称只有2 Sampling.Years的数据，那么在jpg中应该只有2个绘图，但此代码会生成4...这显然是错误的，但我不知道如何修复它。提前使用THanks。

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

Answer 1

此代码可以帮助您。我已经使用了您包含的数据(只需定义一个目录来保存绘图)：

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。

Answer 2

这是一个解决方案，它将保存在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