создать переменную на основе нескольких похожих переменных в R

Question

Мои данные выглядят так (переменные zipid1-zipid13 и переменная hospid находятся в диапазоне 1-13:

  zipid1 zipid2 zipid3 zipid4 zipid5 zipid6 zipid7 zipid8 zipid9 zipid10 zipid11 zipid12 zipid13 hospid local
1      0      0      0      0      1      0      0      0      0       0       0       0       0      5     0
2      0      0      1      0      1      0      0      0      0       0       0       0       0      5     0
3      0      0      0      0      0      0      1      0      0       0       0       0       0      5     0
4      0      0      1      0      0      0      0      0      0       0       0       0       0      5     0
5      0      0      1      0      1      0      0      0      0       0       0       0       0      5     0
6      0      0      0      0      1      0      0      0      0       0       0       0       0      5     0

Как создать локальную переменную = 1 при zipid1 ==1 & hospid =1, zipid2 == 1 & hospid == 2 .etc. и еще = 0 (т. е. zipid = Hospid)?

Я пытался ifelse, но не получалось.

for (i in 1:13) {
name = paste0("zipid", i)
local$local <- with(local, ifelse(name == 1 & hospid == i, 1, 0))
}

Спасибо!

Answer 1

Проблема заключается в том, что имена столбцов zipid1, zipid2 и т. Д. Передают данные полезной нагрузки, то есть число.

Я предлагаю изменить форму данных из широкой в ​​длинную форму, извлечь число из имени столбца, сопоставить его с hospid, объединить его с помощью id и объединить результат с исходным широкоформатным форматом.

Агрегация выполняется с использованием toString(), поэтому мы получаем действительный результат в случае нескольких совпадений.

library(data.table)
# reshape from wide to long format
melt(setDT(DT), id.vars = c("id", "hospid"), variable.name = "zipid")[
  # turn column names into integer
  , zipid := as.integer(stringr::str_replace(zipid, "zipid", ""))][
    # if value is 1 and zipid and hospid do match then store number
    value == 1L & zipid == hospid, local := hospid][
      # aggregate only mathcing entries by id
      !is.na(local), .(local = toString(local)), by = id][
        # right join with original data
        DT, on = "id"][
          # change column order to meet OP's expectation
          , setcolorder(.SD, names(DT))]

   id zipid1 zipid2 zipid3 zipid4 zipid5 zipid6 zipid7 zipid8 zipid9 zipid10 zipid11 zipid12 zipid13 hospid local
1:  1      0      0      0      0      1      0      0      0      0       0       0       0       0      5     5
2:  2      0      0      1      0      1      0      0      0      0       0       0       0       0      5     5
3:  3      0      0      0      0      0      0      1      0      0       0       0       0       0      5  <NA>
4:  4      0      0      1      0      0      0      0      0      0       0       0       0       0      5  <NA>
5:  5      0      0      1      0      1      0      0      0      0       0       0       0       0      5     5
6:  6      0      0      0      0      1      0      0      0      0       0       0       0       0      5     5

Редактировать

При изменении формы соответствующая информация в DT может быть сжата до

melt(setDT(DT), id.vars = c("id", "hospid"), variable.name = "zipid")[
  , zipid := as.integer(stringr::str_replace(zipid, "zipid", ""))][
    value == 1L]

   id hospid zipid value
1:  2      5     3     1
2:  4      5     3     1
3:  5      5     3     1
4:  1      5     5     1
5:  2      5     5     1
6:  5      5     5     1
7:  6      5     5     1
8:  3      5     7     1

Результат дает

melt(setDT(DT), id.vars = c("id", "hospid"), variable.name = "zipid")[
  , zipid := as.integer(stringr::str_replace(zipid, "zipid", ""))][
    value == 1L][
      zipid == hospid]

   id hospid zipid value
1:  1      5     5     1
2:  2      5     5     1
3:  5      5     5     1
4:  6      5     5     1

Итак, чтобы объединить это с исходным объектом данных, мы можем сделать обновление при соединении:

tmp <- 
  melt(setDT(DT), id.vars = c("id", "hospid"), variable.name = "zipid")[
    , zipid := as.integer(stringr::str_replace(zipid, "zipid", ""))][
      value == 1L & zipid == hospid]
DT[tmp, on = "id", local := value][]

   id zipid1 zipid2 zipid3 zipid4 zipid5 zipid6 zipid7 zipid8 zipid9 zipid10 zipid11 zipid12 zipid13 hospid local
1:  1      0      0      0      0      1      0      0      0      0       0       0       0       0      5     1
2:  2      0      0      1      0      1      0      0      0      0       0       0       0       0      5     1
3:  3      0      0      0      0      0      0      1      0      0       0       0       0       0      5    NA
4:  4      0      0      1      0      0      0      0      0      0       0       0       0       0      5    NA
5:  5      0      0      1      0      1      0      0      0      0       0       0       0       0      5     1
6:  6      0      0      0      0      1      0      0      0      0       0       0       0       0      5     1

Это дает ожидаемый результат. Агрегация не требуется.

Данные

library(data.table)
DT <- fread("id        zipid1 zipid2 zipid3 zipid4 zipid5 zipid6 zipid7 zipid8 zipid9 zipid10 zipid11 zipid12 zipid13 hospid local
1      0      0      0      0      1      0      0      0      0       0       0       0       0      5     0
2      0      0      1      0      1      0      0      0      0       0       0       0       0      5     0
3      0      0      0      0      0      0      1      0      0       0       0       0       0      5     0
4      0      0      1      0      0      0      0      0      0       0       0       0       0      5     0
5      0      0      1      0      1      0      0      0      0       0       0       0       0      5     0
6      0      0      0      0      1      0      0      0      0       0       0       0       0      5     0", drop = "local")

Answer 2

name является вектором строк и в этом контексте интерпретируется как строки, а не как переменные, попробуйте как ifelse(get(name)==1 &...

Answer 3

Вот мысль:

df$local <-  unlist(lapply(1:nrow(df), function(x)df[x, paste("zipid", df$hospid, sep = "")[x]]))

давая

#   zipid1 zipid2 zipid3 zipid4 zipid5 zipid6 zipid7 zipid8 zipid9 zipid10 zipid11 zipid12 zipid13 hospid local
# 1      0      0      0      0      1      0      0      0      0       0       0       0       0      5     1
# 2      0      0      1      0      1      0      0      0      0       0       0       0       0      5     1
# 3      0      0      0      0      0      0      1      0      0       0       0       0       0      5     0
# 4      0      0      1      0      0      0      0      0      0       0       0       0       0      5     0
# 5      0      0      1      0      1      0      0      0      0       0       0       0       0      5     1
# 6      0      0      0      0      1      0      0      0      0       0       0       0       0      5     1

Они работают следующим образом: я беру значение в каждой строке hospid, а затем вставляю его с zipid, чтобы получить что-то вроде zipid5. Я смотрю значение в этом конкретном столбце, соответствующее конкретной строке, и проверяю, является ли оно 1.

---

Если в кадре данных есть NA с, их можно удалить с помощью na.omit. Например, df <- na.omit(df) до запуска приведенного выше кода.