# Evaluate by ID/group

#### Ludvig Renbo Olsen

#### 2025-07-07

Abstract

In this vignette, we learn how to evaluate predictions on the ID level with `evaluate()`.
Contact the author at r-pkgs@ludvigolsen.dk

# Introduction

When we have groups of observations (e.g. a participant ID), we are sometimes more interested in the overall prediction for the group than those at the observation-level.

Say we have a dataset with 10 observations per participant and a model that predicts whether a participant has an autism diagnosis or not. While the model will predict each of the 10 observations, it’s really the overall prediction for the participant that we are interested in.

`evaluate()` has two approaches to performing the evaluation on the ID level: averaging and voting.

## Averaging

In averaging, we simply average the predicted probabilities for the participant. This is the default approach as it maintains information about how certain our model is about its class prediction. That is, if all observations have a 60% predicted probability of an autism diagnosis, that should be considered differently than 90%.

## Voting

In voting, we simply count the predictions of each outcome class and assign the class with the most predictions to the participant.

If 7 out of 10 of the observations are predicted as having no autism diagnosis, that becomes the prediction for the participant.

# ID evaluation with evaluate()

We will use the simple `participant.scores` dataset as it has 3 rows per participant and a diagnosis column that we can evaluate predictions against. Let’s add predicted probabilities and diagnoses and have a look:

    library(cvms)
    library(knitr)  # kable()
    library(dplyr)
    set.seed(74)

    # Prepare dataset
    data <- participant.scores %>% as_tibble()
    # Add probabilities and predicted classes
    data[["probability"]] <- runif(nrow(data))
    data[["predicted diagnosis"]] <- ifelse(data[["probability"]] > 0.5, 1, 0)

    data %>% head(10) %>% kable()

participant | age | diagnosis | score | session | probability | predicted diagnosis
--- | --- | --- | --- | --- | --- | ---
1 | 20 | 1 | 10 | 1 | 0.7046162 | 1
1 | 20 | 1 | 24 | 2 | 0.4800045 | 0
1 | 20 | 1 | 45 | 3 | 0.1960176 | 0
2 | 23 | 0 | 24 | 1 | 0.9369707 | 1
2 | 23 | 0 | 40 | 2 | 0.8698302 | 1
2 | 23 | 0 | 67 | 3 | 0.2140318 | 0
3 | 27 | 1 | 15 | 1 | 0.0240853 | 0
3 | 27 | 1 | 30 | 2 | 0.8547959 | 1
3 | 27 | 1 | 40 | 3 | 0.7027153 | 1
4 | 21 | 0 | 35 | 1 | 0.9579817 | 1

We tell `evaluate()` to aggregate the predictions by the `participant` column with the `mean` (averaging) method.

Note: It is assumed that the target class is constant within the IDs. I.e., that the participant has the same diagnosis in all observations.

    ev <- evaluate(
      data = data,
      target_col = "diagnosis",
      prediction_cols = "probability",
      id_col = "participant",
      id_method = "mean",
      type = "binomial"
    )

    ev
    #> # A tibble: 1 × 19
    #>   `Balanced Accuracy` Accuracy    F1 Sensitivity Specificity `Pos Pred Value`
    #>                 <dbl>    <dbl> <dbl>       <dbl>       <dbl>            <dbl>
    #> 1               0.292      0.3 0.364       0.333        0.25              0.4
    #> # ℹ 13 more variables: `Neg Pred Value` <dbl>, AUC <dbl>, `Lower CI` <dbl>,
    #> #   `Upper CI` <dbl>, Kappa <dbl>, MCC <dbl>, `Detection Rate` <dbl>,
    #> #   `Detection Prevalence` <dbl>, Prevalence <dbl>, Predictions <list>,
    #> #   ROC <named list>, `Confusion Matrix` <list>, Process <list>

The `Predictions` column contains the averaged predictions:

    ev$Predictions[[1]] %>% kable()

Target | Prediction | SD | Predicted Class | participant | id_method
--- | --- | --- | --- | --- | ---
1 | 0.4602128 | 0.2548762 | 0 | 1 | mean
0 | 0.6736109 | 0.3994204 | 1 | 2 | mean
1 | 0.5271988 | 0.4422946 | 1 | 3 | mean
0 | 0.7974576 | 0.1703448 | 1 | 4 | mean
1 | 0.5887699 | 0.4738221 | 1 | 5 | mean
1 | 0.3526630 | 0.2302525 | 0 | 6 | mean
1 | 0.2333758 | 0.1913763 | 0 | 7 | mean
1 | 0.3956015 | 0.3207379 | 0 | 8 | mean
0 | 0.3374361 | 0.0304785 | 0 | 9 | mean
0 | 0.5988969 | 0.0675830 | 1 | 10 | mean

Let’s plot the confusion matrix as well:

    # Note: If ev had multiple rows, we would have to
    # pass ev$`Confusion Matrix`[[1]] to
    # plot the first row's confusion matrix
    plot_confusion_matrix(ev)

We can have a better look at the metrics:

    ev_metrics <- select_metrics(ev)
    ev_metrics %>% select(1:9) %>% kable(digits = 5)

Balanced Accuracy | Accuracy | F1 | Sensitivity | Specificity | Pos Pred Value | Neg Pred Value | AUC | Lower CI
--- | --- | --- | --- | --- | --- | --- | --- | ---
0.29167 | 0.3 | 0.36364 | 0.33333 | 0.25 | 0.4 | 0.2 | 0.20833 | 0

    ev_metrics %>% select(10:14) %>% kable(digits = 5)

Upper CI | Kappa | MCC | Detection Rate | Detection Prevalence
--- | --- | --- | --- | ---
0.62475 | -0.4 | -0.40825 | 0.2 | 0.5

## Using voting

We can use the `majority` (voting) method for the ID aggregation instead:

    ev_2 <- evaluate(
      data = data,
      target_col = "diagnosis",
      prediction_cols = "probability",
      id_col = "participant",
      id_method = "majority",
      type = "binomial"
    )

    ev_2
    #> # A tibble: 1 × 19
    #>   `Balanced Accuracy` Accuracy    F1 Sensitivity Specificity `Pos Pred Value`
    #>                 <dbl>    <dbl> <dbl>       <dbl>       <dbl>            <dbl>
    #> 1               0.292      0.3 0.364       0.333        0.25              0.4
    #> # ℹ 13 more variables: `Neg Pred Value` <dbl>, AUC <dbl>, `Lower CI` <dbl>,
    #> #   `Upper CI` <dbl>, Kappa <dbl>, MCC <dbl>, `Detection Rate` <dbl>,
    #> #   `Detection Prevalence` <dbl>, Prevalence <dbl>, Predictions <list>,
    #> #   ROC <named list>, `Confusion Matrix` <list>, Process <list>

Now the `Predictions` column looks as follows:

    ev_2$Predictions[[1]] %>% kable()

Target | Prediction | Predicted Class | participant | id_method
--- | --- | --- | --- | ---
1 | 0 | 0 | 1 | majority
0 | 1 | 1 | 2 | majority
1 | 1 | 1 | 3 | majority
0 | 1 | 1 | 4 | majority
1 | 1 | 1 | 5 | majority
1 | 0 | 0 | 6 | majority
1 | 0 | 0 | 7 | majority
1 | 0 | 0 | 8 | majority
0 | 0 | 0 | 9 | majority
0 | 1 | 1 | 10 | majority

In this case, the `Predicted Class` column is identical to that in the averaging approach. We just don’t have the probabilities to tell us, how sure the model is about that prediction.

# Per model

If we have predictions from multiple models, we can group the data frame and get the results per model.

Let’s duplicate the dataset and change the predictions. We then combine the datasets and add a `model` column for indicating which of the data frames the observation came from:

    # Duplicate data frame
    data_2 <- data
    # Change the probabilities and predicted classes
    data_2[["probability"]] <- runif(nrow(data))
    data_2[["predicted diagnosis"]] <- ifelse(data_2[["probability"]] > 0.5, 1, 0)

    # Combine the two data frames
    data_multi <- dplyr::bind_rows(data, data_2, .id = "model")

    data_multi
    #> # A tibble: 60 × 8
    #>    model participant   age diagnosis score session probability
    #>    <chr> <fct>       <dbl>     <dbl> <dbl>   <int>       <dbl>
    #>  1 1     1              20         1    10       1      0.705
    #>  2 1     1              20         1    24       2      0.480
    #>  3 1     1              20         1    45       3      0.196
    #>  4 1     2              23         0    24       1      0.937
    #>  5 1     2              23         0    40       2      0.870
    #>  6 1     2              23         0    67       3      0.214
    #>  7 1     3              27         1    15       1      0.0241
    #>  8 1     3              27         1    30       2      0.855
    #>  9 1     3              27         1    40       3      0.703
    #> 10 1     4              21         0    35       1      0.958
    #> # ℹ 50 more rows
    #> # ℹ 1 more variable: `predicted diagnosis` <dbl>

We can now group the data frame by the `model` column and run the evaluation again:

    ev_3 <- data_multi %>%
      dplyr::group_by(model) %>%
      evaluate(
        target_col = "diagnosis",
        prediction_cols = "probability",
        id_col = "participant",
        id_method = "mean",
        type = "binomial"
      )

    ev_3
    #> # A tibble: 2 × 20
    #>   model `Balanced Accuracy` Accuracy    F1 Sensitivity Specificity
    #>   <chr>               <dbl>    <dbl> <dbl>       <dbl>       <dbl>
    #> 1 1                   0.292      0.3 0.364       0.333        0.25
    #> 2 2                   0.375      0.4 0.5         0.5          0.25
    #> # ℹ 14 more variables: `Pos Pred Value` <dbl>, `Neg Pred Value` <dbl>,
    #> #   AUC <dbl>, `Lower CI` <dbl>, `Upper CI` <dbl>, Kappa <dbl>, MCC <dbl>,
    #> #   `Detection Rate` <dbl>, `Detection Prevalence` <dbl>, Prevalence <dbl>,
    #> #   Predictions <list>, ROC <named list>, `Confusion Matrix` <list>,
    #> #   Process <list>

The `Predictions` for the second model looks as follows:

    ev_3$Predictions[[2]] %>% kable()

model | Target | Prediction | SD | Predicted Class | participant | id_method
--- | --- | --- | --- | --- | --- | ---
2 | 1 | 0.3302017 | 0.3002763 | 0 | 1 | mean
2 | 0 | 0.6040242 | 0.2854935 | 1 | 2 | mean
2 | 1 | 0.7342651 | 0.2653166 | 1 | 3 | mean
2 | 0 | 0.6383918 | 0.3799305 | 1 | 4 | mean
2 | 1 | 0.4551732 | 0.3417810 | 0 | 5 | mean
2 | 1 | 0.6808281 | 0.3626166 | 1 | 6 | mean
2 | 1 | 0.4536740 | 0.3784584 | 0 | 7 | mean
2 | 1 | 0.6281501 | 0.4506029 | 1 | 8 | mean
2 | 0 | 0.7000411 | 0.1490745 | 1 | 9 | mean
2 | 0 | 0.4630344 | 0.4344227 | 0 | 10 | mean

# In `'gaussian'` evaluation

This kind of ID aggregation is also available for the `'gaussian'` evaluation (e.g. for linear regression models), although only with the averaging approach. Again, it is assumed that the target value is constant for all observations by a participant (like the `age` column in our dataset).

We add a `predicted age` column to our initial dataset:

    data[["predicted age"]] <- sample(20:45, size = 30, replace = TRUE)

We evaluate the predicted age, aggregated by participant:

    ev_4 <- evaluate(
      data = data,
      target_col = "age",
      prediction_cols = "predicted age",
      id_col = "participant",
      id_method = "mean",
      type = "gaussian"
    )

    ev_4
    #> # A tibble: 1 × 8
    #>    RMSE   MAE `NRMSE(IQR)`  RRSE   RAE RMSLE Predictions       Process
    #>   <dbl> <dbl>        <dbl> <dbl> <dbl> <dbl> <list>            <list>
    #> 1  10.3   8.7        0.984  1.48  1.45 0.340 <tibble [10 × 5]> <prcss_n_>

The `Predictions` column looks as follows:

    ev_4$Predictions[[1]] %>% kable()

Target | Prediction | SD | participant | id_method
--- | --- | --- | --- | ---
20 | 35.66667 | 8.326664 | 1 | mean
23 | 33.33333 | 10.214369 | 2 | mean
27 | 35.33333 | 5.686241 | 3 | mean
21 | 30.00000 | 4.582576 | 4 | mean
32 | 28.66667 | 5.507570 | 5 | mean
31 | 43.33333 | 1.154700 | 6 | mean
43 | 39.00000 | 5.196152 | 7 | mean
21 | 40.33333 | 2.516611 | 8 | mean
34 | 35.33333 | 5.507570 | 9 | mean
32 | 35.33333 | 7.571878 | 10 | mean

On average, we predict `participant 1` to have the age `35.66`.

# Results for each ID

If our targets are not constant within the IDs, we might be interested in the ID-level evaluation. E.g. how well it predicted the score for each of the participants.

We add a `predicted score` column to our dataset:

    data[["predicted score"]] <- round(runif(30, 10, 81))

Now, we group the data frame by the `participant` column and evaluate the predicted scores:

    data %>%
      dplyr::group_by(participant) %>%
      evaluate(
        target_col = "score",
        prediction_cols = "predicted score",
        type = "gaussian"
      )
    #> # A tibble: 10 × 9
    #>    participant  RMSE   MAE `NRMSE(IQR)`  RRSE   RAE RMSLE Predictions Process
    #>    <fct>       <dbl> <dbl>        <dbl> <dbl> <dbl> <dbl> <list>      <list>
    #>  1 1           13.8  13.7         0.787 0.957 1.10  0.683 <tibble>    <prcss_n_>
    #>  2 2           32.4  26.3         1.50  1.82  1.69  0.946 <tibble>    <prcss_n_>
    #>  3 3           12.8  10.7         1.03  1.25  1.2   0.549 <tibble>    <prcss_n_>
    #>  4 4            9.15  7.67        0.425 0.513 0.486 0.154 <tibble>    <prcss_n_>
    #>  5 5           24.1  17.3         1.27  1.47  1.15  0.566 <tibble>    <prcss_n_>
    #>  6 6           34.2  33.3         4.27  5.12  5.56  0.895 <tibble>    <prcss_n_>
    #>  7 7           44.7  40           2.98  3.45  3.33  1.21  <tibble>    <prcss_n_>
    #>  8 8            9.80  8           0.700 0.854 0.818 0.306 <tibble>    <prcss_n_>
    #>  9 9           22.6  21.3         1.37  1.66  1.81  0.447 <tibble>    <prcss_n_>
    #> 10 10          29.3  28           1.13  1.38  1.62  0.556 <tibble>    <prcss_n_>

`Participant 4` has the lowest prediction error while `participant 7` has the highest.

This approach is similar to what the `most_challenging()` function does:

    # Extract the ~20% observations with highest prediction error
    most_challenging(
      data = data,
      type = "gaussian",
      obs_id_col = "participant",
      target_col = "score",
      prediction_cols = "predicted score",
      threshold = 0.20
    )
    #> # A tibble: 2 × 4
    #>   participant   MAE  RMSE  `>=`
    #>   <fct>       <dbl> <dbl> <dbl>
    #> 1 7            40    44.7  32.7
    #> 2 6            33.3  34.2  32.7

This concludes the vignette. If any elements are unclear you can leave feedback in a mail or in a GitHub issue :-)