將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")

繪制此圖：