Introduction

When working with data you sometimes want to divide it into groups and subgroups for processing or descriptive statistics. It can help reduce the amount of information if needed, allowing you to compare measurements on different scales - e.g. income per year instead of per month. groupdata2 is a set of tools for creating groups from your data. It consists of four, easy to use, main functions, namely group_factor(), group(), splt(), and fold().

group_factor() is at the heart of it all. It creates the groups and is used by the other functions. It returns a grouping factor with group numbers, i.e. 1s for all elements in group 1, 2s for group 2, etc. So if you ask it to create 2 groups from a vector (‘Hans’,‘Dorte’,‘Mikkel’,‘Leif’) it will return a factor (1,1,2,2).

group() takes in either a dataframe or vector and returns a dataframe with a grouping factor added to it. The dataframe is grouped by the grouping factor (using dplyr::group_by), which makes it very easy to use in dplyr pipelines.
If, for instance, you have a column in a dataframe with quarterly measurements, and you would like to see the average measurement per year, you can simply create groups with a size of 4, and take the mean of each group, all within a 3-line pipeline.

splt() takes in either a dataframe or vector, creates a grouping factor, and splits the given data by this factor using base::split. Often it will be faster to use group() instead of splt(). I also find it easier to work with the output of group() .

fold() is possibly the function I find the most exciting. It creates (optionally) balanced folds for cross-validation. It can balance folds on one categorical variable (e.g. diagnosis) and/or is able to keep all datapoints with the same ID (e.g. participant) in the same fold.

Cross-validation is used for model selection by testing how a model performs on data that it wasn’t trained on - i.e. estimating out-of-sample error. It is done by first dividing the data into groups called folds. Say we choose to divide the data into 5 folds. Then we train a model on the first four folds and test it on the fifth fold. We then train on folds 2,3,4,5 and test on the first fold. We continue changing which fold is the test fold until all folds have been test folds (i.e. we train and test 5 times in total). In the end we get the average performance of the models and compare these to other cross-validated models. This is a great tool, and fold() makes it even more powerful. To explain this further, let’s look at some data and do some grouping and cross-validation!

Creating folds for cross-validation

We start by creating a dataframe with 5 columns and 18 rows. Let’s imagine we test 6 participants 3 times each. Some have the diagnosis ‘a’, others have the diagnosis ‘b’. They keep the same diagnosis and age throughout the experiment. For each session they get a score of how well they did in the experiment.

# Attach some packages
library(groupdata2)
library(dplyr)
library(ggplot2)
library(knitr) # kable()
library(lmerTest) #lmer()
library(broom) #tidy()
library(hydroGOF) # rmse()


# Create dataframe
df <- data.frame("participant" = factor(rep(c('1','2', '3', '4', '5', '6'), 3)),
                "age" = rep(c(20,23,27,21,32,31), 3),
                "diagnosis" = rep(c('a', 'b', 'a', 'b', 'b', 'a'), 3),
                "score" = c(10,24,15,35,24,14,24,40,30,50,54,25,45,67,40,78,62,30))

# Order by participant
df <- df[order(df$participant),] 

# Remove index
rownames(df) <- NULL

# Add session info
df$session <- as.integer(rep(c('1','2', '3'), 6))

# Show the dataframe
kable(df, align = 'c')

We could have a hypothesis that people with the diagnosis ‘b’ in general are better at the experiment. This could be tested by a simple linear model.

lm(score~diagnosis, df) %>%
  summary() %>%
  tidy()
#>          term estimate std.error statistic      p.value
#> 1 (Intercept) 25.88889  5.268120  4.914256 0.0001556386
#> 2  diagnosisb 22.33333  7.450246  2.997664 0.0085209238

The linear model supports the hypothesis, as scores of participants with diagnosis ‘b’ are significantly larger than those of participants with diagnosis ‘a’.

To improve on our model we might also want to use the information we have about age and session. Perhaps the older participants do better than the younger? And maybe participants with the diagnosis ‘b’ are better at learning over time (session) than those with diagnosis ‘a’? By including such information in our model we might explain more than if we are just looking at the diagnosis. We could also use participant as random effect, to factor out the personal differences.
Let’s list a bunch of possible models that we will then compare later with cross-validation! In a moment we will be making a simple cross-validation function that needs the model passed in the format below. Instead of looking at summaries for each model, we will find the best model with cross-validation and only look at the summary for that one. Notice that when we want to compare models, we want to keep the same random effects for all the models, so we are only comparing the combination of fixed effects.

m0 <- 'score~1+(1|participant)'
m1 <- 'score~diagnosis+(1|participant)'
m2 <- 'score~diagnosis+age+(1|participant)'
m3 <- 'score~diagnosis+session+(1|participant)'
m4 <- 'score~diagnosis*session+(1|participant)'
m5 <- 'score~diagnosis*session+age+(1|participant)'

To do the cross-validation we first need to create the folds. We can do this with fold() like this:

df_folded <- fold(df, k=5)

# Order by .folds
df_folded <- df_folded[order(df_folded$.folds),]

kable(df_folded, align='c')

As you can see, we now have a new column called .folds with our 5 new folds. Because we passed the dataframe and the number of folds to create (k) to fold(), the group numbers are distributed randomly. This is equivalent to using group() with randomize set to TRUE. While this could be useful, it is not exploiting the full potential of fold()!
Instead, we want to distribute the datapoints so that we have a balanced representation of the two diagnoses in every fold. We can do this with fold():

df_folded <- fold(df, k=5, cat_col = 'diagnosis')

# Order by .folds
df_folded <- df_folded[order(df_folded$.folds),]

kable(df_folded, align='c')

We can count how many of each diagnosis there are in each fold like this:

df_folded %>% 
  group_by(.folds) %>% 
  count(diagnosis) %>% 
  kable(align='c')

We see that there is a good balance of the diagnoses in all the folds. But there is a problem. In some of our models we want to see the effect of training over time (session) and we want participant as a random effect. To do this we need to have all the measurements of a participant in the same fold! We can do this by simply passing the participant column as id_col in fold().

# Set seed so that we get the exact same folds every time we run our script
set.seed(1)

# Use fold with cat_col and id_col
df_folded <- fold(df, k=3, cat_col = 'diagnosis', id_col = 'participant')

# Order by .folds
df_folded <- df_folded[order(df_folded$.folds),]

kable(df_folded, align='c')

Notice that we only asked fold() to create three groups (k=3) instead of the five we had been using so far. This is because of how fold() works when including both cat_col and id_col. fold() first subsets the passed data by cat_col and then extracts the unique values of id_col for each subset. It creates groups from these lists of IDs and in the end the grouped subsets are merged. This way we end up with this distribution of diagnoses and participants in our folds:

df_folded %>% 
  group_by(.folds) %>% 
  count(diagnosis, participant) %>% 
  kable(align='c')

Now we have 3 of each diagnosis in every fold and each participant stays within 1 fold. If we had asked fold() to create 5 folds, it would first have subset the data by ‘diagnosis’ and then found only 3 participants within each diagnosis, leading to an error as you can’t make 5 groups from 3 elements.

crossvalidate <- function(df, k, model, dependent, random){
  
  # Initialize empty list for recording performances
  performances <- c()
  
  # One iteration per fold
  for (fold in c(1:k)){
    
    # Create training set for this iteration
    # Subset all the datapoints where .folds does not match the current fold
    training_set <- df[df$.folds != fold,]
    
    # Create test set for this iteration
    # Subset all the datapoints where .folds matches the current fold
    test_set <- df[df$.folds == fold,]
    
    ## Train model

    # If there is a random effect,
    # use lmer to train model
    # else use lm

    if (isTRUE(random)){

      # Train linear mixed effects model on training set
      model <-  lmer(model, training_set, REML=FALSE)

    } else {

      # Train linear model on training set
      model <-  lm(model, training_set)

    }

    ## Test model

    # Predict the dependent variable in the test_set with the trained model
    predicted <- predict(model, test_set, allow.new.levels=TRUE)

    # Get the Root Mean Square Error between the predicted and the observed
    RMSE <- rmse(predicted, test_set[[dependent]])

    # Add the RMSE to the performance list
    performances[fold] <- RMSE


  }

  # Return the mean of the recorded RMSEs
  return(c('RMSE' = mean(performances)))

}

m0
#> [1] "score~1+(1|participant)"
crossvalidate(df_folded, k=3, model=m0, dependent='score', random=TRUE)
#>     RMSE 
#> 18.65651

m1
#> [1] "score~diagnosis+(1|participant)"
crossvalidate(df_folded, k=3, model=m1, dependent='score', random=TRUE)
#>     RMSE 
#> 15.30671

m2
#> [1] "score~diagnosis+age+(1|participant)"
crossvalidate(df_folded, k=3, model=m2, dependent='score', random=TRUE)
#>     RMSE 
#> 15.43906

m3
#> [1] "score~diagnosis+session+(1|participant)"
crossvalidate(df_folded, k=3, model=m3, dependent='score', random=TRUE)
#>     RMSE 
#> 7.569802

m4
#> [1] "score~diagnosis*session+(1|participant)"
crossvalidate(df_folded, k=3, model=m4, dependent='score', random=TRUE)
#>     RMSE 
#> 6.912834

m5
#> [1] "score~diagnosis*session+age+(1|participant)"
crossvalidate(df_folded, k=3, model=m5, dependent='score', random=TRUE)
#>     RMSE 
#> 7.255958

lmer(m4, df_folded) %>%
  summary()
#> Linear mixed model fit by REML t-tests use Satterthwaite approximations
#>   to degrees of freedom [lmerMod]
#> Formula: score ~ diagnosis * session + (1 | participant)
#>    Data: df_folded
#> 
#> REML criterion at convergence: 95.9
#> 
#> Scaled residuals: 
#>      Min       1Q   Median       3Q      Max 
#> -1.39711 -0.51307  0.04742  0.53477  1.34145 
#> 
#> Random effects:
#>  Groups      Name        Variance Std.Dev.
#>  participant (Intercept) 10.56    3.25    
#>  Residual                24.60    4.96    
#> Number of obs: 18, groups:  participant, 6
#> 
#> Fixed effects:
#>                    Estimate Std. Error      df t value Pr(>|t|)    
#> (Intercept)          0.5556     4.7595 13.9940   0.117    0.909    
#> diagnosisb           6.3333     6.7310 13.9940   0.941    0.363    
#> session             12.6667     2.0248 10.0000   6.256 9.44e-05 ***
#> diagnosisb:session   8.0000     2.8636 10.0000   2.794    0.019 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Correlation of Fixed Effects:
#>             (Intr) dgnssb sessin
#> diagnosisb  -0.707              
#> session     -0.851  0.602       
#> dgnssb:sssn  0.602 -0.851 -0.707

Windowing time series

When working with time series, groupdata2 allows us to quickly divide them into groups / windows.

timeSeriesFrame = data.frame('residents' = austres)

# Show structure of dataframe
str(timeSeriesFrame) 
#> 'data.frame':    89 obs. of  1 variable:
#>  $ residents: Time-Series  from 1971 to 1993: 13067 13130 13198 13254 13304 ...

# Show head of data
timeSeriesFrame %>% head(12) %>% kable(col.names = NULL)

ts = timeSeriesFrame %>%
  
  # Group data
  group(n = 12, method = 'greedy') %>%
  
  # Find means of each group
  dplyr::summarise(mean = mean(residents))

# Show new data
ts %>% kable() 

ts = timeSeriesFrame %>%
  
  # Group data
  group(n = 12, method = 'greedy') %>%
  
  # Find range of each group
  dplyr::summarise(range = diff(range(residents)))

# Show new data
ts %>% kable() 

main_group_size = 12

# Loop through a list ranging from 1-30
for (step_size in c(1:30)){
  
  # If the remainder is 0
  if(main_group_size %staircase% step_size == 0){
    
    # Print the step size
    print(step_size)
    
  }
  
}
#> [1] 2
#> [1] 4
#> [1] 12

ts <- timeSeriesFrame %>%
  
  # Group data
  group(n = 12, method='greedy') %>%
  
  # Create subgroups
  do(group(., n = 2, method='staircase', col_name = '.subgroups'))
#> Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

# Show head of new data
ts %>% head(24) %>% kable() 

# Show tail of new data
ts %>% tail(17) %>% kable()

ts_means <- ts %>%
  
  # Convert .subgroups to an integer and then to a factor
  mutate(.subgroups = as.integer(.subgroups),
         .subgroups = as.factor(.subgroups)) %>%
  
  # Group by first .groups, then .subgroups
  group_by(.groups, .subgroups) %>%
  
  # Find the mean and range of each subgroup
  dplyr::summarise(mean = mean(residents),
                   range = diff(range(residents)))

# Show head of new data
ts_means %>% head(9) %>% kable() 

Outro

Well done, you made it to the end of this introduction to groupdata2! If you want to know more about the various methods and arguments, you can read the Description of groupdata2
If you have any questions or comments to this vignette (tutorial) or groupdata2, please send them to me at
r-pkgs@ludvigolsen.dk,
so I can make improvements.