在使用 lapply 创建的绘图对象列表中创建不同类型的绘图

Create different types of plots within list of plot objects created with lapply

我有一个函数可以根据来自 mtcars

的 'gear' 的唯一值创建绘图列表
library(datasets) 
library(magrittr)
library(ggplot2)
library(dplyr)

make_plots <- function(data) {

  ### create list of plot objects for every unique value of 'gear' (from mtcars)
  p_list <- lapply(sort(unique(data$gear)), function(i) {

    ggplot2::ggplot(data[data$gear == i,], ggplot2::aes(x = wt, y = mpg, color = factor(cyl))) +
      ggplot2::geom_point() +
      ggplot2::facet_wrap(~ gear) +
      ggplot2::scale_color_discrete(name = "cyl")
  })

  p_list
}

### output list of plots
example_output <- make_plots(mtcars)

我想要什么: 基于 'gear' 的唯一值的绘图列表,但根据每个 'gear' 值的关联 'plot_type' 具有不同类型的绘图输出,我将其创建为 mtcars 数据框中的另一列。地块数量相同,但地块类型不同。

### create new column of 'plot_type', where every unique gear value has the same 'plot_type', i.e., 
### all gears of 3 are of type 'scatter', all gears of 4 are of type 'bar', and all gear of 5 are of type 
### 'log' 
mtcars %>%
  dplyr::mutate(plot_type = case_when(
    gear == 3 ~ "scatter",
    gear == 4 ~ "bar",
    gear == 5 ~ "log"
  ))

我设想的大致如下所示,但显然遇到了麻烦。

make_plots <- function(data) {
  
  ### creates list of dataframes, with one dataframe per unique value of 'plot_type'
  split_data <- data %>% 
    dplyr::group_split(plot_type)
  
  p_type <- lapply(split_data[split_data$plot_type == i,], function(i) {
    
    if(split_data[split_data$plot_type == "scatter"]) {
      
      p_list <- lapply(sort(unique(split_data$gear)), function(i) {
        
        ggplot2::ggplot(split_data[split_data$gear == i,], ggplot2::aes(x = wt, y = mpg, color = factor(cyl))) +
          ggplot2::geom_point() +
          ggplot2::facet_wrap(~ gear) 
        
      })
      
      p_list

    }
  })
  
  p_type
}

与其将所有内容都放在一个函数中,不如

  1. 按照您的第一个 make_plots 函数对每种绘图类型使用单独的函数。

  2. 为调用绘图类型函数的外循环创建一个包装器,我使用 purrr::imap 而不是 lapply 来传递绘图类型的名称。

注意:我去掉了日志类型,只用散点图和条形图说明了方法。

library(ggplot2)
library(dplyr)
library(purrr)

mtcars2 <- mtcars %>%
  dplyr::mutate(plot_type = case_when(
    gear == 3 ~ "scatter",
    gear %in% c(4, 5) ~ "bar"
  ))

make_scatter <- function(data) {
  lapply(sort(unique(data$gear)), function(i) {
    ggplot2::ggplot(data[data$gear == i, ], ggplot2::aes(x = wt, y = mpg, color = factor(cyl))) +
      ggplot2::geom_point() +
      ggplot2::facet_wrap(~gear) +
      ggplot2::scale_color_discrete(name = "cyl")
  })
}

make_bar <- function(data) {
  lapply(sort(unique(data$gear)), function(i) {
    ggplot2::ggplot(data[data$gear == i, ], ggplot2::aes(x = cyl, fill = factor(cyl))) +
      ggplot2::geom_bar() +
      ggplot2::facet_wrap(~gear) +
      ggplot2::scale_color_discrete(name = "cyl")
  })
}

make_plots <- function(data) {
  split_data <- split(data, data$plot_type)

  p_type <- purrr::imap(split_data, function(x, plot_type) {
    if (plot_type == "scatter") {
      make_scatter(x)
    } else if (plot_type == "bar") {
      make_bar(x)
    }
  })

  p_type
}

make_plots(mtcars2)
#> $bar
#> $bar[[1]]

#> 
#> $bar[[2]]

#> 
#> 
#> $scatter
#> $scatter[[1]]