Это сложный вопрос. Это то, что я придумал (но я уверен, что есть возможности для улучшения).
Если я правильно понимаю, набор данных в широком формате содержит 4 переменных sex, age, race и ethnicity, где, например, sex может принимать значения female, male или NA и т. Д. Столбцы с 6 по 26 содержат отсчетов для каждого value. Переменные не включены, но должны быть добавлены для построения групп из значений . Как указано в OP , столбцы c4, c20, c42, c48 содержат счетчики NA, которые добавляют к счетчикам предыдущих столбцов.
Обработка включает несколько этапов. Первая часть шагов будет предварительно обрабатывать данные, вторая часть создаст новые переменные.
Для создания новых переменных существует два подхода:
- с помощью
cross join - или рекурсивно с использованием
Reduce().
Предварительная обработка
(1) Создайте таблицу поиска для связывания столбцов и значения с переменной они принадлежат.
lut <- data.table(value = names(DT))[
, variable := value %>%
shift() %>%
like("c\\d{1,2}") %>%
cumsum() %>%
add(1L) %>%
extract(c("id", "sex", "age", "race", "ethn"),. )][]
lut
value variable
1: Abbreviation id
2: date id
3: month id
4: year id
5: c1 id
6: male sex
7: female sex
8: c4 sex
9: upto22 age
10: from22to24 age
11: from25to34 age
12: from35to44 age
13: from45to54 age
14: from55to59 age
15: from60to64 age
16: over65 age
17: c20 age
18: hispanic race
19: non_hispanic race
20: c42 race
21: native ethn
22: asian ethn
23: black ethn
24: hawaii ethn
25: white ethn
26: c48 ethn
value variable
(2) Символ приведения date к numeri c date, чтобы для краткости избавиться от лишних столбцов year и month. Кроме того, число c дата более гибкое для упорядочивания или построения графика.
DT[, date := as.IDate(date, "%m/%d/%Y")]
(3) Измените формат набора данных с широкого на длинный, удалив столбцы year, month и c1. (Пожалуйста, не путайте параметры value.name и variable.name функции melt() с моим определением переменной и значения .) (4) Добавьте совпадающую переменную к каждому значению с помощью соединения обновления . (5) Замените запутывающие значения c4, c20 и т.д. c. по NA (6) Добавьте сумму для каждой группы (включая NA счетчиков).
long <-
melt(DT[, !c("year", "month", "c1")], id.vars = c("Abbreviation", "date"),
value.name = "count", variable.name = "value")[
lut, on = .(value), variable := i.variable][
value %like% "c\\d{1,2}", value := NA][
, total := sum(count), by = .(Abbreviation, date, variable)][]
long
Abbreviation date value count variable total
1: AK 2011-01-31 male 12288 sex 18397
2: ZZ 2011-01-31 male 12298 sex 18427
3: AK 2011-01-31 female 6107 sex 18397
4: ZZ 2011-01-31 female 6117 sex 18427
5: AK 2011-01-31 <NA> 2 sex 18397
6: ZZ 2011-01-31 <NA> 12 sex 18427
7: AK 2011-01-31 upto22 870 age 18397
8: ZZ 2011-01-31 upto22 880 age 18487
9: AK 2011-01-31 from22to24 1441 age 18397
10: ZZ 2011-01-31 from22to24 1451 age 18487
11: AK 2011-01-31 from25to34 5320 age 18397
12: ZZ 2011-01-31 from25to34 5330 age 18487
...
31: AK 2011-01-31 native 4856 ethn 18397
32: ZZ 2011-01-31 native 4866 ethn 18457
33: AK 2011-01-31 asian 791 ethn 18397
34: ZZ 2011-01-31 asian 801 ethn 18457
35: AK 2011-01-31 black 611 ethn 18397
36: ZZ 2011-01-31 black 621 ethn 18457
37: AK 2011-01-31 hawaii 289 ethn 18397
38: ZZ 2011-01-31 hawaii 299 ethn 18457
39: AK 2011-01-31 white 11209 ethn 18397
40: ZZ 2011-01-31 white 11219 ethn 18457
41: AK 2011-01-31 <NA> 641 ethn 18397
42: ZZ 2011-01-31 <NA> 651 ethn 18457
Abbreviation date value count variable total
Создайте новые переменные с помощью перекрестного соединения
(7) Создайте имена новых переменных с помощью перекрестного соединения CJ(). Перекрестное соединение также будет включать Abbreviation и date
new_vars <-
long[!is.na(value), CJ(Abbreviation,
date,
ethn = .SD[variable == "ethn", value],
sex = .SD[variable == "sex", value],
age = .SD[variable == "age", value],
unique = TRUE)][
, new.var := paste(ethn, sex, age, sep = "_")][]
new_vars
Abbreviation date ethn sex age new.var
1: AK 2011-01-31 native male upto22 native_male_upto22
2: AK 2011-01-31 native male from22to24 native_male_from22to24
3: AK 2011-01-31 native male from25to34 native_male_from25to34
4: AK 2011-01-31 native male from35to44 native_male_from35to44
5: AK 2011-01-31 native male from45to54 native_male_from45to54
---
156: ZZ 2011-01-31 white female from35to44 white_female_from35to44
157: ZZ 2011-01-31 white female from45to54 white_female_from45to54
158: ZZ 2011-01-31 white female from55to59 white_female_from55to59
159: ZZ 2011-01-31 white female from60to64 white_female_from60to64
160: ZZ 2011-01-31 white female over65 white_female_over65
(8) Изменить форму new_vars на длинный формат. Это необходимо, потому что исходный набор данных также был преобразован в длинный формат.
lnv <- melt(new_vars, id.vars = c("Abbreviation", "date", "new.var"))
lnv
Abbreviation date new.var variable value
1: AK 2011-01-31 native_male_upto22 ethn native
2: AK 2011-01-31 native_male_from22to24 ethn native
3: AK 2011-01-31 native_male_from25to34 ethn native
4: AK 2011-01-31 native_male_from35to44 ethn native
5: AK 2011-01-31 native_male_from45to54 ethn native
---
476: ZZ 2011-01-31 white_female_from35to44 age from35to44
477: ZZ 2011-01-31 white_female_from45to54 age from45to54
478: ZZ 2011-01-31 white_female_from55to59 age from55to59
479: ZZ 2011-01-31 white_female_from60to64 age from60to64
480: ZZ 2011-01-31 white_female_over65 age over65
(9) Добавить new.var путем правого соединения lnv с long. (10) Агрегируйте по Abbreviation, date и new.var, тем самым умножая количество и делите на общее количество (для получения долей).
long[lnv, on = .(Abbreviation, date, variable, value)][
, .(new.count = prod(count)/first(total)^2), by = .(Abbreviation, date, new.var)]
Abbreviation date new.var new.count
1: AK 2011-01-31 native_male_upto22 153.38579
2: AK 2011-01-31 native_male_from22to24 254.05623
3: AK 2011-01-31 native_male_from25to34 937.94527
4: AK 2011-01-31 native_male_from35to44 629.05803
5: AK 2011-01-31 native_male_from45to54 761.99238
---
156: ZZ 2011-01-31 white_female_from35to44 720.79330
157: ZZ 2011-01-31 white_female_from45to54 872.68769
158: ZZ 2011-01-31 white_female_from55to59 312.04830
159: ZZ 2011-01-31 white_female_from60to64 180.50050
160: ZZ 2011-01-31 white_female_over65 92.86912
В качестве альтернативы: создайте новые переменные рекурсивно , используя Reduce()
Шаги с (7) по (10) можно заменить рекурсивным объединением подмножеств .
Если сделать это вручную, это будет выглядеть так:
long[!is.na(value) & variable == "ethn"][
long[!is.na(value) & variable == "sex"], on = .(Abbreviation, date), allow.cartesian = TRUE,
.(Abbreviation, date, value = paste(value, i.value, sep ="_"), count = count * i.count / i.total)][
long[!is.na(value) & variable == "age"], on = .(Abbreviation, date), allow.cartesian = TRUE,
.(Abbreviation, date, value = paste(value, i.value, sep ="_"), count = count * i.count / i.total)]
Сначала подмножество для переменной ethn объединяется с подмножеством переменной sex (внешнее соединение), тем самым частично вычисляя первую часть нового имени переменной и новый счетчик. Затем временный результат объединяется с подмножеством te для переменной age, тем самым вычисляя, наконец, новое имя переменной и новый счетчик.
Это может быть записано в более общем виде как
join_fct <- function(x, y) {
x[y, on = .(Abbreviation, date), allow.cartesian = TRUE,
.(Abbreviation,
date,
value = paste(value, i.value, sep ="_"),
count = count * i.count / i.total)]
}
Reduce(join_fct,
lapply(c("ethn", "sex", "age"),
function(x) long[!is.na(value) & variable == x])
)
Abbreviation date value count
1: AK 2011-01-31 native_male_upto22 153.385786
2: AK 2011-01-31 asian_male_upto22 24.985205
3: AK 2011-01-31 black_male_upto22 19.299571
4: AK 2011-01-31 hawaii_male_upto22 9.128602
5: AK 2011-01-31 white_male_upto22 354.057100
---
156: ZZ 2011-01-31 native_female_over65 40.280090
157: ZZ 2011-01-31 asian_female_over65 6.630570
158: ZZ 2011-01-31 black_female_over65 5.140554
159: ZZ 2011-01-31 hawaii_female_over65 2.475082
160: ZZ 2011-01-31 white_female_over65 92.869365
Этот подход достаточно гибкий, так как количество и порядок переменных можно легко изменить, например,
Reduce ( join_fct, lapply (c («раса», «пол»), function (x) long [! is.na (значение) & variable == x]))
Abbreviation date value count
1: AK 2011-01-31 hispanic_male 514.9779
2: AK 2011-01-31 non_hispanic_male 11660.8090
3: ZZ 2011-01-31 hispanic_male 521.2318
4: ZZ 2011-01-31 non_hispanic_male 11657.9728
5: AK 2011-01-31 hispanic_female 255.9383
6: AK 2011-01-31 non_hispanic_female 5795.2930
7: ZZ 2011-01-31 hispanic_female 259.2596
8: ZZ 2011-01-31 non_hispanic_female 5798.6518
Данные
OP предоставил строку исходного набора данных (в широком формате)
DT <- structure(list(Abbreviation = "AK", date = "1/31/2011", month = "01",
year = "2011", c1 = "P", male = 12288, female = 6107, c4 = 2,
upto22 = 870, from22to24 = 1441, from25to34 = 5320, from35to44 = 3568,
from45to54 = 4322, from55to59 = 1539, from60to64 = 886, over65 = 451,
c20 = 0, hispanic = 771, non_hispanic = 17458, c42 = 168,
native = 4856, asian = 791, black = 611, hawaii = 289, white = 11209,
c48 = 641), row.names = c(NA, -1L), class = c("data.table", "data.frame"))
Однако, чтобы убедиться, что код работает должным образом, мне нужна вторая строка. Итак, я добавил вторую строку:
library(data.table)
DT <- rbind(DT, DT)
DT[2, (6:ncol(DT)) := lapply(.SD, `+`, y = 10), .SDcols = 6:ncol(DT)]
DT[2, Abbreviation := "ZZ"]
DT
Abbreviation date month year c1 male female c4 upto22 from22to24 from25to34
1: AK 1/31/2011 01 2011 P 12288 6107 2 870 1441 5320
2: ZZ 1/31/2011 01 2011 P 12298 6117 12 880 1451 5330
from35to44 from45to54 from55to59 from60to64 over65 c20 hispanic non_hispanic c42 native
1: 3568 4322 1539 886 451 0 771 17458 168 4856
2: 3578 4332 1549 896 461 10 781 17468 178 4866
asian black hawaii white c48
1: 791 611 289 11209 641
2: 801 621 299 11219 651