J'ai un ensemble de données sur les zones et les scores dans ces zones.
Je souhaite conserver un score agrégé ( agg_score ) égal à la somme des scores les plus récents pour A, B et C.
Par exemple, vous verrez dans mon attendu_output pour la ligne 4 est 7, car la calue de C est maintenant 2 tandis que les valeurs les plus récentes de A et B sont toujours 1 et 4. p >
Tout ce que j'ai pu faire jusqu'à présent, c'est faire la somme des trois scores les plus récents, ce qui donne des valeurs agg_score qui égalent parfois la somme de C, C et B. Il est important que j'aie un agg_score précis à chaque date possible.
library(dplyr)
ds <-
tibble(
area = c("A", "B", "C", "C", "B", "A", "A", "B", "C"),
score = c(1,4,5,2,6,3,4,6,3),
scoring_date =
seq.Date(
from = as.Date("2019-01-01"),
to = as.Date("2019-01-09"),
by = "days"
),
expected_output = c(NA, NA, 10, 7, 9, 11, 12, 12, 13)
) %>%
arrange(scoring_date)
# Inadequate code for summing last three scores
ds %>%
mutate(agg_score = score + lag(score) + lag(score, 2))
5 Réponses :
nuevoDs<-ds %>% arrange(desc(scoring_date)) %>% as.data.frame
#getting length of dataframe
longitud<-nrow(nuevoDs)
#we will iterate on each value up until (longitud - 2) and save results to a vector
elVector <- vector()
for(i in 1:(longitud-2))
{
elVector[i] <- nuevoDs[i,"score"] + nuevoDs[i+1,"score"] + nuevoDs[i+2,"score"]
}
#before cbinding we need to make the vector the same length as your dataFrame
elVector[longitud-1] <- 0
elVector[longitud] <- 0
elVector
cbind(nuevoDs,elVector)
area score scoring_date elVector
1 C 3 2019-01-09 13
2 B 6 2019-01-08 13
3 A 4 2019-01-07 13
4 A 3 2019-01-06 11
5 B 6 2019-01-05 13
6 C 2 2019-01-04 11
7 C 5 2019-01-03 10
8 B 4 2019-01-02 0
9 A 1 2019-01-01 0
J'aurais besoin des scores agrégés à chaque moment, pas seulement du dernier.
J'ai donc trouvé un moyen de faire cela en utilisant fill () pour m'assurer que la valeur la plus récente est toujours reportée jusqu'à ce qu'elle soit remplacée par une valeur plus récente.
library(tidyr) ds %>% select(area, score, scoring_date) %>% spread(area, score) %>% fill(A, .direction = "down") %>% fill(B, .direction = "down") %>% fill(C, .direction = "down") %>% rowwise() %>% mutate(agg_score = sum(A, B, C))
Il existe peut-être une option d'auto-fusion data.table , mais je n'arrivais pas à la comprendre. Voici une idée utilisant la mise en œuvre de votre remplissage mais dans data.table . Doit être flexible pour plus de "zones":
ds$agg_score <- sapply(1:nrow(ds), function(i) {other_areas <- setdiff(unique(ds$area), ds[i, "area"])
f_idxs = Filter(function(x) x < i, which(ds$area %in% other_areas)) #Locate other areas that come before current index
if(length(f_idxs) == 0) return(NA)
idxs = sapply(split(f_idxs, ds[f_idxs, "area"]), max) #Split based on area so we can get maximum index before our date
if(length(idxs) < length(other_areas)) return(NA)
sum(ds[c(idxs, i), "score"])}) #Sum up our scores
Solution originale:
Vous pouvez également essayer un code sapply >. La fonction est un peu longue, mais c'est parce que nous avons beaucoup de travail à faire! Si vous vouliez faire cela sur plus de domaines, vous n’auriez pas à les remplir manuellement, ce qui pourrait être un avantage:
library(data.table)
lapply(unique(ds$area), function(a){
ds[, paste0("val_",a) := zoo::na.locf0(ifelse(area==a, score, NA))]
invisible(return(NULL))
})
ds[, agg_score := rowSums(.SD), .SDcols = paste0("val_", unique(ds$area))][, paste0("val_", unique(ds$area)) := NULL]
ds
# area score scoring_date agg_score
#1 A 1 2019-01-01 NA
#2 B 4 2019-01-02 NA
#3 C 5 2019-01-03 10
#4 C 2 2019-01-04 7
#5 B 6 2019-01-05 9
#6 A 3 2019-01-06 11
#7 A 4 2019-01-07 12
#8 B 6 2019-01-08 12
#9 C 3 2019-01-09 13
En utilisant dplyr :: last , nous pouvons trouver la dernière valeur «récente» pour chaque zone, puis les additionner lorsque la longueur atteint 3.
#small function to clarify
sum_fun<-function(x){
#browser()
lc_vec <- ds[1:x,] %>% group_by(area) %>% summarise(lc=last(score)) %>% pull(lc)
lc_vecf <- ifelse(length(lc_vec)==3,sum(lc_vec),NA)
return(lc_vecf)
}
library(dplyr)
ds %>% mutate(Output=sapply(1:nrow(.),sum_fun)) #Instead of sapply we can use purrr::map_dpl
# A tibble: 9 x 5
area score scoring_date expected_output Output
<chr> <dbl> <date> <dbl> <dbl>
1 A 1. 2019-01-01 NA NA
2 B 4. 2019-01-02 NA NA
3 C 5. 2019-01-03 10. 10.
4 C 2. 2019-01-04 7. 7.
5 B 6. 2019-01-05 9. 9.
6 A 3. 2019-01-06 11. 11.
7 A 4. 2019-01-07 12. 12.
8 B 6. 2019-01-08 12. 12.
9 C 3. 2019-01-09 13. 13.
Une autre approche possible de data.table .
ds[.(area=unique(area), scd=.BY$scoring_date),
sum(score),
on=.(area=area, scoring_date<=scd),
mult="last"]
sortie :
library(data.table)
ds <- data.table(
area = c("A", "B", "C", "C", "B", "A", "A", "B", "C"),
score = c(1,4,5,2,6,3,4,6,3),
scoring_date = seq.Date(from = as.Date("2019-01-01"), to = as.Date("2019-01-09"), by = "days"))
données:
area score scoring_date output 1: A 1 2019-01-01 NA 2: B 4 2019-01-02 NA 3: C 5 2019-01-03 10 4: C 2 2019-01-04 7 5: B 6 2019-01-05 9 6: A 3 2019-01-06 11 7: A 4 2019-01-07 12 8: B 6 2019-01-08 12 9: C 3 2019-01-09 13
Explication: p >
L'essentiel du code ci-dessus est:
ds[, output :=
ds[,
ds[.(area=unique(area), scd=.BY$scoring_date),
sum(score),
on=.(area=area, scoring_date<=scd),
mult="last"],
by=.(area, scoring_date)]$V1
]
Cela signifie que pour chaque date ( scd = .BY $ scoring_date ), nous essayons pour effectuer une auto-jointure non équi pour trouver le dernier ( mult = "last" ) score pour toutes les zones ( area = unique (area) )
@RonakShah Je viens de les ajouter. Bonne suggestion
Avez-vous toujours exactement trois dates différentes pour un triple
A,B,C?@MauritsEvers, non, il y aura toujours au moins un score pour les zones A, B et C, mais le nombre de dates auxquelles chaque zone est notée peut varier.