R как использовать mapply с таблицей данных и двумя списками имен столбцов - PullRequest
0 голосов
/ 29 апреля 2018

У меня есть таблица данных с двумя столбцами данных и двумя столбцами идентификаторов. Столбцы id - это годы со значениями (X2010, X2015, X2020 и т. Д.) И страны (cty1, cty2 и т. Д.). Для каждой страны первый набор столбцов данных (f1, f2, f3 и т. Д.) Имеет значение только в первой строке (X2010) и NA в остальных строках. Второй набор столбцов (x.f1, x.f2, x.f3 и т. Д.) Имеет NA в первой строке и различные значения в остальных строках. Я хочу заменить NA в первом наборе столбцов следующей рекурсивной структурой для каждой страны.

f1.X2015 = f1.X2010 * x.f1.X2015
f1.X2020 = f1.X2015 * x.f1.X2020
...

Я пробовал следующее

foods <- c("f1", "f2", "f3")
x.foods <- c("x.f1", "x.f"2, "x.f3")
res <- c("res.f1", "res.f2", "res.f3")
f.cumprod <- function(x,y) {return(first(x) * cumprod(replace(y), 1,1) * NA^(.I= 1))}

Вот структура таблицы данных, которая, как я думал, будет работать для генерации значений для столбцов res.

DT[,(res) := mapply(FUN = f.cumprod, x = .SD, y = list(x.foods)), .SDcols = foods, by = c("cty")]

Вот упрощенная версия только для одной страны

set.seed(24)

 dt <- data.table(cty = c(rep("cty1", 5), rep("cty2", 5), rep("cty3", 5)), year = rep(c("X2010", "X2015", "X2020", "X2025", "X2030"), 3), 
             f1 = rep(c(0.9883415, rep(NA, 4)), 3), f2 = rep(c(1.0685221, rep(NA, 4)), 3), f3 = rep(c(1.0664189, rep(NA, 4)), 3), 
           x.f1 = rep(c(NA, rep(rnorm(4))), 3),   x.f2 = rep(c(NA, rep(rnorm(4))), 3),   x.f3 = rep(c(NA, rep(rnorm(4))), 3))

И хитрый и медленный способ получить результат для одного из продуктов питания, f1.

dt.subset <- dt[, c("f1", "x.f1"), with = FALSE]

for (i in 2:nrow(dt.subset)) {
  dt.subset$f1[i] <- dt.subset$f1[i - 1] * dt.subset$x.f1[i]
}

Поскольку я хочу сделать это примерно для 170 стран и 20 продуктов питания (и с 4 сценариями), я надеюсь, что есть решение, аналогичное приведенному выше коду DT.

1 Ответ

0 голосов
/ 29 апреля 2018

Если мы ищем рекурсивную функцию (для одного 'cty')

dt.subset[, f1 := Reduce(`*`, x.f1[-1], init = f1[1], accumulate = TRUE)]

Или с accumulate из purrr

library(purrr)
dt.subset[, f1 := accumulate(x.f1[-1], ~ .x * .y, .init = f1[1])]

Исходя из данных ОП 'dt', мы могли бы melt в формате 'long', а затем применить функцию с accumulate, dcast обратно к 'wide'

out <- dcast(melt(dt, measure = patterns("^f\\d+", "^x\\.f\\d+"))[, 
  accumulate(value2[-1], ~ .x * .y, .init = value1[1]), .(variable, cty)], 
  cty + rowid(variable) ~ variable, value.var = "V1")
nm1 <- grep("^f\\d+$", names(dt), value = TRUE)
setnames(out, -(1:2), nm1)

, а затем set интересующие столбцы с новыми значениями

for(j in nm1) set(dt, i= NULL, j= j, value = out[[j]])
dt
#     cty  year          f1         f2           f3       x.f1       x.f2         x.f3
# 1: cty1 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 2: cty1 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 3: cty1 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 4: cty1 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
# 5: cty1 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
# 6: cty2 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 7: cty2 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 8: cty2 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 9: cty2 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#10: cty2 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
#11: cty3 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
#12: cty3 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
#13: cty3 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
#14: cty3 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#15: cty3 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113

-проверка значениями 'dt.subset' для первого 'cty' после применения функции OP

dt.subset
#            f1       x.f1
#1:  0.98834150         NA
#2: -0.53951661 -0.5458808
#3: -0.28949668  0.5365853
#4: -0.12147951  0.4196231
#5:  0.07089875 -0.5836272

Или мы можем сделать это с Map

dt[, (foods) := Map(function(x, y) accumulate(y[-1], `*`, .init = x[1]),
           mget(foods), mget(x.foods)), by = .(cty)]
dt
#     cty  year          f1         f2           f3       x.f1       x.f2         x.f3
# 1: cty1 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 2: cty1 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 3: cty1 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 4: cty1 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
# 5: cty1 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
# 6: cty2 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 7: cty2 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 8: cty2 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 9: cty2 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#10: cty2 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
#11: cty3 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
#12: cty3 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
#13: cty3 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
#14: cty3 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#15: cty3 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113

Или, если мы используем cumprod (были некоторые ошибки в функции f.cumprod ОП). Может быть изменено на

f.cumprod <- function(x, y)  cumprod(c(x[1], y[-1]))
dt[, (foods) := Map(f.cumprod,  mget(foods), mget(x.foods)), by = .(cty)]
dt
#     cty  year          f1         f2           f3       x.f1       x.f2         x.f3
# 1: cty1 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 2: cty1 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 3: cty1 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 4: cty1 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
# 5: cty1 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
# 6: cty2 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
# 7: cty2 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
# 8: cty2 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
# 9: cty2 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#10: cty2 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113
#11: cty3 X2010  0.98834150  1.0685221  1.066418900         NA         NA           NA
#12: cty3 X2015 -0.53951661  0.9055298 -0.904717849 -0.5458808  0.8474600 -0.848370044
#13: cty3 X2020 -0.28949668  0.2408908 -0.002091656  0.5365853  0.2660220  0.002311942
#14: cty3 X2025 -0.12147951  0.1070965  0.002754518  0.4196231  0.4445853 -1.316908124
#15: cty3 X2030  0.07089875 -0.0499600  0.001647943 -0.5836272 -0.4664951  0.598269113

ПРИМЕЧАНИЕ. Значения одинаковы для каждого 'cty', поскольку значения набора данных примера одинаковы для каждого 'cty'

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...