---
title: "Estimate Measures of Injury Epidemiology"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{estimate-epi-measures}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
bibliography: refs.bib
link-citations: yes
---


```{r, include = FALSE}
library(knitr)
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
options(rmarkdown.html_vignette.check_title = FALSE) # to supress R-CMD check

## to fold/hook the code
hook_output <- knit_hooks$get("output")
knit_hooks$set(output = function(x, options) {
   lines <- options$output.lines
   if (is.null(lines)) {
     return(hook_output(x, options))  # pass to default hook
   }
   x <- unlist(strsplit(x, "\n"))
   more <- "..."
   if (length(lines) == 1) {
     if (length(x) > lines) {
       # truncate the output, but add ....
       x <- c(head(x, lines), more)
     }
   } else {
     x <- c(if (abs(lines[1]) > 1) more else NULL,
            x[lines],
            if (length(x) > lines[abs(length(lines))]) more else NULL
           )
   }
   # paste these lines together
   x <- paste(c(x, ""), collapse = "\n")
   hook_output(x, options)
 })
```


```{r setup, warning=FALSE, message=FALSE}
library(injurytools)
library(dplyr)
library(knitr)
library(kableExtra)
```

Whenever one collects and prepares the data, the next natural step is to summarize and explore these data. In this case, from a sports-applied point of view, one wants to know e.g.: how many and what type of injuries have occurred, how often they have occurred or what the load has been.

This document shows convenient functions from `injurytools` to describe sports injury data, in terms of measures used in sports injury epidemiology (see @Bahr2003 and @walden2023). Below, these measures are explained and then, `injsummary()` and `injprev()` functions are illustrated.

# Measures of occurrence
## Rates

As @Hodgson2000 state,

*"Sports injuries occur when athletes are exposed to their given sport and they occur under specific conditions, at a known time and place."* 

Thus, when attempting to describe the distribution of injuries it is necessary to relate this to the population at risk over a specified time period. This is why the fundamental unit of measurement is **rate**.

A rate is a measure that consists of a denominator and a numerator over a period of time. Denominator data can be a number of different things (e.g. number of minutes trained/played, number of matches played). As such, it reflects the speed at which new "injury-related" events occur.

### Injury incidence rate

**Injury incidence rate** is the number of new injury cases ($I$) per unit of player-exposure time, i.e.

$$ I_{r} = \frac{I}{\Delta T}$$
where $\Delta T$ is the total time under risk of the study population.

### Injury burden rate

**Injury burden rate** is the number of days lost ($n_d$) per unit of player-exposure time, i.e.

$$I_{br} = \frac{n_d}{\Delta T}$$
where $\Delta T$ is the total time under risk of the study population.


<div class="alert alert-warning" role="alert">
  **NOTE 1:** as @Bahr2018 state, injury incidence (likelihood) and injury burden (severity) should be reported and assessed in conjunction rather than in isolation. In this regard, see the risk matrix plot provided by `gg_injriskmatrix()` function. 
</div>

<div class="alert alert-warning" role="alert">
  **NOTE 2:** neither injury incidence ($I_r$) nor injury burden ($I_{br}$) are ratios, and they are not interpreted as a probability; they are rates and their unit (person-time)$^{-1}$ (e.g. per 1000h of player-exposure, per player-season etc.). 
</div>

<div class="alert alert-warning" role="alert">
**NOTE 3:** as @walden2023 point out, incidence-based measures that provide a standard time-window for the population at risk (injuries per hour) are preferable to measures for which the time at risk varies across individuals (injuries per athletic-exposure, injuries per number of matches), because time-based measures better facilitate comparison across sports.
</div>

## Prevalence

**Prevalence**, period prevalence, is a proportion that refers to the number of players that has reported the injury of interest ($X$) divided by the total player-population at risk at any time during the specified period of time ($\Delta T$ time window). This includes players who already had the condition at the start of the study period as well as those who acquired it during that period.

$$P = \frac{X}{N}$$
where $X$ is the number of injury cases and $N$ the total number of players in the study at any point in the window of time $\Delta T$.

# In practice

Again, as in the [prepare-data](https://lzumeta.github.io/injurytools/articles/prepare-injury-data.html) vignette, we use the data sets available from the `injurytools` package: data from Liverpool Football Club male's first team players over two consecutive seasons, 2017-2018 and 2018-2019, scrapped from https://www.transfermarkt.com/ website[^estimate-note-1].

[^estimate-note-1]: These data sets are provided for illustrative purposes. We warn that they might not be accurate, there might be a mismatch and non-completeness with what actually occurred.

## - `injsummary()`

<details>

<summary>
  Prepare data
</summary>

```{r, eval = FALSE}
df_exposures <- prepare_exp(raw_df_exposures, player = "player_name",
                            date = "year", time_expo = "minutes_played")
df_injuries  <- prepare_inj(raw_df_injuries, player = "player_name",
                            date_injured = "from", date_recovered = "until")
injd         <- prepare_all(data_exposures = df_exposures,
                            data_injuries  = df_injuries,
                            exp_unit = "matches_minutes")
```
</details>

Now, the preprocessed data is passed to `injsummary()` to calculate injury summary statistics:

```{r}
injds <- injsummary(injd)
```

We notice that it throws some warning messages (unless `quiet = TRUE`). They are thrown to make it clear what the exposure time unit is[^estimate-note-2]. 

[^estimate-note-2]: Something that it is important to be aware of.

What `injsummary()` returns as its output is a list of two elements, i.e. the output stored (here) in the `injds` object consists of,

```{r}
str(injds, 1)
```

two data frames (two tables), which can be accessed by typing `injds[[1]]` (or `injds[["playerwise"]]`) and `injds[[2]]` (`injds[["overal"]]`).

To present the results in a more tidier and comprehensible way (instead of **R** code styled output) the following can be done:

```{r}
# format the 'playerwise' data frame for output as a table
injds[[1]] %>% 
  arrange(desc(injincidence)) %>% # sort by decreasing order of injincidence
  head(10) %>%
  kable(digits = 2, col.names = c("Player", "N injuries", "N days lost", 
                                  "Mean days lost", "Median days lost", "IQR days lost",
                                  "Total exposure", "Incidence", "Burden"))
```

We used [RMarkdown](https://rmarkdown.rstudio.com/), in particular `knitr::kable()` function, to report these tables in this way.

```{r}
# format the table of total incidence and burden (main columns)
injds[[2]] %>% 
  select(1:8) %>% 
  data.frame(row.names = "TOTAL") %>% 
  kable(digits = 2,
        col.names = c("N injuries", "N days lost", "Mean days lost",
                      "Median days lost", "IQR days lost",
                      "Total exposure", "Incidence", "Burden"),
        row.names = TRUE) %>% 
  kable_styling(full_width = FALSE)
```

Note that to provide numbers that are easy to interpret and to avoid small decimals, injury incidence and injury burden are reported 'per 100 player-match exposure'. As in this example exposure time is **minutes played in matches**, we multiply the rates by 90*100 (i.e. 90 minutes lasts a football match). The reported incidence rate is estimated by $\hat{I}_r = \frac{82}{74690}\times90\times100$.  

```{r}
# format the table of total incidence and burden (point + ci estimates)
injds_tot_cis <- injds[[2]] %>% 
  select(7:last_col()) %>% 
  data.frame(row.names = "TOTAL")
injds_tot_cis$ci_injincidence <- paste0("[", round(injds_tot_cis$injincidence_lower, 1),
                                    ", ",round(injds_tot_cis$injincidence_upper, 1), "]")
injds_tot_cis$ci_injburden <- paste0("[", round(injds_tot_cis$injburden_lower, 1),
                                    ", ",round(injds_tot_cis$injburden_upper, 1), "]")

conf_level <- attr(injds, "conf_level")*100
injds_tot_cis %>% 
  select(1, 9, 2, 10) %>% 
  kable(digits = 2,
        col.names = c("Incidence",  paste0("CI", conf_level, "% for \\(I_r\\)"), 
                      "Burden", paste0("CI", conf_level, "% for \\(I_{br}\\)")))
```

Players with the highest injury incidence rate (all type of injuries) were Adam Lallana and Daniel Sturridge with 77.1 and 29.1 injuries per 100 player-matches respectively. The teams overall injury incidence was of 9.9 injuries per 100 player-matches and the injury burden of 246.9 days lost per 100 player-matches. 

These summaries can be done by type of injury:

```{r}
injstats_pertype <- injsummary(injd, var_type_injury = "injury_type", quiet = T)
```

These are the results of the team regarding injury incidence and injury burden by type of injury:

```{r}
injstats_pertype[["overall"]] %>% 
  select(1:5, 7:11) %>% 
  mutate(ninjuries2 = paste0(ninjuries, " (", percent_ninjuries, ")"),
         ndayslost2 = paste0(ndayslost, " (", percent_dayslost, ")"),
         median_dayslost2 = paste0(median_dayslost, " (", iqr_dayslost, ")")) %>% 
  select(1, 11:13, 8:10) %>% 
  arrange(desc(injburden)) %>% 
  kable(digits = 2,
        col.names = c("Type of injury", "N injuries (%)", "N days lost (%)",
                      "Median days lost (IQR)",
                      "Total exposure", "Incidence", "Burden"),
        row.names = TRUE) %>% 
  kable_styling(full_width = FALSE)
```


## - `injprev()`

<details>

<summary>
  Prepare data
</summary>

```{r, eval = FALSE}
df_exposures <- prepare_exp(raw_df_exposures, player = "player_name",
                            date = "year", time_expo = "minutes_played")
df_injuries  <- prepare_inj(raw_df_injuries, player = "player_name",
                            date_injured = "from", date_recovered = "until")
injd         <- prepare_all(data_exposures = df_exposures,
                            data_injuries  = df_injuries,
                            exp_unit = "matches_minutes")
```
</details>

We calculate the injury prevalence and the proportions of injury-free players on a season basis:

```{r}
prev_table1 <- injprev(injd, by = "season")
prev_table1
```

Making use of `knitr::kable()`:

```{r}
kable(prev_table1,
      col.names = c("Season", "Status", "N", "Total", "%"))
```

Overall, there were more injured players in the 18-19 season than in the previous season. Let's calculate it monthly:

```{r}
prev_table2 <- injprev(injd, by = "monthly")

## compare two seasons July and August
prev_table2 %>%
  group_by(season) %>% 
  slice(1:4)


## compare two seasons January and February
prev_table2 %>%
  group_by(season) %>% 
  slice(13:16)
```

Looking at monthly basis, there were more differences w.r.t. player availability in Liverpool FC 1st male team, during the winter January/February months. More injured players in the 18-19 season. 


```{r}
prev_table3 <- injprev(injd, by = "monthly", var_type_injury = "injury_type")
```

Tidy up:

```{r, results = "hide", eval = F}
## season 1
prev_table3 %>% 
  filter(season == "season 2017/2018", month == "Jan") %>% 
  kable(col.names = c("Season", "Month", "Status", "N", "Total", "%"),
        caption = "Season 2017/2018") %>% 
  kable_styling(full_width = FALSE, position = "float_left")
## season 2
prev_table3 %>% 
  filter(season == "season 2018/2019", month == "Jan") %>% 
  kable(col.names = c("Season", "Month", "Status", "N", "Total", "%"),
        caption = "Season 2018/2019") %>% 
  kable_styling(full_width = FALSE, position = "left")
```

```{r, echo = F}
## season 1
prev_table3 %>% 
  filter(season == "season 2017/2018", month == "Jan") %>% 
  kable(col.names = c("Season", "Month", "Status", "N", "Total", "%"),
        caption = "Season 2017/2018") %>% 
  kable_styling(full_width = FALSE, position = "left")
## season 2
prev_table3 %>% 
  filter(season == "season 2018/2019", month == "Jan") %>% 
  kable(col.names = c("Season", "Month", "Status", "N", "Total", "%"),
        caption = "Season 2018/2019") %>% 
  kable_styling(full_width = FALSE, position = "left")
```

# Further implementation

In the near future there will be available the negative binomial (`method = "negbin"` argument), zero-inflated poisson ("`zinfpois`") and zero-inflated negative binomial (`"zinfnb"`) methods in `injsummary()` function.

Finally, this document shows how to perform descriptive analyses for injury epidemiology, but naturally, following these analyses further statistical inferences or multivariate regression analyses may be chosen to infer about the player's/athletes population properties (e.g. to test whether there are differences between the injury incidence rates of two cohorts) or to evaluate the influence of independent factors (e.g. previous injuries, workload) on the injuries occurred.    

# References

