Grouping with condition in RStudio

Viewed 141

Good morning everyone, I have a csv file (df2.csv) with several variables, as illustrated below (just for example):

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 

I want for each class (1 or 2 in this case), for each distinct date variable, if the number of individuals is less than 3, to group individuals with the next date. If I have a period of more than 3 individuals, in this case, I want to have a date like '20160701q-20160901q' instead of 20160701q and 20160901q separately. In this case, we group two dates or more to get a period of more than 3 individuals, and if the next date of the class has less than 3 individuals, we will group this date with the period before also. I started whit this code

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

But it doesn't work, I want to have this one after grouping:

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

I don't know what I must change else if you can help me, I hope I was clear. Thanks in advance

3 Answers

We can use MESS::cumsumbinning function here to create groups until a threshold is reached.

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)

This returns :

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

To combine the last row, we can do :

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

This is a quite cumbersome solution I've created that does what you asked. I'm sure it can be optimized or that functions from other packages can be used.

Explanations are inserted into the code

# 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,]

Result:

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

Here is a base R solution:

  1. define custom function for grouping
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
}
  1. then use 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)

  1. format the dfout to the desired style by using order
dfout <- dfout[order(dfout$Classe,dfout$Variables),]

Output

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

UPDATE If you want to concatenate the contents in Terms, try the code below

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

such that

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