Заменить значения в фрейме данных на основе таблицы поиска

У меня возникают некоторые проблемы с заменой значений в фрейме данных. Я хотел бы заменить значения на основе отдельной таблицы. Ниже приведен пример того, что я пытаюсь сделать.

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

> table
#       P1     P2     P3
# 1    cat lizard parrot
# 2 lizard parrot    cat
# 3 parrot    cat lizard

У меня также есть таблица, которую я буду ссылаться под названием lookUp.

> lookUp
#      pet   class
# 1    cat  mammal
# 2 lizard reptile
# 3 parrot    bird

Я хочу создать новую таблицу с именем new с функцией, заменяющей все значения в table столбцом class в lookUp. Я сам пробовал это с помощью функции lapply, но я получил следующие предупреждения.

new <- as.data.frame(lapply(table, function(x) {
  gsub('.*', lookUp[match(x, lookUp$pet) ,2], x)}), stringsAsFactors = FALSE)

Warning messages:
1: In gsub(".*", lookUp[match(x, lookUp$pet), 2], x) :
  argument 'replacement' has length > 1 and only the first element will be used
2: In gsub(".*", lookUp[match(x, lookUp$pet), 2], x) :
  argument 'replacement' has length > 1 and only the first element will be used
3: In gsub(".*", lookUp[match(x, lookUp$pet), 2], x) :
  argument 'replacement' has length > 1 and only the first element will be used

Любые идеи о том, как сделать эту работу?

Ответ 1

Вы опубликовали подход в своем вопросе, который был неплохим. Здесь есть знакомый подход:

new <- df  # create a copy of df
# using lapply, loop over columns and match values to the look up table. store in "new".
new[] <- lapply(df, function(x) look$class[match(x, look$pet)])

Альтернативный подход, который будет быстрее:

new <- df
new[] <- look$class[match(unlist(df), look$pet)]

Обратите внимание, что я использую пустые скобки ([]) в обоих случаях, чтобы сохранить структуру new как есть (data.frame).

(Я использую df вместо table и look вместо lookup в своем ответе)

Ответ 2

Другими параметрами являются комбинация tidyr и dplyr

library(dplyr)
library(tidyr)
table %>%
   gather(key = "pet") %>%
   left_join(lookup, by = "pet") %>%
   spread(key = pet, value = class)

Ответ 3

data.frame когда у вас есть два отдельных data.frame и вы пытаетесь передать информацию от одного к другому, ответ - объединить.

У каждого есть свой любимый метод слияния в R. Мой - data.table.

Кроме того, поскольку вы хотите сделать это для многих столбцов, будет быстрее melt и dcast - вместо того, чтобы зацикливать столбцы, примените его один раз к измененной таблице, а затем измените форму снова.

library(data.table)

#the row names will be our ID variable for melting
setDT(table, keep.rownames = TRUE) 
setDT(lookUp)

#now melt, merge, recast
# melting (reshape wide to long)
table[ , melt(.SD, id.vars = 'rn')     
       # merging
       ][lookup, new_value := i.class, on = c(value = 'pet') 
         #reform back to original shape
         ][ , dcast(.SD, rn ~ variable, value.var = 'new_value')]
#    rn      P1      P2      P3
# 1:  1  mammal reptile    bird
# 2:  2 reptile    bird  mammal
# 3:  3    bird  mammal reptile

В случае, если вы обнаружите, что dcast/melt немного пугающий, вот подход, который просто зацикливается на столбцах; dcast/melt - просто обход цикла для этой проблемы.

setDT(table) #don't need row names this time
setDT(lookUp)

sapply(names(table), #(or to whichever are the relevant columns)
       function(cc) table[lookUp, (cc) := #merge, replace
                            #need to pass a _named_ vector to 'on', so use setNames
                            i.class, on = setNames("pet", cc)])

Ответ 4

Сделайте именованный вектор и пропустите каждый столбец и сопоставьте его:

# make lookup vector with names
lookUp1 <- setNames(as.character(lookUp$class), lookUp$pet)
lookUp1    
#      cat    lizard    parrot 
# "mammal" "reptile"    "bird" 

# match on names get values from lookup vector
res <- data.frame(lapply(df1, function(i) lookUp1[i]))
# reset rownames
rownames(res) <- NULL

# res
#        P1      P2      P3
# 1  mammal reptile    bird
# 2 reptile    bird  mammal
# 3    bird  mammal reptile

данные

df1 <- read.table(text = "
       P1     P2     P3
 1    cat lizard parrot
 2 lizard parrot    cat
 3 parrot    cat lizard", header = TRUE)

lookUp <- read.table(text = "
      pet   class
 1    cat  mammal
 2 lizard reptile
 3 parrot    bird", header = TRUE)

Ответ 5

Ответ выше, показывающий, как это сделать в dplyr, не отвечает на вопрос, таблица заполнена NA. Это сработало, я был бы признателен за любые комментарии, показывающие лучший способ:

# Add a customer column so that we can put things back in the right order
table$customer = seq(nrow(table))
classTable <- table %>% 
    # put in long format, naming column filled with P1, P2, P3 "petCount"
    gather(key="petCount", value="pet", -customer) %>% 
    # add a new column based on the pet class in data frame "lookup"
    left_join(lookup, by="pet") %>%
    # since you wanted to replace the values in "table" with their
    # "class", remove the pet column
    select(-pet) %>% 
    # put data back into wide format
    spread(key="petCount", value="class")

Обратите внимание, что, вероятно, было бы полезно хранить длинную таблицу, содержащую клиента, домашнего животного, животных (?) и их класс. В этом примере просто добавляется промежуточное сохранение в переменную:

table$customer = seq(nrow(table))
petClasses <- table %>% 
    gather(key="petCount", value="pet", -customer) %>% 
    left_join(lookup, by="pet")

custPetClasses <- petClasses %>%
    select(-pet) %>% 
    spread(key="petCount", value="class")

Ответ 6

Я попробовал другие подходы, и они заняли очень много времени с моим очень большим набором данных. Вместо этого я использовал следующее:

    # make table "new" using ifelse. See data below to avoid re-typing it
    new <- ifelse(table1 =="cat", "mammal",
                        ifelse(table1 == "lizard", "reptile",
                               ifelse(table1 =="parrot", "bird", NA)))

Этот метод требует, чтобы вы написали больше текста для своего кода, но векторизация ifelse заставляет его работать быстрее. На основании ваших данных вы должны решить, хотите ли вы тратить больше времени на написание кода или ожидание запуска компьютера. Если вы хотите убедиться, что это сработало (в ваших командах iflese не было опечаток), вы можете использовать apply(new, 2, function(x) mean(is.na(x))).

данные

    # create the data table
    table1 <- read.table(text = "
       P1     P2     P3
     1    cat lizard parrot
     2 lizard parrot    cat
     3 parrot    cat lizard", header = TRUE)