#r
#r
Вопрос:
Я пытаюсь заполнить столбец суммой выражения, содержащего фиксированные ячейки, но по мере перемещения выражения вниз по столбцам фиксированные ячейки для суммы меняются, как и количество строк, которые необходимо включить. Я думал, что смогу достичь этого с помощью функций lead amp; lag, но нет.
Я надеюсь, что это возможно, я мог бы записать каждое выражение для каждой ячейки, а затем создать столбец из значений, но это будет частью функции, через которую передаются наборы данных разного размера, поэтому мне нужно, чтобы это было автоматизировано до конца time_bin .
Выходной столбец в данных — это то, на что я надеюсь.
NCP <- c(96.05655668, 16.94332276, 19.8844913, 17.74200903, 17.6135507)
time_bin <- c(100,200,300,400,500)
output <- c(14.01221047, 6.51265852, 5.399067538, 3.743397662, 2.02022025)
df <- data.frame(NCP, time_bin, output)
Выражение будет выглядеть примерно так: (но аккуратно и удобно)
output =
row1 = sum(((NCP/(exp(-0.0008*(time_bin[1])))-(NCP/(exp(-0.0008*0)))))) # Could use lag(time_bin with default 0 to fro last expression
row2 = sum((NCP***Starting at row 2***/(exp(-0.0008*time_bin[2])))-(NCP/(exp(-0.0008*time_bin[1])))),
row3 = sum((NCP***Starting at row 3***/(exp(-0.0008*time_bin[3])))-(NCP/(exp(-0.0008*time_bin[2])))),
row4 = sum((NCP***Starting at row 4***/(exp(-0.0008*time_bin[4])))-(NCP/(exp(-0.0008*time_bin[3])))),
row5 = sum((NCP***Starting at row 5***/(exp(-0.0008*time_bin[5])))-(NCP/(exp(-0.0008*time_bin[4]))))
Спасибо всем!
Комментарии:
1. Является ли вторая ссылка на
NCPв каждом вычислении целым вектором или тем же подмножеством, что и первая ссылка наNCP?2. Привет, извините, может быть, не самое четкое объяснение, начиная со строки 2, я имею в виду NCP суммы, исключая значения из NCP row1, вторая ссылка на NCP также исключит row1, затем row3 исключит значения row1 и row2 и т. Д
Ответ №1:
Попробуй это:
len <- nrow(df)
df$out2 <- mapply(
function(i, tb, tblag) sum(df$NCP[i:len]/tb - df$NCP[i:len]/tblag),
seq_len(len), exp(-0.0008 * df$time_bin), exp(-0.0008 * c(0, df$time_bin[-len])))
df
# NCP time_bin output out2
# 1 96.05656 100 14.012210 14.012210
# 2 16.94332 200 6.512659 6.512659
# 3 19.88449 300 5.399068 5.399068
# 4 17.74201 400 3.743398 3.743398
# 5 17.61355 500 2.020220 2.020220
Если вы хотите, чтобы это было в одном calc (векторизованном) вместо использования mapply :
len <- nrow(df)
e <- exp(-0.0008 * c(0, df$time_bin))
o <- outer(df$NCP, e[-1], `/`) - outer(df$NCP, e[-(len 1)], `/`)
df$out3 <- colSums(replace(o, upper.tri(o), 0))
df
# NCP time_bin output out2 out3
# 1 96.05656 100 14.012210 14.012210 14.012210
# 2 16.94332 200 6.512659 6.512659 6.512659
# 3 19.88449 300 5.399068 5.399068 5.399068
# 4 17.74201 400 3.743398 3.743398 3.743398
# 5 17.61355 500 2.020220 2.020220 2.020220
(С этим образцом данных это немного быстрее, чем с другими, но не настолько, чтобы меня беспокоил бенчмарк.)
Сквозной:
-
нам не нужно пересчитывать
exp(-0.0008 * time_bin)для каждого из них и его задержки, поэтому выполнение этого один раз и последующая обработка задержки эффективны, следовательноe <- exp(-0.0008 * c(0, df$time_bin)) ### verifying equality exp(-0.0008 * df$time_bin) # [1] 0.9231163 0.8521438 0.7866279 0.7261490 0.6703200 e[-1] # [1] 0.9231163 0.8521438 0.7866279 0.7261490 0.6703200 exp(-0.0008 * c(0, df$time_bin[-len])) # [1] 1.0000000 0.9231163 0.8521438 0.7866279 0.7261490 e[-(len 1)] # [1] 1.0000000 0.9231163 0.8521438 0.7866279 0.7261490 -
на самом деле немного быстрее (я думаю) вычислить для всех
NCPи отбросить, поскольку операции деления и вычитания также выполняются довольно быстро.outerФункция берет два вектора и разворачивает их в матрицу (столько строк, сколькоlength(vec1), столько столбцов, сколькоlength(vec2), применяя функцию к каждой паре. В этом случае мы разделим их, так чтоouter(df$NCP, e[-1], `/`) # [,1] [,2] [,3] [,4] [,5] # [1,] 104.05683 112.72341 122.11182 132.28215 143.29954 # [2,] 18.35448 19.88317 21.53918 23.33312 25.27647 # [3,] 21.54061 23.33467 25.27814 27.38349 29.66418 # [4,] 19.21969 20.82044 22.55451 24.43301 26.46797 # [5,] 19.08053 20.66969 22.39121 24.25611 26.27633 o <- outer(df$NCP, e[-1], `/`) - outer(df$NCP, e[-(len 1)], `/`) o # [,1] [,2] [,3] [,4] [,5] # [1,] 8.000269 8.666588 9.388403 10.170335 11.017392 # [2,] 1.411160 1.528691 1.656011 1.793936 1.943347 # [3,] 1.656121 1.794054 1.943476 2.105342 2.280690 # [4,] 1.477680 1.600752 1.734073 1.878499 2.034954 # [5,] 1.466981 1.589162 1.721518 1.864898 2.020220 -
в общем, нам нужны суммы столбцов, но поскольку вы хотите, чтобы второе значение начиналось со второго
NCP, мы отбрасываем первое значение во втором столбце, первые два значения в третьем столбце и т.д. К счастью, мы можем использоватьupper.tri(), чтобы сократить это:upper.tri(o) # [,1] [,2] [,3] [,4] [,5] # [1,] FALSE TRUE TRUE TRUE TRUE # [2,] FALSE FALSE TRUE TRUE TRUE # [3,] FALSE FALSE FALSE TRUE TRUE # [4,] FALSE FALSE FALSE FALSE TRUE # [5,] FALSE FALSE FALSE FALSE FALSE replace(o, upper.tri(o), 0) # [,1] [,2] [,3] [,4] [,5] # [1,] 8.000269 0.000000 0.000000 0.000000 0.00000 # [2,] 1.411160 1.528691 0.000000 0.000000 0.00000 # [3,] 1.656121 1.794054 1.943476 0.000000 0.00000 # [4,] 1.477680 1.600752 1.734073 1.878499 0.00000 # [5,] 1.466981 1.589162 1.721518 1.864898 2.02022 colSums(replace(o, upper.tri(o), 0)) # [1] 14.012210 6.512659 5.399068 3.743398 2.020220
удобный для dplyr подход к группировке:
func <- function(ncp, i, tb, tblag) sum(ncp[i:length(ncp)]/tb - ncp[i:length(ncp)]/tblag)
df2 <- bind_rows(df, df, .id = "grp")
df2
# grp NCP time_bin output
# 1 1 96.06 100 14.012
# 2 1 16.94 200 6.513
# 3 1 19.88 300 5.399
# 4 1 17.74 400 3.743
# 5 1 17.61 500 2.020
# 6 2 96.06 100 14.012
# 7 2 16.94 200 6.513
# 8 2 19.88 300 5.399
# 9 2 17.74 400 3.743
# 10 2 17.61 500 2.020
df2 %>%
group_by(grp) %>%
mutate(out2 = mapply(func, list(NCP), row_number(), exp(-0.0008 * time_bin), exp(-0.0008 * lag(time_bin, default = 0)))) %>%
ungroup()
# # A tibble: 10 x 5
# grp NCP time_bin output out2
# <chr> <dbl> <dbl> <dbl> <dbl>
# 1 1 96.1 100 14.0 14.0
# 2 1 16.9 200 6.51 6.51
# 3 1 19.9 300 5.40 5.40
# 4 1 17.7 400 3.74 3.74
# 5 1 17.6 500 2.02 2.02
# 6 2 96.1 100 14.0 14.0
# 7 2 16.9 200 6.51 6.51
# 8 2 19.9 300 5.40 5.40
# 9 2 17.7 400 3.74 3.74
# 10 2 17.6 500 2.02 2.02
Или с помощью purrr :
df2 %>%
group_by(grp) %>%
mutate(out2 = pmap_dbl(list(list(NCP), row_number(), exp(-0.0008 * time_bin), exp(-0.0008 * lag(time_bin, default = 0))), func)) %>%
ungroup()
Комментарии:
1. Прошу прощения за медленный ответ, это идеально. Спасибо!
2. Привет, я не уверен, что это действительно должен быть отдельный вопрос, но есть ли способ применить это к сгруппированным данным, чтобы он выполнялся отдельно для каждой группы? Я пытался использовать pmap, но не очень далеко продвинулся, подход tidyverse был бы отличным, если это возможно.