如何使用 R 中的 ifelse 函数使 lapply 遍历列表？

Question

我有两个不同的列表，我希望根据它们所在的列表输出不同的图。这是我用来绘图的两个函数。

daily_active_users <- function(data, site_name) {
ggplot(data, aes(x = opened_dates, y = num_active_users, fill = "Blue")) + geom_col() + theme(legend.position = "none") +
labs(title = paste0(site_name, ": Daily # Active Users"), y = "# Active Users")}

如果用户在以下数据框中，这是我要输出的图

df_table <- data.frame(site_name = c("User1", "User2", "User3"), opened_dates = c("2021-07-01", "2021-08-02", "2021-09-03"), num_active_users = c(5, 18, 11))

如果用户不在这个df中，我想用这个函数来绘图

default_plot <- function(data, site_name) {
 p <- ggplot(data, aes(NULL, NULL)) +
 geom_blank() +
 theme_void() 

 ggdraw(p) + 
 draw_label("No Data Available", colour = "#80404080", size = 50) }

此图将基于此数据框

all_sitesList <- data.frame(site_name = c("User1", "User2", "User3", "User4", "User5"))

如果用户在 df_table 数据框中但如果用户不在 df_table 数据框中，则现在我尝试使用 ifelse 函数绘制第一个图 (daily_active_users)，然后绘制第二个 default_plot 对象。

但是，当我这样做时， lapply 似乎没有通过列表。它只为 user1 输出东西。这是我正在使用的

plts <- function(site_name) {
ifelse(site_name %in% df_table$site_name,  lapply(df_table%>% 
distinct(site_name)%>%pull(site_name), function(x) daily_active_users(df_table, x)) %>% 
setNames(df_table$site_name), lapply(all_sitesList %>% distinct(site_name) %>% pull(site_name), 
function(x) default_plot(df_table, x)) %>%
setNames(all_sitesList$site_name))}

然后，例如，当我调用 User2 时，使用 plts("User2")，我会返回一个包含 User1 数据的图，如图顶部的标签所示

Answer 1

ifelse 函数将返回一个与您正在检查的条件长度相同的值，因此如果length(site_name %in% df_table$site_name) 为 1，您将只能返回一个值。例如

ifelse(5>0, 1:5, 10:20)
# [1] 1

只返回一个值并且

ifelse(c(-5,5)>0, 1:5, 10:20)
# [1] 10  2

只返回两个值。

在这种情况下，您应该只使用常规的 if() {} else {} 语句。

plts <- function(site_name) {
  if(site_name %in% df_table$site_name) {
    lapply(df_table %>%
             distinct(site_name) %>%
             pull(site_name), function(x)
               daily_active_users(df_table, x)) %>%
      setNames(df_table$site_name)    
  } else {
    lapply(all_sitesList %>% distinct(site_name) %>% pull(site_name),
           function(x)
             default_plot(df_table, x)) %>%
      setNames(all_sitesList$site_name)    
  }
}

为了让你可以传入多个 site_name，你可以这样做

plts <- function(site_name) {
  sites <- unique(site_name)
  lapply(sites, function(site) {
    if(site %in% df_table$site_name) {
      daily_active_users(df_table, site)
    } else {
      default_plot(all_sitesList, x)
    }
  }) %>% setNames(sites)
}