Один из способов справиться с этой ситуацией - объединить элементы, перечисленные как «другие» в списке типов заболеваний. Исходя из данных, в исходном векторе disease
имеется 5 типов заболеваний и три новых из анкет.
Сначала, после некоторой очистки, мы читаем данные, размещенные с вопросом.
textFile <- "id|response
1|Não tenho nenhum dos problemas de saúde indicados;
2| Doença respiratória/pulmonar (incluindo asma, bronquite crónica e doença pulmonar obstrutiva crónica);
3| Doença respiratória/pulmonar (incluindo asma, bronquite crónica e doença pulmonar obstrutiva crónica);Hipertensão arterial (tensão arterial alta);Problemas renais crónicos (doença nos rins, incluindo insuficiência renal);
4|Doença autoimmune;
5| Doença respiratória/pulmonar (incluindo asma, bronquite crónica e doença pulmonar obstrutiva crónica);Hipertensão arterial (tensão arterial alta);Diabetes;
6|HIV;
7|Não tenho nenhum dos problemas de saúde indicados;
8|Cardiológica; "
data <- read.csv(text = textFile,sep = "|",
header = TRUE, stringsAsFactors = FALSE)
disease <- c("Doença respiratória/pulmonar (incluindo asma, bronquite crónica e doença pulmonar obstrutiva crónica)",
"Hipertensão arterial (tensão arterial alta)",
"Doença autoimmune",
"Problemas renais crónicos (doença nos rins, incluindo insuficiência renal)",
"Não tenho nenhum dos problemas de saúde indicados")
Далее мы загружаем некоторые пакеты из tidyverse, очищаем данные анкеты и преобразуем их в узкоформатные аккуратные данные.
library(tidyr)
library(dplyr)
library(glue)
data %>% separate(.,response,into = c("resp1","resp2","resp3","resp4","resp5"),
sep=";") %>% group_by(id) %>%
pivot_longer(.,c(resp1,resp2,resp3,resp4,resp5),values_to = "disease") %>%
mutate(disease = trimws(disease)) %>%
filter(!disease %in% c(NA," "," ","")) -> narrowData
На данный момент narrowData
содержит 12 наблюдений и 3 столбца.
> head(narrowData)
# A tibble: 6 x 3
# Groups: id [4]
id name disease
<int> <chr> <chr>
1 1 resp1 Não tenho nenhum dos problemas de saúde indicados
2 2 resp1 Doença respiratória/pulmonar (incluindo asma, bronquite crónica e d…
3 3 resp1 Doença respiratória/pulmonar (incluindo asma, bronquite crónica e d…
4 3 resp2 Hipertensão arterial (tensão arterial alta)
5 3 resp3 Problemas renais crónicos (doença nos rins, incluindo insuficiência…
6 4 resp1 Doença autoimmune
>
Далее мы объединяем данные из вектора disease
с ответами на опрос, чтобы найти уникальные значения для опросов и входного списка заболеваний.
narrowData %>% distinct(trimws(disease)) %>% .[[1]] -> diseaseList
# expanded list
combinedDiseases <- unique(c(diseaseList,disease))
disease_id <- 1:length(combinedDiseases)
diseaseData <- data.frame(disease_id,disease = combinedDiseases,
stringsAsFactors = FALSE)
Фрейм данных diseaseData
выглядит следующим образом: заболевания, о которых сообщалось в анкетах, но не в первоначальном списке, находятся на позициях 6, 7 и 8.
Поскольку мы создали уникальный последовательный номер для связи с каждым названием болезни, теперь мы можем объединить данные и использовать номер идентификатора болезни для переноса данных обратно в набор данных широкого формата по опросу респондента.
narrowData %>% left_join(.,diseaseData) -> joinedData
# create wide format data
joinedData %>% select(id,disease_id) %>% mutate(value = 2) %>%
pivot_wider(.,id_cols = id,names_from = disease_id,names_prefix = "disease",
values_from = value) -> result
Наконец, мы устанавливаем все значения NA в выводе на 1 и печатаем.
result[is.na(result)] <- 1
result
... и вывод:
> result
# A tibble: 8 x 9
# Groups: id [8]
id disease1 disease2 disease3 disease4 disease5 disease6 disease7 disease8
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 2 1 1 1 1 1 1 1
2 2 1 2 1 1 1 1 1 1
3 3 1 2 2 2 1 1 1 1
4 4 1 1 1 1 2 1 1 1
5 5 1 2 2 1 1 2 1 1
6 6 1 1 1 1 1 1 2 1
7 7 2 1 1 1 1 1 1 1
8 8 1 1 1 1 1 1 1 2
>
Кодирование дополнительных зарегистрированных заболеваний как "других"
Согласно комментариям к моему ответу, ОП хотел бы любые заболевания, о которых сообщили респонденты, которых нет в первоначальном списке болезней, которые должны быть закодированы в единую переменную ответа. Вот код, который удовлетворяет этому требованию.
library(tidyr)
library(dplyr)
library(glue)
data %>% separate(.,response,into = c("resp1","resp2","resp3","resp4","resp5"),
sep=";") %>% group_by(id) %>%
pivot_longer(.,c(resp1,resp2,resp3,resp4,resp5),values_to = "disease") %>%
mutate(disease = trimws(disease)) %>%
filter(!disease %in% c(NA," "," ","")) -> narrowData
Еще раз у нас есть фрейм данных с узким форматом, состоящий из одной строки для каждого зарегистрированного заболевания.
Далее мы обрабатываем заболевания, чтобы идентифицировать зарегистрированные заболевания, которых нет в первоначальном списке вариантов. назначьте им идентификатор заболевания, который на единицу больше длины вектора disease
, и создайте фрейм данных.
# create disease data frame by combining data with unique values in survey data frame
narrowData %>% distinct(trimws(disease)) %>% .[[1]] -> reportedDiseases
notInDiseaseList <- unique(reportedDiseases[!reportedDiseases %in% disease ])
disease_id <- 1:length(disease)
diseaseData <- data.frame(disease_id,disease,stringsAsFactors = FALSE)
disease_id <- rep(max(diseaseData$disease_id)+1,length(notInDiseaseList))
reportedDiseases <- data.frame(disease_id,disease = notInDiseaseList,stringsAsFactors = FALSE)
diseaseData <- rbind(diseaseData,reportedDiseases)
Обратите внимание, что все зарегистрированные болезни, не входящие в первоначальный список, имеют одинаковое значение для disease_id
.
Далее мы соединяем фрейм данных diseaseData
с файлом узкого формата, чтобы мы могли pivot_wider()
по идентификатору болезни.
narrowData %>% left_join(.,diseaseData) -> joinedData
Наконец, мы удаляем дубликаты, где disease_id
равен 6, прежде чем использовать `pivot_wider () для создания фрейма данных с шестью столбцами: 1 = нет болезни, 2 = болезнь для 5 типов плюс "Другой".
# create wide format data after eliminating
# any duplicates where multiple reported diseases for a respondent
joinedData %>% select(id,disease_id) %>%
group_by(id,disease_id) %>%
mutate(value = 2, n = row_number()) %>%
filter(n == 1) %>%
pivot_wider(.,id_cols = id,names_from = disease_id,names_prefix = "disease",
values_from = value) -> result
result[is.na(result)] <- 1
result
... и вывод:
> result
# A tibble: 8 x 7
# Groups: id [8]
id disease5 disease1 disease2 disease4 disease3 disease6
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 2 1 1 1 1 1
2 2 1 2 1 1 1 1
3 3 1 2 2 2 1 1
4 4 1 1 1 1 2 1
5 5 1 2 2 1 1 2
6 6 1 1 1 1 1 2
7 7 2 1 1 1 1 1
8 8 1 1 1 1 1 2
>