Как создать таблицу, измеряющую переходы элементов за календарные периоды?
У меня есть функция генерации таблицы переходов, которая вычисляет переходы состояний элементов с течением времени, прошедшего с момента первого появления элемента («Период_1» в примере фрейма данных ниже), вывод и код, как показано ниже:
library(data.table)
data <-
data.frame(
ID = c(1,1,1,2,2,2,3,3,3),
Period_1 = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
Period_2 = c("2020-01","2020-02","2020-03","2020-04","2020-05","2020-06","2020-02","2020-03","2020-04"),
Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0")
)
numTransit <- function(x, from=1, to=3){
setDT(x)
unique_state <- unique(x$State)
all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
dcast(x[, .(from_state = State[from],
to_state = State[to]),
by = ID]
[,.N, c("from_state", "to_state")]
[all_states,on = c("from_state", "to_state")],
to_state ~ from_state, value.var = "N"
)
}
numTransit(data,1,3)
Однако в более полном коде, в котором это развернуто, я также пытаюсь дать пользователю возможность вместо этого рассчитать переходы за календарные периоды («Период_2» во фрейме данных), где вывод будет выглядеть следующим образом, если пользователь хочет увидеть переходы от месяца 2020-02 к месяцу 2020-04 (поскольку с периода 2020-02 до 2020-04 существовал только один элемент, ID = 3, в результирующей таблице переходов отображается только один элемент; и этот элемент перемещен из состояния X2 в состояние X0 в течение этого периода):
> numTransit(data,"2020-02","2020-04")
to_state X0 X1 X2
1: X0 NA NA 1
2: X1 NA NA NA
3: X2 NA NA NA
Любые идеи, как это сделать? Я новичок в data.table(), но привержен этому из-за скорости, так как эта функция работает с миллионами строк данных и генерирует результаты за доли секунды. Этот пост является продолжением поста Как преобразовать цикл for в функцию lapply для целей параллельного тестирования?
Ответы 1
Вот одно из альтернативных определений вашей функции numTransit.
(Обновлено: я удалил convert_to_matrix из этой функции)
num_transit <- function(x,from,to,refvar = "Period_2", return_matrix=T) {
res <- x[get(refvar) %in% c(to,from), if (.N>1) .SD, by=ID, .SDcols = c(refvar, "State")]
res <- res[, id:=1:.N, by=ID]
res <- dcast(res, ID~id, value.var = "State")[,.N, .(`1`,`2`)]
setnames(res,c("from","to", "ct"))
if (return_matrix) return(convert_transits_to_matrix(res, unique(x$State)))
res
}
convert_transits_to_matrix <- function(transits,states) {
m = matrix(NA, nrow=length(states), ncol=length(states), dimnames=list(states,states))
m[as.matrix(transits[,.(to,from)])] <- transits$ct
m = data.table(m)[,to_state:=rownames(m)]
setcolorder(m,"to_state")
return(m[])
}
Использование:
setDT(data)
num_transit(data, "2020-02", "2020-04")
to_state X0 X1 X2
<char> <int> <int> <int>
1: X0 NA NA 1
2: X1 NA NA NA
3: X2 NA NA NA
num_transit(data, 1,3, refvar = "Period_1")
to_state X0 X1 X2
<char> <int> <int> <int>
1: X0 1 NA 1
2: X1 NA NA NA
3: X2 1 NA NA