R - 无法在 lapply 函数中进行 rbind答案

【问题标题】：R -- Cannot rbind In lapply functionR - 无法在 lapply 函数中进行 rbind
【发布时间】：2018-12-04 05:54:28
【问题描述】：

我从构建一个空数据框开始：

results <- data.frame(ID=numeric(0), StartDate=numeric(0), term_type=character(0), EndDate=numeric(0), stringsAsFactors = FALSE)

然后我有一个唯一 ID 号列表： uniqueIds

我有一个函数getDataForGivenId，它生成格式为：

的数据框：

ID, StartDate, term_type, EndDate

我需要代码为每个 ID 调用函数 getDataForGivenId 并将结果数据帧附加到空数据帧 results。

我试过了：

library(dplyr)

results <- bind_rows(results, (lapply(uniqueIds, getDataForGivenId)))

和

do.call("rbind", lapply(uniqueIds, getDataForGivenId))

和

for (Id in uniqueIds) {
    Y <- getDataForGivenId(Id)
    results <- rbind(results, Y) 
}

每次我得到一个空的 results 数据框。

请注意，如果我将事情从循环中取出并简单地执行代码：

Y <- getDataForGivenId(1234)
results <- rbind(results, Y)

我得到了我期望的输出。

有谁知道我做错了什么？

编辑 -- 我的完整脚本如下。

library(dplyr)
library(lubridate)

enVariables <- Sys.getenv()
username    <- enVariables[["DB_USERNAME"]]
password    <- enVariables[["DB_PASSWORD"]]

results <- data.frame(ID=numeric(0), StartDate=numeric(0), term_type=character(0), EndDate=numeric(0), stringsAsFactors = FALSE)

getConnection <- function(){
  require(RMySQL)
  username <- username
  password <- password 
  con <- dbConnect(
    MySQL(), user=username, password=password, 
    dbname='database', host='host', port=port
  )
  return(con)
}

queryuniqueIds <- "SELECT DISTINCT(id) FROM table LIMIT 5"
con                <- getConnection()
uniqueIds      <- dbGetQuery(con, queryuniqueIds)
dbDisconnect(con)

getDataForGivenID <- function(idNumber) {
  queryData <- paste0(
    "SELECT ",
    "Id, bill_date, bill_hour ",
    "FROM table ",
    "WHERE id = ", idNumber
  ) 
  con <- getConnection()
  Data <- dbGetQuery(con, queryData)
  dbDisconnect(con)
  X <- Data %>% 
    select(ID, bill_date, bill_hour) %>%
    mutate(
      bill_date_x = ymd_hms(bill_date)
    ) %>% 
    arrange(ID, bill_date, bill_hour)
  hour(X$bill_date_x) <- X$bill_hour
  X <- X %>% 
    mutate(
      lag_x     = lag(bill_date_x, 1),
      lag_diff  = difftime(bill_date_x,lag_x, units = "hours") %>% as.integer(),
      lead_x    = lead(bill_date_x, 1),
      lead_diff = difftime(lead_x, bill_date_x, units = "hours") %>% as.integer()
    )
  Y <- X %>% 
    filter(
      is.na(lag_diff) | 
        is.na(lead_diff) | 
        !(lag_diff == 1 & lead_diff == 1),

      is.na(lag_diff) | 
        is.na(lead_diff) | 
        !(lag_diff == 0 | lead_diff == 0)
    ) %>% 
    mutate(
      term_type = "N",
      term_type = replace(term_type, lead_diff == 1, "S"),
      term_type = replace(term_type, lag_diff  == 1, "E")
    )
  Y <- Y %>%
    select(ID, bill_date_x, term_type) %>% 
    mutate(
      lead_date = lead(bill_date_x, 1)
    )  %>% 
    filter(term_type == "S")
  colnames(Y) <- c("ID", "StartDate", "term_type", "EndDate")
  return(Y)
}

do.call("rbind", lapply(uniqueIds, getDataForGivenID))
View(results)

【问题讨论】：

我要检查的第一件事是getDataForGivenId 是否实际上返回非空数据帧。
它正在返回填充的数据帧，我检查了。
在这种情况下，如果没有更可重复的示例，我们可能无法帮助或猜测其他事情。因为 if lapply 实际上是返回一个非空数据帧的列表，所以 do.call 行 will 工作，这向我表明还有其他事情发生我们不知道的。
寻求帮助时，您应该包含一个简单的reproducible example，其中包含可用于测试和验证可能解决方案的示例输入和所需输出。
这很难解决。我们基本上仍然必须相信lapply(uniqueIds, getDataForGivenID) 成功返回非空数据帧列表。但是，如果我只是用您指定的列创建一个非空数据框列表，do.call("rbind",...) 每次测试时都非常适合我。这里的“可重现”部分试图帮助您完成调试过程。运行lapply(uniqueIds, getDataForGivenID) 并通过dput 分享实际输出。

标签： r dataframe lapply rbind

【解决方案1】：

我终于找到了我的问题。

uniqueIds 的列表长度为 1。R 将整个列表作为一次传递，导致 SQL 语句只返回第一个 id 的数据。

我变了

uniqueIds <- dbGetQuery(con, queryuniqueIds)

到

uniqueIds <- as.data.frame(dbGetQuery(con, queryuniqueIds))

和

do.call("rbind", lapply(uniqueIds, getDataForGivenId))

到

results <- do.call("rbind", lapply(uniqueIds$id, getDataForGivenId))

现在一切正常。感谢那些帮助过的人。

【讨论】：