Como faço para fazer uma soma condicional que só procura entre determinados critérios de data
https://stackoverflow.com//questions/24020207
-
21-12-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPergunta
Dizem que eu tenho dados que se parece com
date, user, items_bought, event_number
2013-01-01, x, 2, 1
2013-01-02, x, 1, 2
2013-01-03, x, 0, 3
2013-01-04, x, 0, 4
2013-01-04, x, 1, 5
2013-01-04, x, 2, 6
2013-01-05, x, 3, 7
2013-01-06, x, 1, 8
2013-01-01, y, 1, 1
2013-01-02, y, 1, 2
2013-01-03, y, 0, 3
2013-01-04, y, 5, 4
2013-01-05, y, 6, 5
2013-01-06, y, 1, 6
para obter a soma cumulativa por usuário por ponto de dados que eu estava fazendo
data.frame(cum_items_bought=unlist(tapply(as.numeric(data$items_bought), data$user, FUN = cumsum)))
saída a partir deste aspecto
date, user, items_bought
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 3
2013-01-04, x, 4
2013-01-04, x, 6
2013-01-05, x, 9
2013-01-06, x, 10
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 7
2013-01-05, y, 13
2013-01-06, y, 14
No entanto quero restringir minha soma para adicionar apenas aqueles que aconteceu dentro de 3 dias de cada linha (em relação ao usuário).i.e.a saída terá este aspecto:
date, user, cum_items_bought_3_days
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 1
2013-01-04, x, 2
2013-01-04, x, 4
2013-01-05, x, 6
2013-01-06, x, 7
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 6
2013-01-05, y, 11
2013-01-06, y, 12
Solução
Aqui está um dplyr solução que irá produzir o resultado desejado (14 linhas), conforme especificado na pergunta.Note que ele se encarrega de duplicar entradas de data, por exemplo, 2013-01-04 do usuário x.
# define a custom function to be used in the dplyr chain
myfunc <- function(x){
with(x, sapply(event_number, function(y)
sum(items_bought[event_number <= event_number[y] & date[y] - date <= 2])))
}
require(dplyr) #install and load into your library
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(.))) %>%
select(-c(items_bought, event_number))
# date user cum_items_bought_3_days
#1 2013-01-01 x 2
#2 2013-01-02 x 3
#3 2013-01-03 x 3
#4 2013-01-04 x 1
#5 2013-01-04 x 2
#6 2013-01-04 x 4
#7 2013-01-05 x 6
#8 2013-01-06 x 7
#9 2013-01-01 y 1
#10 2013-01-02 y 2
#11 2013-01-03 y 2
#12 2013-01-04 y 6
#13 2013-01-05 y 11
#14 2013-01-06 y 12
Na minha resposta eu usar uma função personalizada myfunc dentro de um dplyr cadeia.Isso é feito usando o do operador de dplyr.A função personalizada é passado o subdividida df por user grupos.Em seguida, ele usa sapply para passar cada event_number e calcular a soma dos items_bought.A última linha do dplyr cadeia desmarca o indesejado colunas.
Deixe-me saber se você gostaria de uma explicação mais detalhada.
Editar depois comentário por OP:
Se você precisa de mais flexibilidade para também condicionalmente soma-se a outras colunas, você pode ajustar o código da seguinte maneira.Eu assumo aqui, que as outras colunas devem ser resumida da mesma forma como items_bought.Se isso não é correto, por favor, especifique como você deseja somar a outras colunas.
Eu primeiro crie duas colunas adicionais com números aleatórios nos dados (vou postar uma dput os dados do fundo do meu resposta):
set.seed(99) # for reproducibility only
df$newCol1 <- sample(0:10, 14, replace=T)
df$newCol2 <- runif(14)
df
# date user items_bought event_number newCol1 newCol2
#1 2013-01-01 x 2 1 6 0.687800094
#2 2013-01-02 x 1 2 1 0.640190769
#3 2013-01-03 x 0 3 7 0.357885360
#4 2013-01-04 x 0 4 10 0.102584999
#5 2013-01-04 x 1 5 5 0.097790922
#6 2013-01-04 x 2 6 10 0.182886256
#7 2013-01-05 x 3 7 7 0.227903474
#8 2013-01-06 x 1 8 3 0.080524150
#9 2013-01-01 y 1 1 3 0.821618422
#10 2013-01-02 y 1 2 1 0.591113977
#11 2013-01-03 y 0 3 6 0.773389019
#12 2013-01-04 y 5 4 5 0.350085977
#13 2013-01-05 y 6 5 2 0.006061323
#14 2013-01-06 y 1 6 7 0.814506223
Em seguida, você pode modificar myfunc tomar 2 argumentos, em vez de 1.O primeiro argumento permanecerão com subconjunto de dados.moldura como antes (representado por . dentro da cadeia e dplyr x na definição da função de myfunc), enquanto o segundo argumento para myfunc irá especificar a coluna a soma (colname).
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
Em seguida, você pode usar myfunc várias vezes se você quiser condicionalmente soma a várias colunas:
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
# date user cum_items_bought_3_days newCol1Sums newCol2Sums
#1 2013-01-01 x 2 6 0.6878001
#2 2013-01-02 x 3 7 1.3279909
#3 2013-01-03 x 3 14 1.6858762
#4 2013-01-04 x 1 18 1.1006611
#5 2013-01-04 x 2 23 1.1984520
#6 2013-01-04 x 4 33 1.3813383
#7 2013-01-05 x 6 39 0.9690510
#8 2013-01-06 x 7 35 0.6916898
#9 2013-01-01 y 1 3 0.8216184
#10 2013-01-02 y 2 4 1.4127324
#11 2013-01-03 y 2 10 2.1861214
#12 2013-01-04 y 6 12 1.7145890
#13 2013-01-05 y 11 13 1.1295363
#14 2013-01-06 y 12 14 1.1706535
Agora que você criou condicional somas das colunas items_bought, newCol1 e newCol2.Você pode também deixar de fora qualquer dos montantes no dplyr cadeia ou adicionar mais colunas para resumir.
Edit #2 depois comentário por OP:
Para calcular a soma cumulativa dos distintos (exclusivo) itens comprados por usuário, você pode definir uma segunda função personalizada myfunc2 e use-o para dentro da dplyr cadeia.Esta função também é flexível como myfunc para que você possa definir as colunas para as quais você deseja aplicar a função.
O código seria:
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
myfunc2 <- function(x, colname){
cumsum(sapply(seq_along(x[[colname]]), function(y)
ifelse(!y == 1 & x[y, colname] %in% x[1:(y-1), colname], 0, 1)))
}
require(dplyr) #install and load into your library
dd %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"),
distinct_items_bought = myfunc2(., "items_bought"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
Aqui está os dados que eu usei:
dput(df)
structure(list(date = structure(c(1L, 2L, 3L, 4L, 4L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L), .Label = c("2013-01-01", "2013-01-02",
"2013-01-03", "2013-01-04", "2013-01-05", "2013-01-06"), class = "factor"),
user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"),
items_bought = c(2L, 1L, 0L, 0L, 1L, 2L, 3L, 1L, 1L, 1L,
0L, 5L, 6L, 1L), event_number = c(1L, 2L, 3L, 4L, 5L, 6L,
7L, 8L, 1L, 2L, 3L, 4L, 5L, 6L), newCol1 = c(6L, 1L, 7L,
10L, 5L, 10L, 7L, 3L, 3L, 1L, 6L, 5L, 2L, 7L), newCol2 = c(0.687800094485283,
0.640190769452602, 0.357885359786451, 0.10258499882184, 0.0977909218054265,
0.182886255905032, 0.227903473889455, 0.0805241498164833,
0.821618422167376, 0.591113976901397, 0.773389018839225,
0.350085976999253, 0.00606132275424898, 0.814506222726777
)), .Names = c("date", "user", "items_bought", "event_number",
"newCol1", "newCol2"), row.names = c(NA, -14L), class = "data.frame")
Outras dicas
Eu gostaria de propor um adicional de data.table abordagem combinado com zoo pacote rollapplyr função
Primeiro, vamos agregar items_bought coluna por user por date (como você apontou, que não poderia ser mais do que uma única data, por usuário)
library(data.table)
data <- setDT(data)[, lapply(.SD, sum), by = c("user", "date"), .SDcols = "items_bought"]
A seguir, vamos calcular rollapplyr combinado com sum e partial = TRUE a fim de encobrir margens (obrigado pelo conselho @G.Grothendieck) em intervalos de 3 dias
library(zoo)
data[, cum_items_bought_3_days := lapply(.SD, rollapplyr, 3, sum, partial = TRUE), .SDcols = "items_bought", by = user]
# user date items_bought cum_items_bought_3_days
# 1: x 2013-01-01 2 2
# 2: x 2013-01-02 1 3
# 3: x 2013-01-03 0 3
# 4: x 2013-01-04 0 1
# 5: x 2013-01-05 3 3
# 6: x 2013-01-06 1 4
# 7: y 2013-01-01 1 1
# 8: y 2013-01-02 1 2
# 9: y 2013-01-03 0 2
# 10: y 2013-01-04 5 6
# 11: y 2013-01-05 6 11
# 12: y 2013-01-06 1 12
Este é o conjunto de dados que usei
data <- structure(list(date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 15706, 15707, 15708, 15709, 15710, 15711), class = "Date"), user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)), .Names = c("date", "user", "items_bought"), row.names = c(NA, -12L), class = "data.frame")
Aqui está um método razoavelmente simples:
# replicate your data, shifting the days ahead by your required window,
# and rbind into a single data frame
d <- do.call(rbind,lapply(0:2, function(x) transform(data,date=date+x)))
# use aggregate to add it together, subsetting out "future" days
aggregate(items_bought~date+user,subset(d,date<=max(data$date)),sum)
date user items_bought
1 2013-01-01 x 2
2 2013-01-02 x 3
3 2013-01-03 x 3
4 2013-01-04 x 1
5 2013-01-05 x 3
6 2013-01-06 x 4
7 2013-01-01 y 1
8 2013-01-02 y 2
9 2013-01-03 y 2
10 2013-01-04 y 6
11 2013-01-05 y 11
12 2013-01-06 y 12
A seguir parece válida:
unlist(lapply(split(data, data$user),
function(x) {
ave(x$items_bought,
cumsum(c(0, diff(x$date)) >= 3), FUN = cumsum)
}))
#x1 x2 x3 x4 y1 y2 y3 y4
# 2 3 3 4 1 6 6 7
Onde data:
data = structure(list(date = structure(c(15706, 15707, 15710, 15711,
15706, 15707, 15710, 15711), class = "Date"), user = structure(c(1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"),
items_bought = c(2L, 1L, 3L, 1L, 1L, 5L, 6L, 1L)), .Names = c("date",
"user", "items_bought"), row.names = c(NA, -8L), class = "data.frame")
Aqui é uma abordagem que não usa cumsum mas um aninhados lapply em vez disso.O primeiro vai para os utilizadores e, em seguida, para cada usuário, o segundo lapply constrói o desejado de pacotes de dados pela soma de todos os itens comprados nos últimos 2 dias de cada data.Observe que, se data$date não foram classificados, teria de ser ordenados em ordem crescente em primeiro lugar.
data <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -12L),
class = "data.frame")
do.call(rbind, lapply(unique(data$user),
function(u) {
subd <- subset(data, user == u)
do.call(rbind, lapply(subd$date,
function(x) data.frame(date = x,
user = u, items_bought =
sum(subd[subd$date %in% (x - 2):x, "items_bought"]))))
}))
Editar
Para lidar com o problema de ter vários carimbos de data / hora para cada dia (mais de 1 linha por data) em primeiro lugar gostaria de agregado pela soma de todos os itens comprados durante em cada momento, no mesmo dia.Você pode fazer isso e.g.usando o built-in função de aggregate mas se seus dados é muito grande você pode usar também data.table para a velocidade.Eu vou chamar o seu frame de dados original (com mais de 1 linha por data) predata e o agregado 1 (uma linha por data) data.Então, chamando
predt <- data.table(predata)
setkey(predt, date, user)
data <- predt[, list(items_bought = sum(items_bought)), by = key(predt)]
você obter uma estrutura de dados que contém uma linha por data e colunas data, usuário, items_bought.Agora, eu acho o seguinte maneira vai ser mais rápido do que o aninhados lapply acima, mas eu não tenho certeza já que não posso testá-lo em seus dados.Eu estou usando os dados.tabela porque ele é feito para ser rápido (se usado da maneira correta, o que eu não tenho a certeza se é isso).O loop interno será substituído por uma função f.Eu não sei se existe uma forma sucinta, evitando-se a essa função e substituir o duplo ciclo com apenas uma chamada para dados.tabela, ou como gravar dados.tabela chamada que seria executado mais rapidamente.
library(data.table)
dt <- data.table(data)
setkey(dt, user)
f <- function(d, u) {
do.call(rbind, lapply(d$date, function(x) data.frame(date = x,
items_bought = d[date %in% (x - 2):x, sum(items_bought)])))
}
data <- dt[, f(.SD, user), by = user]
De outra forma, que não usa dados.tabela, partindo do princípio de que você tem bastante RAM (novamente, eu não sei o tamanho dos dados), é o armazenamento de itens comprados 1 dia antes em um vetor, em seguida, os itens comprados 2 dias antes em outro vetor, etc, e soma-los no final.Algo como
sumlist <- vector("list", 2) # this will hold one vector, which contains items
# bought 1 or 2 days ago
for (i in 1:2) {
# tmpstr will be used to find the items that a given user bought i days ago
tmpstr <- paste(data$date - i, data$user, sep = "|")
tmpv <- data$items_bought[
match(tmpstr, paste(data$date, data$user, sep = "|"))]
# if a date is not in the original data, assume no purchases
tmpv[is.na(tmpv)] <- 0
sumlist[[i]] <- tmpv
}
# finally, add up items bought in the past as well as the present day
data$cum_items_bought_3_days <-
rowSums(as.data.frame(sumlist)) + data$items_bought
A última coisa que eu iria tentar seria para colocar em paralelo o lapply chama, por exemplo,usando a função mclapply em vez disso, ou por re-escrever o código usando a funcionalidade paralela de foreach ou plyr.Dependendo da força do seu PC e o tamanho da tarefa, isto pode superar o de dados.tabela single-core de desempenho...
Parece que pacotes xts e zoo contêm funções que fazer o que você quer, embora você pode ter os mesmos problemas com o tamanho de seu conjunto de dados reais como com @alexis_laz resposta.Usando as funções do xts resposta esta pergunta parecem fazer o truque.
Primeiro eu peguei o código da resposta que eu link acima para ter certeza de que funcionou por apenas um user.Eu incluir o apply.daily função, porque eu acredito que a partir de suas edições/comentários que você tiver várias observações por alguns dias para alguns usuários - eu adicionei uma linha extra para o brinquedo de conjunto de dados para refletir isso.
# Make dataset with two observations for one date for "y" user
dat <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L, 0L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -13L),
class = "data.frame")
# Load xts package (also loads zoo)
require(xts)
# See if this works for one user
dat1 = subset(dat, user == "y")
# Create "xts" object for use with apply.daily()
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
# Now use rollapply with a 3-day window
# The "partial" argument appears to only work with zoo objects, not xts
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
Eu pensei que a saída poderia parecer melhor (mais como saída de exemplo a partir de sua pergunta).Eu ainda não tinha trabalhado com zoo objetos muito, mas a resposta para esta pergunta deu-me algumas indicações para colocar as informações em uma data.frame.
data.frame(Date=time(sum.itemsbought), sum.itemsbought, row.names=NULL)
Uma vez eu tive isso funcionou por um user, ele foi direto para expandir isso para todo o brinquedo conjunto de dados.Este é o lugar onde a velocidade pode se tornar um problema.Eu uso lapply e do.call para esta etapa.
allusers = lapply(unique(dat$user), function(x) {
dat1 = dat[dat$user == x,]
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
data.frame(Date=time(sum.itemsbought), user = x, sum.itemsbought, row.names=NULL)
} )
do.call(rbind, allusers)
Eu gosto de James resposta melhor, mas aqui está uma alternativa:
with(data,{
sapply(split(data,user),function(x){
sapply(x$date,function(y) sum(x$items_bought[x$date %in% c(y,y-1,y-2)]))
})
})
