Verwenden von dplyr für dynamische group_by

Question

Versuchen, meinen Kopf um dieses dplyr Ding zu bekommen. Ich habe einen sortierten Datenrahmen, den ich basierend auf einer Variablen gruppieren möchte. Die Gruppen müssen jedoch so konstruiert werden, dass jede von ihnen eine minimale Summe von 30 auf der Gruppierungsvariablen hat.

Betrachten Sie dieses kleine Beispiel Datenrahmen:

df1 <- matrix(data = c(05,0.9,95,12,0.8,31, 
    16,0.8,28,17,0.7,10, 
     23,0.8,11,55,0.6,9, 
    56,0.5,12,57,0.2,1, 
    59,0.4,1), 
    ncol = 3, 
    byrow = TRUE, 
    dimnames = list(c(1:9), 
    c('freq', 'mean', 'count') 
) 
) 

Nun, ich gruppieren möchten, so dass count eine Summe von mindestens 30 freq und mean haben sollte dann in eine weighted.mean zusammengelegt werden, wobei die Gewichte der ist count Werte. Beachten Sie, dass der letzte "bin" eine Summe von 32 nach Zeile 7 erreicht, aber da Zeile 8: 9 nur zu 2 addiert wird, füge ich sie zum letzten "bin" hinzu.

Wie so:

freq mean count 
5.00 0.90 95 
12.00 0.80 31 
16.26 0.77 38 
45.18 0.61 34 

Die einfachen Zusammenfassungs mit dplyr sind kein Problem, aber das kann ich nicht herausfinden. Ich denke, die die Lösung irgendwo hier versteckt:

Dynamic Grouping in R | Grouping based on condition on applied function

Aber wie es um meine Situation anzuwenden entgeht mir.

Answer 1

Ich wünschte, ich hätte eine kürzere Lösung, aber hier ist, was ich gefunden habe.

Zuerst definieren wir eine benutzerdefinierte cumsum Funktion:

cumsum2 <- function(x){ 
    Reduce(function(.x,.y){ 
    if(tail(.x,1)>30) x1 <- 0 else x1 <- tail(.x,1) ;c(.x,x1+.y)},x,0)[-1] 
} 
# cumsum2(1:10) 
# [1] 1 3 6 10 15 21 28 36 9 19 

Dann können wir Spaß mit der dplyr Kette:

library(dplyr) 
library(tidyr) 

df1 %>% 
    as.data.frame %>%      # as you started with a matrix 
    mutate(id = row_number(),    # we'll need this to sort in the end 
     cumcount = cumsum2(count)) %>% # adding nex cumulate count 
    `[<-`(.$cumcount < 30,"cumcount",NA) %>% # setting as NA values less than 30 ... 
    fill(cumcount,.direction = "up")  %>% # ... in order to fill them with cumcount 
    fill(cumcount,.direction = "down") %>% # the last NAs belong to the last group so we fill down too 
    group_by(cumcount)     %>% # these are our new groups to aggregate freq and mean 
    summarize(id = min(id), 
      freq = sum(freq*count)/sum(count), 
      mean = sum(mean*count)/sum(count)) %>% 
    arrange(id)       %>% # sort 
    select(freq,mean,count=cumcount)   # and lay out as expected output 

# # A tibble: 4 x 3 
#  freq  mean count 
#  <dbl>  <dbl> <dbl> 
# 1 5.00000 0.9000000 95 
# 2 12.00000 0.8000000 31 
# 3 16.26316 0.7736842 38 
# 4 45.17647 0.6117647 32