Перекодирование одной переменной с разбросом по нескольким из R

Question

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

1. Создайте новую переменную, p.race.
2. Присвоить p.race значение одной из восьми переменных для расы/этнической принадлежности (см. Ниже).
3. Определите, является ли человек отмеченным двумя или более расами и назначает p.race значение «Две или более рас» в таких случаях.
4. Присвоить p.race значение «латиноамериканец или латиноамериканец», когда они указали эту этническую принадлежность.
5. Создайте новую переменную, p.poc, чтобы указать, является ли это человеком цвета (то есть не белый, в том числе испаноязычный/латиноамериканец). Это должно быть 0 или 1.

Восемь категорий гонки - белые *, черные *, азиатские *, AIAN *, NHPI *, другая гонка *, две или более рас * и испаноязычные; где * обозначает не Испаноязычное или латиноамериканское происхождение.

---

Вот что я пытался до сих пор для разбора из «Два или больше гонок»:

p['p.race'] <- NA # create new variable for race 

# list of variable names that store a string indicating the race 
## e.g., `race_white` would be either blank or contain "White, European, Middle Eastern, or Caucasian" 
race.list <- c('p.race_white', 'p.race_black', 'p.race_asian', 'p.race_aian', 'p.race_nhpi', 'p.race_other') 

# iterate through each record 
for (n in 1:length(p)) { 
    multiflag = 0 

    # iterate through the race list 
    for (i in race.list) { 

    # if it is not blank, +1 to multiflag 
    if (p$i[n] != '') { 
     multiflag <- multiflag + 1 
    } 
    } 

    # if multiflag was flagged more than once, assign "Two or more races" to `race` 
    if (multiflag > 1) { 
    p$p.race[n] <- 'Two or more races' 
    } 
} 

При выполнении он возвращает эту ошибку:

> Error in if (p$i[n] != "") { : argument is of length zero 

А вот мой poc с погрешностью ниже:

p['p.poc'] <- 0 # create a new variable for whether they are a person of color 
for (n in 1:length(p)) { 
    if (p$p.race_black[n] == 'Black, African-American, or African' 
     | p$p.race_asian[n] == 'Asian or Asian-American' 
     | p$p.race_aian[n] == 'American Indian or Alaskan Native' 
     | p$p.race_nhpi[n] == 'Native Hawaiian or other Pacific Islander' 
     | p$p.race_other[n] == 'Other (please specify)' 
     | p$p.hispanic[n] == 'Yes') { 
    p$p.poc[n] <- 1 
    } 
} 

> Error in if (p$p.race_black[n] == "Black, African-American, or African" | : 
    missing value where TRUE/FALSE needed 

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

---

Если это помогает, ниже вопросы обследования:

Q1. Вы считаете себя латиноамериканцем, латиноамериканцем или испанским?

• Да
• Нет

Q2. Какую расу вы идентифицируете (проверьте все, что подходит)?

• Белый, Европы, Ближнего Востока, или кавказская
• Черный, афро-американец, или африканский
• Азии или азиатско-американских
• американских индейцев или коренных народов Аляски
• Гаваец или Тихого океана Islander
• Другое (просьба указать)

А вот й е пример вывода (текст усеченный):

> p[264:271] 
#  
#  p.hispanic p.race_white p.race_black p.race_asian p.race_aian p.race_nhpi p.race_other 
# 1 Yes   White 
# 2 No   White 
# 3 No      Black 
# 4 No   White      Asian 
# 5 Yes                  Some other race 

А вот dput выход:

> dput(p[264:270]) 
structure(list(p.hispanic = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 
2L, 2L, 2L, 2L, 3L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("", "No", "Yes" 
), class = "factor"), p.race_white = structure(c(2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 
2L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L), .Label = c("", 
"White, European, Middle Eastern, or Caucasian"), class = "factor"), 
    p.race_black = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
    1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("", 
    "Black, African-American, or African"), class = "factor"), 
    p.race_asian = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L), .Label = c("", 
    "Asian or Asian-American"), class = "factor"), p.race_aian = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 
    1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L), .Label = c("", "American Indian or Alaskan Native" 
    ), class = "factor"), p.race_nhpi = c(NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), 
    p.race_other = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 
    1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("", 
    "Other (please specify)"), class = "factor")), .Names = c("p.hispanic", 
"p.race_white", "p.race_black", "p.race_asian", "p.race_aian", 
"p.race_nhpi", "p.race_other"), class = "data.frame", row.names = c(NA, 
-79L)) 

Answer 1

Это не очень элегантно, но я думаю, что это работает. Использование циклов, особенно вложенных циклов, не очень «R», поскольку они медленны, но также имеют побочные эффекты, такие как загромождение рабочего пространства.

и вы можете изменить, как это относится к p.poc, если гонка не определена, потому что по умолчанию она равна 1, которая может быть не такой, какой вы хотите.

Так вот один из способов:

tmp <- lapply(1:nrow(p), function(ii) { 
    ## this checks for columns that aren't blank or NA, takes the colname 
    ## and strips off the prefix 
    tmp <- gsub('p.race_', '', names(p)[which(p[ii, -1] != '' & !is.na(p[ii, -1])) + 1]) 

    ## some special cases for > 1 race and blanks and p.poc 
    tmp <- ifelse(length(tmp) > 1, 'Two or more', tmp) 
    tmp[is.na(tmp)] <- 'Not specified' 
    tmp <- ifelse(p[ii, 1] %in% 'Yes', 'Hispanic or Latino', tmp) 
    p.poc <- (!grepl('white', tmp)) * 1 

    return(list(p.race = tmp, p.poc = p.poc)) 
}) 

head(do.call(rbind, tmp), 20) 

# p.race    p.poc 
# [1,] "white"    0  
# [2,] "white"    0  
# [3,] "white"    0  
# [4,] "white"    0  
# [5,] "white"    0  
# [6,] "white"    0  
# [7,] "white"    0  
# [8,] "white"    0  
# [9,] "asian"    1  
# [10,] "white"    0  
# [11,] "other"    1  
# [12,] "white"    0  
# [13,] "white"    0  
# [14,] "white"    0  
# [15,] "Hispanic or Latino" 1  
# [16,] "white"    0  
# [17,] "white"    0  
# [18,] "white"    0  
# [19,] "white"    0  
# [20,] "white"    0 

## and combine back to the data frame 
p <- cbind(p, do.call(rbind, tmp)) 

данные:

p <- structure(list(p.hispanic = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 2L, 
2L, 2L, 2L, 2L, 3L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("", "No", "Yes" 
), class = "factor"), p.race_white = structure(c(2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 
2L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L), .Label = c("", 
"White, European, Middle Eastern, or Caucasian"), class = "factor"), 
p.race_black = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("", 
"Black, African-American, or African"), class = "factor"), 
p.race_asian = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L), .Label = c("", 
"Asian or Asian-American"), class = "factor"), p.race_aian = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 
1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L), .Label = c("", "American Indian or Alaskan Native" 
), class = "factor"), p.race_nhpi = c(NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), 
p.race_other = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 
1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("", 
"Other (please specify)"), class = "factor")), .Names = c("p.hispanic", 
"p.race_white", "p.race_black", "p.race_asian", "p.race_aian", 
"p.race_nhpi", "p.race_other"), class = "data.frame", row.names = c(NA, 
    -79L)) 

Answer 2

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

library(tidyr) 
library(dplyr) 

# Add individual ID to each row 
p = mutate(p, id = 1:n()) 

Как только это будет сделано, я бы немного поработать, чтобы сделать p.hispanic колонки больше похожи на другие столбцы расы, положить набор данных в длинном формате, удалите все NA/заготовки, а затем сделать два новых переменные. Как только новые переменные сделаны, они могут быть соединены с оригиналом. Я использую пакет tidyr для перестройки и dplyr для манипуляций.

p %>% 
    mutate(p.hispanic = ifelse(p.hispanic == "No", NA, "Hispanic or Latino")) %>% # change p.hispanic column 
    gather(category, answer, p.hispanic:p.race_other, na.rm = TRUE) %>% 
    filter(answer != "") %>% # get rid of blanks (if were NA would have removed in "gather") 
    group_by(id) %>% 
    # Create new variable p.race and p.pop based on rules 
    mutate(p.race = ifelse(n_distinct(answer) > 1, "Two or more races", answer), 
      p.poc = as.integer(p.race == "White, European, Middle Eastern, or Caucasian")) %>% 
    slice(1) %>% # take only 1 record for the duplicate id's 
    select(-category, - answer) %>% # remove columns that aren't needed 
    left_join(p, ., by = "id") %>% # join new columns with original dataset 
    select(-id) # remove ID column if not wanted 

После того, как у вас есть этот набор данных, можно сбросить уровни p.race с factor, если вы хотите, чтобы уровни, чтобы выглядеть определенным образом.