Суммируйте последние оценки в 3 уникальных областях

Question

У меня есть набор данных областей и оценки в этих областях.

Я хочу сохранить агрегированную оценку (agg_score), равную сумме самых последних оценок для A, B и C.

ДляНапример, вы увидите в моем expected_output для строки 4 значение 7, потому что значение C теперь равно 2, а самые последние значения A и B по-прежнему равны 1 и 4.

Все, что я смогдо сих пор суммируем три последних результата, что приводит к значениям agg_score, которые в разы равны сумме C, C и B.Важно, чтобы у меня был точный agg_score на каждую возможную дату.

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))

Answer 1

Другой возможный data.table подход.

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
    ]

вывод:

   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

данные:

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"))

Объяснение:

Суть приведенного выше кода:

ds[.(area=unique(area), scd=.BY$scoring_date), 
    sum(score), 
    on=.(area=area, scoring_date<=scd), 
    mult="last"]

Это означает, что для каждой даты (scd=.BY$scoring_date) мы пытаемся выполнить самоэквивалентное объединение, чтобы найти последний (mult="last") счет для всех областей (area=unique(area))

Answer 2

Используя dplyr::last, мы можем найти последнее «последнее» значение для каждой области, а затем сложить их, когда длина достигнет 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.

Answer 3

Итак, я нашел способ сделать это, используя fill (), чтобы гарантировать, что самое последнее значение всегда переносится, пока не будет заменено более новым значением.

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))

Answer 4

Может быть, есть вариант слияния data.table, но я не могу понять это.Вот идея использования вашей заливки, но в data.table.Должно быть гибким для большего количества «областей»:

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

Исходное решение:

В качестве альтернативы вы можете попробовать sapply.Функция немного длинная, но это потому, что у нас много работы!Если вы хотите сделать это в большем количестве областей, вам не придется заполнять каждую из них вручную, что может быть полезным:

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

Answer 5

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