Давайте начнем с функционального интерфейса, который представляет собой список функций, вместе с их входами и выходами, которые решат проблему.
Функция reset_cum_sums
принимает два элемента, вектор и список позиций сброса этого вектора. Выводом будет вектор , содержащий кумулятивные суммы , при этом суммы перезапускаются в каждой требуемой позиции вектора. Пример должен сделать это более понятным:
При каждой позиции сброса накопленная сумма сбрасывается. Таким образом, если входные данные 1:10
и вектор положения 3 5 7
, выходной сигнал будет
input: [1 2 3 4 5 6 7 8 9 10]
output: [1 3 3 7 5 11 7 15 24 34]
Если позиции не указаны, это даст тот же результат, что и cumsum
.
is_feb_1st
вернет TRUE
, если дата - первое февраля, FALSE
в противном случае. Я оставлю это как упражнение для вас.
Функциональный интерфейс использует примитивные функции which
, split
и lapply
, документация которых оставлена в качестве упражнения для чтения.
Теперь набросок решения можно записать в виде:
restart_feb_first<-function(data.frame) {
reset_cum_sums(data.frame$value,
which(is_feb_first(data.frame$date))
}
Если в ваших данных происходят первые февральские данные в позициях 32,32 + 365,32+730, .. это будет составлять ваш вектор позиции. Приятно, что вы можете легко приспособиться к високосным годам.
Единственная сложная часть - написать reset_cum_sums
;Здесь я приведу один способ сделать это, не обязательно самый эффективный. Программа разбивает вектор на куски, каждый из которых начинается с правильной позиции (в вашем случае, февральских первых). Обратите внимание, что оператор трубы не требуется для этого примера. Вместо этого вы можете использовать традиционную функциональную нотацию.
Кроме того, я написал эту функцию таким образом, чтобы проиллюстрировать некоторые концепции R, а вовсе не обязательно писать наиболее эффективный код. Но, если вы хотите переписать, вы просто изолируете свои усилия для этой функции.
#
# purpose: define a function that creates cumulative sums
# of vectors, but which reset at each position given by
# the vector `positions`, which can be null.
# reset_sum
# parameters for hypothetical example
set.seed(18)
values=runif(50)
# cumulative sums reset at these positions.
positions=c(3,13,23,33,43)
# dependencies
require(magrittr) # or tidyverse for pipe operator
reset_sum = function(vector,positions) {
k=length(vector)
# cut the list into pieces
splitter=cut(1:k,breaks=c(-Inf,positions,Inf),right = FALSE)
pieces=split(vector,splitter)
# do the cumsum of each piece, and then glue then back together
pieces %>% lapply(cumsum) %>% unlist(use.names=FALSE)
}
Вот как эта функция будет называться
# examples
reset_sum(values,positions)
reset_sum(rep(1,50),positions)
Я надеюсь, что это поможет вам найти решение, котороесоответствует вашим потребностям. Основная идея заключается в том, чтобы разбить ее до тех пор, пока вы не найдете функцию, которую «легко» написать в терминах R-примитивов. Если вам нужно, чтобы reset_cum_sums
был суперэффективным, его довольно легко написать на C или data.table
, но давайте оставим это на другой день.
Update
Эта функция возвращаетвектор, поэтому, чтобы использовать его с пакетом таблицы данных, просто добавьте присвоение, как в
DT[,new_column:=reset_sum(value,,isFebFirst(date)]