嵌套循环通过 R 中的结构化列表

Question

我有一个示例数据集garden，如下所示。真正的东西是数千行。我也有一个示例列表。 productFruit。考虑到garden 中报告的usage，我想知道每个fruit 的calories。我基本上想遍历表中的所有行，检查productFruit 列表中的用法是否为recorded，并返回calories 或以下错误消息之一：

• 如果在productFruit 列表中没有找到usage，则“使用超出范围”
• 如果在productFruit 列表中没有找到usage，则“水果超出范围”
• “错误数据”如果数据丢失

garden:

fruit = c("Apple", "Kiwi", "Banana", "Orange", "Blueberry")
usage = c("cooking", "cooking", "NA", "drinking", "medicine")
reported = c(200, 500, 77, 520, 303)

    garden <- cbind(fruit, usage, reported)
    garden <- as.data.table(garden)

productFruit:

productFruit <- list(Basket = c('DUH'), 
                type = list (
                  Apple = list(ID = 1,
                            color = "poor",
                            usage = list(eating = list(ID = 1,
                                                       quality = "good",
                                                       calories = 500),
                                         medicine = list(ID = 2,
                                                         quality = "poor",
                                                         calories = 300))),
                  Orange = list(ID = c(1,2,3),
                            color = c(3,4,5),
                            usage = list(eating = list(ID = 1,
                                                       quality = "poor",
                                                       calories = 420),
                                         cooking = list(ID = 2,
                                                        quality = "questionable",
                                                        calories = 600),
                                         drinking = list(ID = 3,
                                                         quality = "good",
                                                         calories = 800),
                                         medicine = list(ID = 4,
                                                         quality = "good",
                                                         calories = 0))),
                  Banana = list(ID = c(1,2,3),
                           color = c(3,4,5),
                           usage = list(cooking = list(ID = 1,
                                                      quality = "good",
                                                      calories = 49),
                                          drinking = list(ID = 2,
                                                          quality = "questionable",
                                                          calories = 11),
                                          medicine = list(ID = 3,
                                                          quality = "poor",
                                                          calories = 55)))))

我试图将其分解为更小的步骤并使用循环来执行此操作，但我对lists 的经验很少，并且遇到了很多错误。任何想法如何以有效且可读的方式解决这个问题？下面是我尝试匹配fruits 的众多尝试之一。我知道该字段不匹配，我只是想让循环运行...

for (i in seq_len(nrow(garden))){
  if (garden$fruit[i] == productFruit$type){
    garden$calories = productFruit$type[[i]]$ID
  } 
  garden$calories = "error"
}

想要的输出是这样的：

    fruit = c("Apple", "Kiwi", "Banana", "Orange", "Blueberry")
    usage = c("cooking", "cooking", "NA", "drinking", "medicine")
    reported = c(200, 500, 77, 520, 303)
    calories = c("usage out of scope", "fruit out of scope", "erroneous data", 800, "fruit out of scope")

garden_with_calories <- cbind(fruit, usage, reported, calories)
garden_with_calories <- as.data.table(garden)

Answer 1

从嵌套列表中提取数据可能非常繁琐。以下是一些适用于您提供的示例的代码，但如果您的条目与示例数据不同，可能仍然会遇到困难。您可能必须使其更健壮并检查数据是否具有您期望的 class 等。

library(tidyverse)

第 1 步：

我们创建了一段代码，一次提取一个水果：

# this creates a tibble with a column for each usage entry (eating, drinking,
# etc.)
type_df <- as.tibble(productFruit$type[[1]]$usage)

# With map*() we apply as.tibble() to each column to get a one-row data frame
# per "usage" case. We use map_dfr() in order to bind togeter the resulting
# rows into one dataframe. This is the line that might need to be made more
# robust in order to not fail on unexpected input.)
res <- map_dfr(type_df, as.tibble, .id = "usage")

# When there is no usage entry, `res` will be empty and we create a dummy
# dataframe for that case that has `NA` for the "colories" column.
if (nrow(res) < 1)
  tibble(calories = NA)
else
  res

第 2 步：

现在我们把前面几行放到一个函数中，这样我们就可以把它应用到所有水果上。

extract_fruit_data <-
  function(fruit) {
    type_df <- as.tibble(fruit$usage)
    res <- map_dfr(type_df, as.tibble, .id = "usage")
    if (nrow(res) < 1)
      tibble(calories = NA)
    else
      res
  }

第 3 步：

我们将extract_fruit_data 应用到每个水果的入口并绑定在一起 使用map_dfr() 生成的行。然后我们删除并重命名一些变量， 为下一步做准备。

fruits_df <-
  map_dfr(productFruit$type, extract_fruit_data, .id = "type") %>%
  select(-ID, -quality) %>% 
  rename(fruit = type)

第四步：

我们将两个数据集与left_join() 连接起来，这样花园中的每个条目， 保留，并且 fruits_df 中不匹配的那些条目将获得 NA 在卡路里栏中。使用case_when()，我们对每一列进行分类， 根据您的要求

left_join(garden, fruits_df) %>% 
  mutate(calories = case_when(
    usage == "NA" ~ "erroneous data",
    !fruit %in% fruits_df$fruit ~ "fruit out of scope",
    is.na(calories) ~ "usage out of scope",
    TRUE ~ as.character(calories)
  ))

Answer 2

我在Base R 中编写了这段代码，它只查找并报告实际存在的水果及其各自的用途。我知道这不完全是你要求的，但当我意识到这有点太晚了。这是与其他提议的解决方案截然不同的方法。

FruitNames <- unlist(lapply(productFruit,names)[2])

UsageByFruit <- lapply(FruitNames, function(X) names(productFruit[["type"]][[X]][["usage"]]))
LengthByFruit<- lapply(UsageByFruit, length)

gardenlength <- sum(unlist(LengthByFruit))
garden <- data.frame(matrix(ncol=3,nrow=gardenlength, dimnames=list(NULL, c("Fruit", "Usage", "Calories"))))

garden[,2] <- unlist(UsageByFruit)
garden[,1] <- unlist(lapply(1:length(FruitNames), function(X) replicate(LengthByFruit[[X]],FruitNames[X])))
garden[,3] <- unlist(lapply(1:length(FruitNames), function(X) unlist(lapply(unlist(UsageByFruit[X]), function(Y) productFruit[["type"]][[FruitNames[X]]][["usage"]][[Y]][["calories"]]  ))))

输出：

> garden
   Fruit    Usage Calories
1  Apple   eating      500
2  Apple medicine      300
3 Orange   eating      420
4 Orange  cooking      600
5 Orange drinking      800
6 Orange medicine        0
7 Banana  cooking       49
8 Banana drinking       11
9 Banana medicine       55

Answer 3

更新

对于大型数据集，不推荐使用for 循环。以下代码是替代方法

第 1 步检查产品列表中是否存在水果

fruitExist <- fruit %in% names(productFruit$type)  

第2步对每种水果，检查产品列表中是否存在相应的用法

usageExist <- sapply(fruit, function(f){
  sapply(usage, `%in%`, x = names(productFruit$type[[f]][["usage"]]))})
usageExist <- as.data.frame(unique(sapply(usageExist[sapply(usageExist, is.logical)], colSums)))
usageExist$usage <- row.names(usageExist)

第 3 步提取卡路里

calories <-  data.frame(unique(
                  sapply(fruit, function(f){
                    sapply(usage, function(u){productFruit$type[[f]][["usage"]][[u]][["calories"]]})}
                    )))

calories <- unlist(as.data.frame(unique(
  sapply(fruit, function(f){
    sapply(usage, function(u){productFruit$type[[f]][["usage"]][[u]][["calories"]]})}
  ))))

calories <- as.data.frame(calories)
names(calories) <- "cal"
calories$fruitUsage <- row.names(calories)

第 4 步合并并完成

library(tidyverse) 

garden %>%
  mutate(fruitExist = fruitExist) %>%
  left_join(usageExist %>% pivot_longer(-usage, names_to = "fruit", values_to = "usageExist")) %>%
  left_join(calories %>% separate(fruitUsage, c("fruit","usage"))) %>%
  mutate(calories = case_when(
    fruit == "NA" | usage == "NA" ~ "erroneous data",
    usageExist == FALSE ~ "usage out of scope",
    fruitExist == FALSE ~ "fruit out of scope",
    TRUE ~ as.character(cal))) %>%
  select(fruit, usage, reported, calories)

输出

garden

#       fruit    usage reported           calories
# 1     Apple  cooking      200 usage out of scope
# 2      Kiwi  cooking      500 fruit out of scope
# 3    Banana       NA       77     erroneous data
# 4    Orange drinking      520                800
# 5 Blueberry medicine      303 fruit out of scope

---

以前的代码

试试这个：

cal <- as.character()

for(i in 1:length(fruit)){
  fruitName <- fruit[i]
  usageName <- usage[i]

  if(fruitName == "NA" | usageName == "NA") {
    out <- "erroneous data"
  } else if(!(fruitName %in% names(productFruit[["type"]]))){
    out <- "fruit out of scope"
  } else if(!(usageName %in% names(productFruit[["type"]][[fruitName]][["usage"]]))){
    out <- "usage out of scope"
  } else {
    out <- productFruit[["type"]][[fruitName]][["usage"]][[usageName]][["calories"]]
  }

  cal <- c(cal, out)
}

garden$calories <- cal

garden

#        fruit    usage reported           calories
# 1:     Apple  cooking      200 usage out of scope
# 2:      Kiwi  cooking      500 fruit out of scope
# 3:    Banana       NA       77     erroneous data
# 4:    Orange drinking      520                800
# 5: Blueberry medicine      303 fruit out of scope