Группировка с условием в RStudio

Question

Доброе утро всем, у меня есть CSV-файл (df2.csv) с несколькими переменными, как показано ниже (только для примера):

CLASSE  Variables   Terms   Number    
1       DAT_1    20160701q   5    
1       DAT_1    20160802q   2    
1       DAT_1    20160901q   1    
1       DAT_2    20161001q   1    
1       DAT_2    20161201q   2    
1       DAT_2    20170301q   3    
2       DAT_1    20161001q   1    
2       DAT_1    20161201q   2    
2       DAT_1    20170301q   1 

Я хочу для каждого класса (1 или 2 в этом case), для каждой отдельной переменной даты, если число лиц меньше 3, сгруппировать людей со следующей датой. Если у меня период более 3 человек, в этом случае я хочу иметь дату, например «20160701q-20160901q» вместо 20160701q и 20160901q отдельно. В этом случае мы группируем две или более дат, чтобы получить период более 3-х человек, и, если в следующей дате урока будет менее 3 человек, мы также сгруппируем эту дату с периодом до этого. Я начал с этого кода

for (n in df2$CLASSE){
  for (k in df2$Variables){
    for (i in 1:nrow(df2)){
      if (df2$Number[i]<3){
        rempl_date=paste(df2$Terms[i],df2$Terms[i+1], sep="-")
        df2$Terms[i]<-rempl_date
        next  
      }
    }
  }
}

Но он не работает, я хочу иметь этот после группировки:

CLASSE  Variables   Terms              Number
1       DAT_1    20160701q               5
1       DAT_1    20160802q-20160901q     3
1       DAT_2    20161001q-20161201q     3
1       DAT_2    20170301q               3
2       DAT_1    20161001q-20170301q     4

Я не знаю, что я должен изменить, если еще Вы можете помочь мне, я надеюсь, что я был ясен. Заранее спасибо

Answer 1

Здесь мы можем использовать функцию MESS::cumsumbinning для создания групп, пока не будет достигнут порог.

library(dplyr)
thresh <- 3

temp <- df %>%
         group_by(CLASSE, Variables, 
                  group = MESS::cumsumbinning(Number, thresh)) %>%
         summarise(Terms = if(n() > 1) 
                           paste(first(Terms), last(Terms), sep = "-") else Terms,
                   Number = sum(Number)) %>%
         select(-group)

Возвращает:

temp
# A tibble: 6 x 4
# Groups:   CLASSE, Variables [3]
#  CLASSE Variables Terms               Number
#   <int> <chr>     <chr>                <int>
#1      1 DAT_1     20160701q                5
#2      1 DAT_1     20160802q-20160901q      3
#3      1 DAT_2     20161001q-20161201q      3
#4      1 DAT_2     20170301q                3
#5      2 DAT_1     20161001q-20161201q      3
#6      2 DAT_1     20170301q                1

Чтобы объединить последнюю строку, мы можем сделать:

n <- nrow(temp) 
if(temp$Number[n] < 3) {
   temp$Terms[n-1] <- sub("-.*", paste0('-', temp$Terms[n]), temp$Terms[n -1])
   temp$Number[n-1] <- sum(temp$Number[n-1], temp$Number[n])
   temp <- temp[-n,]
}


#  CLASSE Variables Terms               Number
#   <int> <chr>     <chr>                <int>
#1      1 DAT_1     20160701q                5
#2      1 DAT_1     20160802q-20160901q      3
#3      1 DAT_2     20161001q-20161201q      3
#4      1 DAT_2     20170301q                3
#5      2 DAT_1     20161001q-20170301q      4

Answer 2

Вот базовое решение R:

1. определить пользовательскую функцию для группировки

f <- function(v, th = 3) {
  k <- 1
  r <- c()
  repeat {
    if (length(v)==0) break
    ind<-seq(head(which(cumsum(v)>=th),1))
    if (sum(v)<2*th) {
      r <- c(r,rep(k,length(v)))
      v <- c()
    } else {
      r <- c(r,rep(k,length(ind)))
      v <- v[-ind]
    }
    k <- k+1
  }
  r
}

затем используйте aggregate + ave

dfout <- subset(aggregate(Terms~.,
                          within(within(df,grp <- ave(Number,Classe, Variables, FUN = f)),
                                 Number <- ave(Number,Classe,Variables,grp,FUN = sum)),
                          c),
                select = -grp)

отформатируйте dfout до нужного стиля, используя order

dfout <- dfout[order(dfout$Classe,dfout$Variables),]

Выход

> dfout
  Classe Variables Number                           Terms
3      1     DAT_1      5                       20160701q
4      1     DAT_1      3            20160802q, 20160901q
1      1     DAT_2      3            20161001q, 20161201q
5      1     DAT_2      3                       20170301q
2      2     DAT_1      4 20161001q, 20161201q, 20170301q

DATA

df <- structure(list(Classe = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L), 
    Variables = c("DAT_1", "DAT_1", "DAT_1", "DAT_2", "DAT_2", 
    "DAT_2", "DAT_1", "DAT_1", "DAT_1"), Terms = c("20160701q", 
    "20160802q", "20160901q", "20161001q", "20161201q", "20170301q", 
    "20161001q", "20161201q", "20170301q"), Number = c(5L, 2L, 
    1L, 1L, 2L, 3L, 1L, 2L, 1L)), class = "data.frame", row.names = c(NA, 
-9L))

ОБНОВЛЕНИЕ Если вы хотите объединить содержимое в Terms, попробуйте код ниже

dfout <- subset(aggregate(Terms~.,
                          within(within(df,grp <- ave(Number,Classe, Variables, FUN = f)),
                                 Number <- ave(Number,Classe,Variables,grp,FUN = sum)),
                          FUN = function(v) ifelse(length(v)==1,v,paste0(c(v[1],v[length(v)]),collapse = "-"))),
                select = -grp)

dfout <- dfout[order(dfout$Classe,dfout$Variables),]

, такой что

> dfout
  Classe Variables Number               Terms
3      1     DAT_1      5           20160701q
4      1     DAT_1      3 20160802q-20160901q
1      1     DAT_2      3 20161001q-20161201q
5      1     DAT_2      3           20170301q
2      2     DAT_1      4 20161001q-20170301q

Answer 3

Это довольно громоздкое решение, которое я создал, которое делает то, что вы просили. Я уверен, что его можно оптимизировать или использовать функции из других пакетов.

Пояснения вставлены в код

# new dataframe
df_new <- data.frame(
  CLASSE = numeric(nrow(df2)),
  Variables = character(nrow(df2)),
  Terms = character(nrow(df2)),
  Number = numeric(nrow(df2)),
  stringsAsFactors = FALSE
)

# temporary dataframe
temp_df <- data.frame(
  CLASSE = numeric(0),
  Variables = character(0),
  Terms = character(0),
  Number = numeric(0),
  stringsAsFactors = FALSE
)

temp_sum <- 0
present_row_temp_df <- 1
for (i in 1:nrow(df2)){
  # if the row doesn't have to be grouped, just paste it in the new dataframe
  if (df2$Number[i] >= 3){
    df_new[i,] <- df2[i,]
    next
  }
  # if the row has to be grouped, add it to a temporary dataframe
  if (df2$Number[i] < 3){
    temp_df[present_row_temp_df,] <- df2[i,]
    temp_sum <- temp_sum + df2$Number[i]
    present_row_temp_df <- present_row_temp_df + 1
    # if the rows in the temporary dataframe need to be grouped now
    if(temp_sum >= 3){
      Terms_new <- paste(temp_df$Terms[1], temp_df$Terms[nrow(temp_df)], sep = "-")
      Number_new <- sum(temp_df$Number)
      df_new[i, c(1:3)] <- c(df2$CLASSE[i], df2$Variables[i], Terms_new)
      df_new[i, 4] <- Number_new
      # re-initialize temporary variables
      temp_df <- data.frame(
        CLASSE = numeric(0),
        Variables = character(0),
        Terms = character(0),
        Number = numeric(0),
        stringsAsFactors = FALSE
      )
      temp_sum <- 0
      present_row_temp_df <- 1
    }
    # for the case in which the last row is not united with the previous rows
    if (i == nrow(df2) & df2$Number[i] < 3){
      Terms_new <- paste(stringr::str_extract(df_new$Terms[i-1], "^[^-]*"), df2$Terms[i], sep = "-")
      Number_new <- df_new$Number[i-1] + df2$Number[i]
      df_new[i, c(1:3)] <- c(df_new$CLASSE[i-1], df_new$Variables[i-1], Terms_new)
      df_new[i, 4] <- Number_new
      df_new[i-1,] <- c("0", "0", "0", 0)
    }
  }
}

# filter only relevant rows
df_new <- df_new[df_new$Number != 0,]

Результат:

df_new

#CLASSE Variables               Terms Number
#     1     DAT_1           20160701q      5
#     1     DAT_1 20160802q-20160901q      3
#     1     DAT_2 20161001q-20161201q      3
#     1     DAT_2           20170301q      3
#     2     DAT_1 20161001q-20170301q      4