将R for循环的结果存储到对象中并使用Apply函数绘制图的问题

Question

问题是将来自for循环的图形存储为R中的向量。

我编写了一个函数，可以逐表绘制图形（见下文）。

# packages used
library(xlsx)
library(ggplot2)
library(tidyverse)
library(readxl)
library(ggplot2)
library(reshape2)

d1 <- data.frame(options = c("Strongly Agree", "Agree", "Disagree", "N/A",NA), foo2016 =
                   c(1, 4, 5, 6, NA), foo2017 = c(10, 7, 8, 9, NA), foo2018 = c(10, 7, 15, 14, NA))
d2 <- data.frame(options = c("options","Strongly Agree", "Agree", "Disagree", "N/A",NA),
                 foo2016 = c(11, 4, 3, 2, 1, NA), foo2017 = c(12, 6, 5, 4, 5, NA), foo2018 = c(10, 7, 6, 15, 14, NA))

mytables_in_a_list <- list(d1, d2)


x <- mytables_in_a_list

# where x = my tables in a list, n = table index in the list 
foo_graph <- function(x, n){
  tbl1 <- x[[n]]

  if(tbl1[1,1] != "Strongly Agree"){
    tbl1 <- tbl1[-1,]
  }

  #rename column
  names(tbl1) <- c("Options", "2016", "2017", "2018")

  # remove rofoo with NAs
  tbl1 <- tbl1 %>% drop_na()

  cols.num <- c("2016","2017", "2018")

  tbl1[cols.num] <- sapply(tbl1[cols.num],as.numeric)

  sapply(tbl1, class)

  # alternative to removing rofoo with NAs
  # na.omit(tbl)
  mdf <- melt(tbl1, value.name="value", variable.name="year", id.vars="Options")

  foo_graph <- ggplot(data=mdf, aes(x=year, y=value, group = Options, colour = Options)) +
    geom_line() +
    geom_point( size=4, shape=21, fill="white")

foo_graph
}

上面的代码工作正常。 但是，由于我有很多表（大约40个），我认为我可以通过使用for循环来重复绘图，从而将图形（大约40个）存储在单个R中来节省很多时间。宾语。 我已经尝试过for循环（请参见下面的代码），但是我得到的R对象为空，没有错误消息。

# packages used
library(xlsx)
library(ggplot2)
library(tidyverse)
library(readxl)
library(ggplot2)
library(reshape2)

x <- mytables_in_a_list
foo_graph <- list()
for (i in length(x)){
tbl1 <- x[[i]]

# delete table 1st row if the 1st element in the 1st row is not "Strongly Agree" 
if(tbl1[1,1] != "Strongly Agree"){
  tbl1 <- tbl1[-1,]
}

#rename column
names(tbl1) <- c("Options", "2016", "2017", "2018")

# remove rows with NAs
tbl1 <- tbl1 %>% drop_na()

# change "2016","2017", "2018" columns to numeric
cols.num <- c("2016","2017", "2018")
tbl1[cols.num] <- sapply(tbl1[cols.num],as.numeric)

# melt the table
mdf <- melt(tbl1, value.name="value", variable.name="year", id.vars="Options")

# plot the graph with ggplot
foo_graph[[i]] <- ggplot(data=mdf, aes(x=year, y=value, group = Options, colour = Options)) +
  geom_line() +
  geom_point( size=4, shape=21, fill="white")
}

foo_graph

我也知道可以使用lapply函数来做同样的事情。 我尝试了mapply，因为我的函数有两个参数，但是不幸的是，我收到了下面的错误。

> mapply(x, foo_graph, n)
Error in get(as.character(FUN), mode = "function", envir = envir) : 
  object 'alistoftables' of mode 'function' was not found

我希望输出是存储在R对象中的图，这样，如果我查询对象中的第3个元素（例如foo_graph[3] ，则将显示该对象中的第3个图。 但是，显示的内容不是预期的结果。

> foo_graph[3]
[[1]]
NULL

Answer 1

没有您的数据，我们将无法重现该行为。 但是这里有一些示例代码可以做到这一点。 我使用purrr::map而不是循环或apply系列，但是您可以用lapply替换map并获得相同的结果。

library(tidyverse)
library(cowplot) # to plot a list of plots

# create some fake data
# make a vector for table size
sz <- 21:60

# function to make data frames
make_tbl <- function(size) {
  a <- sample(x = 1:50, size = size, replace = TRUE)
  b <- sample(x = LETTERS[1:3], size = size, replace = TRUE)
  return(tibble(a,b))
}

# a list of tables
list_of_tbls <- map(sz, make_tbl )

# function to plot
make_plot <- function(tbl) {
  ggplot(data=tbl) + geom_boxplot(aes(x=b, y=a, fill=b))
}

# make plot for all tables
list_of_plots <- map(list_of_tbls, make_plot)

# plot (all 40 if on a big screen)
cowplot::plot_grid(plotlist = list_of_plots[1:8], nrow=2)

一种替代方法是按行绑定表，并使用构面进行打印。 当然，表应该具有相同的列。 这里的参数.id将创建一列tbl来跟踪该表，因此按40个表进行刻面操作非常简单。

# alternative to bind the tables if they have the same columns
bound_tbls <- bind_rows(list_of_tbls, .id = "tbl")

# then plot with facet
ggplot(bound_tbls) + geom_boxplot(aes(x=b, y=a, fill=b)) + facet_wrap("tbl", ncol=8)

编辑：与OP的代码和数据 。 略微修改了绘图功能以匹配虚拟数据。 注意最后使用cowplot::plot_grid 。 但是，如果您只运行all_graphs[[graph_number]]则应该能够使图一一显示。

# library(xlsx)
library(ggplot2)
library(tidyverse)
library(readxl)
library(ggplot2)
library(reshape2)

d1 <-
  data.frame(
    options = c("Strongly Agree", "Agree", "Disagree", "N/A", NA),
    foo2016 =
      c(1, 4, 5, 6, NA),
    foo2017 = c(10, 7, 8, 9, NA)
  )
d2 <-
  data.frame(
    options = c("options", "Strongly Agree", "Agree", "Disagree", "N/A", NA),
    foo2016 = c(11, 4, 3, 2, 1, NA),
    foo2017 = c(12, 6, 5, 4, 5, NA)
  )

mytables_in_a_list <- list(d1, d2)

# where x = my tables in a list, n = table index in the list
foo_graph <- function(x, n) {
  tbl1 <- x[[n]]

  if (tbl1[1, 1] != "Strongly Agree") {
    tbl1 <- tbl1[-1, ]
  }

  #rename column
  # edited to match input data that doesn't have 2018
  names(tbl1) <- c("Options", "2016", "2017")

  # remove rofoo with NAs
  tbl1 <- tbl1 %>% drop_na()

  # edited to match input data that doesn't have 2018
  cols.num <- c("2016", "2017")

  tbl1[cols.num] <- sapply(tbl1[cols.num], as.numeric)

  sapply(tbl1, class)

  # alternative to removing rofoo with NAs
  # na.omit(tbl)
  mdf <-
    melt(
      tbl1,
      value.name = "value",
      variable.name = "year",
      id.vars = "Options"
    )

  foo_graph <-
    ggplot(data = mdf, aes(
      x = year,
      y = value,
      group = Options,
      colour = Options
    )) +
    geom_line() +
    geom_point(size = 4,
               shape = 21,
               fill = "white")

  foo_graph
}

all_graphs <-
  lapply(1:length(x), function(i)
    foo_graph(x = mytables_in_a_list, n = i))

# plot all of them
library(cowplot)
pp <- plot_grid(plotlist = all_graphs,
          align = "hv",
          axis = "ltbr")

# to save:
# ggsave(pp, filename = "all_plots.pdf", width=10, height=5)

要查看一起绘制的图，只需调用pp对象：

pp

在拥有all_graphs ，您应该可以通过调用以下命令查看各个图：

all_graphs[[1]]

如果仅调用all_graphs仅在显示窗口中看到最后一个图，因为每个图都会显示并替换为以下内容。 在Rstudio中，您可以在显示窗格中向后浏览以查看列表中的先前图。

> all_graphs
[[1]]

[[2]]

**编辑2：使用cowplot面而不是cowplot 。 使用40张桌子应该可以更好地工作。 仍然有一个问题是，是否有一种方法可以从40个表中的每一个中汇总/提取出有趣的信息，并绘制一个汇总图。 而不是绘制40次调查的原始结果。

library(tidyverse)

d1 <-
  data.frame(
    options = c("Strongly Agree", "Agree", "Disagree", "N/A", NA),
    foo2016 =
      c(1, 4, 5, 6, NA),
    foo2017 = c(10, 7, 8, 9, NA)
  )
d2 <-
  data.frame(
    options = c("options", "Strongly Agree", "Agree", "Disagree", "N/A", NA),
    foo2016 = c(11, 4, 3, 2, 1, NA),
    foo2017 = c(12, 6, 5, 4, 5, NA)
  )

mytables_in_a_list <- list(d1, d2)

# combine into a single table
mytables_df <- bind_rows(mytables_in_a_list, .id="table")

# a single chain instead of function. 
# You could make this a function, but not necessary

mytables_df %>%
  drop_na() %>%
  rename("Options" = options,
         "2016" = foo2016,
         "2017" = foo2017) %>%
  filter(Options %in% c("Strongly Agree", "Agree", "Disagree", "N/A")) %>%
# make sure the options are ordered appropriatelly
  mutate(Options = factor(Options, levels = c(
    "Strongly Agree", "Agree", "Disagree", "N/A"
  ))) %>%
# using `gather` instead of `melt`, but its the same operation
  gather("Year", "Value", -table, -Options) %>% 
  ggplot(data = ., aes(x=Year, y=Value, group=Options, color=Options)) +
  geom_line() +
  geom_point() +
  facet_wrap("table", ncol=2) +
  theme(legend.position = "top")

绘制此图：