Использование lapply в сочетании с операторами for и if..else для добавления условного столбца к нескольким фреймам данных

Question

Скажем, у меня есть 2 кадра данных, каждый с двумя столбцами 'pic_type' и 'roi' (на самом деле у меня намного больше блоков данных, но для этого примера будет работать 2)

a <- setNames(data.frame(matrix(ncol = 2,nrow =6)), c("pic_type","roi"))
b <- setNames(data.frame(matrix(ncol = 2,nrow =6)), c("pic_type","roi"))

В каждом кадре данных 'pic_type 'может быть одним из двух строковых значений (' item ',' ratio '),' roi 'может быть одним из трех (' object ',' ratio ',' pic '). Например (извините за плохое кодирование)

a$pic_type <- c("item", "item", "item","relation","relation","relation")
a$roi <- c("object", "object", "pic", "object", "relation","relation")
b$pic_type <- c("item", "item", "item","relation","relation","relation")
b$roi <- c("relation", "relation", "object", "pic", "pic","object")

Что дает:

'a'
 pic_type      roi
 item          object
 item          object
 item          pic
 relation      object
 relation      relation
 relation      relation

'b'
 pic_type      roi
 item          relation
 item          relation
 item          object
 relation      pic
 relation      pic
 relation      object

И поместить их в список

myList <- list(a,b)

Теперь я хочу использовать lapplyпросмотреть все df в списке и создать новый столбец с именем «type», который содержит одно из трех значений в строке («busy», «empty» или «nil»). Эти значения основаны на следующем:

If pic_type = "item" & roi = "object", then type = "occupied"
If pic_type = "relation" & roi = "relation", then type = "occupied"
If pic_type = "item" & roi = "relation", then type = "empty"
If pic_type = "relation" & roi = "object", then type = "empty"
Otherwise type = "nil"

Например:

 'a'
 pic_type      roi        type
 item          object     occupied
 item          object     occupied
 item          pic        nil
 relation      object     empty
 relation      relation   occupied
 relation      relation   occupied

Я пробовал следующее:

myList <- lapply(myList, function(x) for(row in 1:dim(x)[1]) { 
   if(as.data.frame(x)[row,1] == "item" && as.data.frame(x)[row,2]=="object") {as.data.frame(x)[row,3] == "occupied"}  
   else if(as.data.frame(x)[row,1] == "relation" && as.data.frame(x)[row,2]=="relation") {as.data.frame(x)[row,3] == "occupied"} 
   else if(as.data.frame(x)[row,1] == "item" && as.data.frame(x)[row,2]=="relation") {as.data.frame(x)[row,3] == "empty"} 
   else if(as.data.frame(x)[row,1] == "relation" && as.data.frame(x)[row,2]=="object") {as.data.frame(x)[row,3] == "empty"}
   else {as.data.frame(x)[row,3] == "null"}})

Однако это выдает ошибку:

Error in if (as.data.frame(x)[row, 1] == "item" && as.data.frame(x)[row,  : 
  missing value where TRUE/FALSE needed

Кто-нибудь может предложить решение? Я знаю, что всего с двумя dfs легче сделать это без лапы, но у меня есть много dfs в фактическом списке и я хочу применить эту функцию к каждому из них.

Заранее спасибо!

Answer 1

Добро пожаловать в stackoverflow.

R работает немного иначе, чем другие программные пакеты, и полезно отметить, что есть две команды 'if / else'. Пожалуйста, смотрите else if () {} VS ifelse () для описания. Как и многие команды в R, ifelse векторизовано, что означает, что он примет вектор и выведет вектор - т.е. нет необходимости явно указывать ему запускать строку за строкой во фрейме данных.

Для вашего примера вы хотите использовать ifelse() или, что еще лучше, команду case_when из библиотеки dplyr (из коллекции tidyverse https://www.tidyverse.org/), которая позволяет тестировать несколькоусловия (см. https://community.rstudio.com/t/case-when-why-not/2685/2 для общего обсуждения опций). Ниже я также использую команду base within, но могу также использовать команду mutate из библиотеки dplyr.

library(dplyr)

a <- data.frame(
  pic_type = c("item", "item", "item","relation","relation","relation"),
  roi = c("object", "object", "pic", "object", "relation","relation")
)

b <- data.frame(
  pic_type = c("item", "item", "item","relation","relation","relation"),
  roi = c("relation", "relation", "object", "pic", "pic","object")
)

myList <- list(a = a, b = b)

myList <- lapply(myList, function(x) {

    x <- within(x, {
      type = case_when(
        (pic_type == "item" & roi == "object") |
          (pic_type == "relation" & roi == "relation") ~ "occupied",
        (pic_type == "item" & roi == "relation") | 
          (pic_type =="relation" & roi == "object") ~ "empty",
        TRUE ~ "nil")        
    })

  return(x)

})

myList$a

Answer 2

Поскольку элементы списка, который вы перебираете, уже являются фреймами данных, я бы предложил пропустить второй цикл по строкам и выполнить назначения непосредственно на основе целых столбцов:

myList <- lapply(myList, function(x) {
    x$type = "nil"
    x$type[x$pic_type== "item" && x$roi=="object" ]  ="occupied"
    x$type[x$pic_type== "relation" && x$roi=="relation" ]  ="occupied"
    x$type[x$pic_type== "item" && x$roi=="relation" ]  ="empty"
    x$type[x$pic_type== "relation" && x$roi=="object" ]  ="empty"
    return(x)
} 

Также для установки используемого вами типа==, который выполняет сравнения, но для назначений вы должны использовать один =.

Answer 3

Это работает с использованием фрейма данных в качестве таблицы сопоставления, а не ваших операторов if-then

# first lets build your data frames in a list
a <- setNames(data.frame(matrix(ncol = 2,nrow =6)), c("pic_type","roi"))
b <- setNames(data.frame(matrix(ncol = 2,nrow =6)), c("pic_type","roi"))
a$pic_type <- c("item", "item", "item","relation","relation","relation")
a$roi <- c("object", "object", "pic", "object", "relation","relation")
b$pic_type <- c("item", "item", "item","relation","relation","relation")
b$roi <- c("relation", "relation", "object", "pic", "pic","object")
myList <- list(a,b)

# build the mapping table
mapping = c("item", "object", "occupied",
"relation", "relation", "occupied",
"item", "relation",  "empty",
"relation", "object", "empty")
dim(mapping) =c(3,4)
mapping = as.data.frame(t(mapping))
colnames(mapping)= c("pic_type","roi","type")

Функция addTheColumnType сопоставляет строки фрейма данных с таблицей сопоставления и возвращает фрейм данных с дополнительным столбцом. "type":

addTheColumnType = function (df, mapping){
  # build keys for columns of interest
  mappingKey = apply(mapping[,c("pic_type","roi")],1,paste, collapse="-")
  aKey  = apply(df,1,paste, collapse="-")
  # match the keys and pick the type
  df$type = mapping$type [match(aKey, mappingKey)]
  # replace NAs by nil (for unmatched rows)
  df$type[is.na(df$type)] = "nil"
  return (df)
}

Наконец, примените эту функцию к вашему списку фреймов данных

lapply(myList, addTheColumnType, mapping=mapping)