вложенные циклы через структурированный список в R - PullRequest
Новая
       43

вложенные циклы через структурированный список в R

0 голосов
/ 26 марта 2020

У меня есть пример набора данных, garden, как показано ниже. Реальная вещь - тысячи строк. У меня также есть список примеров. productFruit. Я хочу знать calories каждого fruit, учитывая usage, указанный в garden. Я в основном хочу, чтобы l oop прошел по всем строкам в моей таблице, проверил, является ли использование recorded в списке productFruit, и возвращает либо calories, либо одно из следующих сообщений об ошибке:

  • "использование вне области", если в списке productFruit не найдено usage
  • "использование вне области", если в productFruit не найдено usage list
  • "ошибочные данные", если данные отсутствуют

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. Я знаю, что поле не совпадает, я просто пытался заставить l oop работать вообще ... 

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)

Ответы [ 3 ]

1 голос
/ 26 марта 2020

Извлечение данных из вложенных списков может быть очень утомительным. Вот некоторый код, который работает для предоставленного вами примера, но все еще может не справиться, если у вас есть записи, которые отличаются от данных примера. Вам, вероятно, придется сделать его более надежным и убедиться, что данные имеют class, который, как вы ожидаете, будет c. 

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)

Шаг 4:

Мы объединяем два набора данных с 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)
  ))
1 голос
/ 27 марта 2020

Я сделал этот код в 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
1 голос
/ 26 марта 2020

Обновление

Для большого набора данных for l oop не рекомендуется. Следующие коды являются альтернативой

Шаг 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
...