Заменить значения в фрейме данных на основе таблицы поиска
У меня возникают некоторые проблемы с заменой значений в фрейме данных. Я хотел бы заменить значения на основе отдельной таблицы. Ниже приведен пример того, что я пытаюсь сделать.
У меня есть таблица, где каждая строка является клиентом, и каждый столбец является животным, которого они купили. Позволяет называть этот фрейм данных 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)