Simulating data and file-based ETL

Library

I always declare libraries at the top of the document in a typical workflow. It makes it a lot easier to know upfront which libraries are used when sharing the document with others.

library(tidyverse)
library(lubridate)
library(readxl)
library(knitr)
library(kableExtra)

Functions

Keeping general functions towards the top of a document makes it easier to reuse throughout. In larger projects, I tend to create function files that are sourced by other files, sourcing it upon setting up a document. It promotes consistency, continuity, standardisation and simplification.

A better idea is to create packages, as I am increasingly reusing functions between different projects. Hadley Wickham wrote a whole book advocating the use of packages to create fundamental units of shareable R code, bundling together code, data, documentation, and tests.

func_rename_tidy <-
  function(.) {
    gsub("[^[:alnum:] \\_\\.]", "", .) %>%
      str_replace_all(pattern = " |\\.", replacement = "\\_") %>%
      str_replace_all(pattern = "\\_+", replacement = "\\_") %>%
      str_replace_all(pattern = "\\_$|\\.$", replacement = "")
  }

General Parameters

Grouping generic parameters in one section quickly allows new users to adopt a document customised to their environment and for its intended use. Here I am setting up the relative path to the source data.

directory_path <- "../../resources/england_football_simulation/"

Importing

The data type of each column is guessed when the base source data is imported. I always increase the guess_max parameter as a rule unless I know the data structure in advance.

I have previously imported data where the first few hundred values in a column are empty, having populated values further down the table. The import function guesses the data-type as logical when it isn’t, resulting in subsequent populated values incorrectly coerced to NA.

A hangover from working with databases, I tend to tidy column names upon import, using the func_rename_tidy function as it simplifies coding after import.

# IO: In: df
df <- 
  readr::read_csv(
    file = paste0(directory_path, "football.csv"), 
    guess_max = 100000
  ) %>% 
  rename_all(func_rename_tidy)

## Parsed with column specification:
## cols(
##   No. = col_double(),
##   Player = col_character(),
##   `Date of birth (age)` = col_character()
## )

Let’s take a look at the first few rows of data and simultaneously create an initial table for later comparison.

kable(
  df_initial <-
    df %>% 
    head()
)

Tidying

The Date_of_birth_age field contains multiple variables, depicting the date-of-birth, and age calculated at the time the article was published. This is messy data, which I have previously written about.

The DOB is extracted from the field and converted to a date datatype, with the age part discarded. A new feature Age is created, which is the calculated interval between DOB field and the lubridate::today() function.

df <-
  df %>%
  rename(DOB = Date_of_birth_age) %>% 
  mutate_at(vars(DOB), ~
              str_remove(., pattern = "\\(age \\d+\\)") %>% 
              str_trim(., side = "both") %>% 
              dmy(.)) %>% 
  mutate(Age = DOB %>% 
           interval(today()) %>%
           as.period(unit = "year") %>% 
           year())

Let’s inspect the head of the tidied compared with the initial dataframe.

  df_initial %>% 
  
  # Join the newly created table with the initial table using the common fields
  inner_join(
    df %>%
      head(),
    by = c("No", "Player")) %>% 
  kable() %>% 
  kable_styling(full_width = FALSE) %>%
  add_header_above(c("Common fields" = 2, 
                     "Initial field\nwith multi-values" = 1,
                     "New\nsplit fields" = 2)) %>% 
  column_spec(3, background = "red", color = "white") %>% 
  column_spec(4:5, background = "lightgreen")

This confirms that the DOB field has been converted into a date field, and used to calculate the Age based on today(), the current date when the notebook was run.

Simulation Scenario

The number of repetitions for each one of the standard exercises are logged during a training session. Most players are unable to train every day, so there are gaps in the timeline for each player during the recorded period, with some players missing more sessions compared with others.

The exercises included:

• Horizontal Seated Leg Press
• Lat Pull-Down
• Cable Biceps Bar
• Cable Triceps Bar
• Chest Press
• Hanging Leg Raise

Simulation Process

The graph shows the simulation data process flow cycle.

Simulation Process Cycle

Between 15 and 22 players train daily, represented by the Sampled Players in the above graph. Days during the two months where no exercises are simulated are coded those as Day Off.

Some of the exercises repetitions, represented by Repetitions in the graph have a zero count, the case where a player skips an exercise during a training session.

Let’s start this section by creating some parameters and reference values.

Simulation Parameters

# Players: group size
param_group_size <- df %>% nrow()

# Training: Gym exercises + Day off
param_exercises <-
  c(
  "Horizontal Seated Leg Press",
  "Lat Pull-Down",
  "Cable Biceps Bar",
  "Cable Triceps Bar",
  "Chest Press",
  "Hanging Leg Raise",
  "Day Off"
)

# Factor version of the exercises which helps to retain order when graphing
param_exercises_factored <-
  param_exercises %>% 
  factor(ordered = TRUE)

# Starting date of the log
param_date_start <- ymd("2018-03-01")

# Creating data ranges, one for 2017 and another for 2018, packaging it nicely
# into a tibble
param_days <- 
  
  tibble(
    Date = c(
      # 2018 data
      seq.Date(
        from = param_date_start,
        by = "day",
        length.out = 28
      ),
      
      # 2017 data
      seq.Date(
        from = param_date_start - years(1),
        by = "day",
        length.out = 28
      )
    )
  )

Simulation Function

The following code section is the simulation function that maps together the parameters with random combinations and sequences through the simulation process, as represented by the Simulation Process Cycle graph shown above.

func_create_data <-
  
  # As with the process graph, each day from the param_days tibble is used as a
  # input to start a new simulated cycle
  function(param_day) {
    
    # Use the integer value of the day to set a seed value, which means that
    # this part of the simulation can be recreated as is
    set.seed(param_day %>% as.integer())
    
    # create the sample size from the 22 players, sampling a value between 15
    # and 22 which represent the total number of players that exercise in a
    # single day
    training_group_size <- sample(15:param_group_size, 1)
    
    # Generate between training_group_size-value samples, instanced from a population
    # between 1 to 22 without replacement
    sample(x = 1:param_group_size,
             replace = FALSE,
             size = training_group_size) %>%
      
      # Map each sampled player in the distribution to all 6 exercises
      purrr::map(function(param_player_number) {
       param_exercises[1:6] %>%

          # for each one of the exercises, create a random sample between 0 and
          # 20 repetitions
          purrr::map(function(param_excercise) {
          
              # Populate a tibble with all parameters used within the daily
              # cycle simulation.  This part is truly random and will be
              # different between all iterations
            tibble(
              No = param_player_number,
              Exercise = param_excercise,
              Volume = sample(x = 0:20,
                             replace = FALSE,
                             size = 1)
            ) %>%
              return()
          })
      }) %>%
      
      # Return and nest the result in the daily tibble, corresponding its
      # calling date
      return()
  }

Executing the Simulation

The code section below calls the tmp_exercise_data function by feeding it the previously created parameters.

tmp_exercise_data <- 
  param_days %>%
  
  # Map the list of days to the func_create_data function to simulate the data
  mutate_at(vars(Date), list(data = purrr::map), func_create_data) %>% 
  
  # The unnest() function returns all iteratively nested cycled data to a top
  # param_days level
  unnest(data) %>%
  unnest(data) %>%
  unnest(data) %>% 
  
  # Complete the data for all combinations of the player no, date and exercise,
  # creating explicit entries for the missing combinations
  complete(No, Date, Exercise) %>% 
  
  # Create a new variable by extracting the year value from the date
  mutate_at(vars(Date), list(Year = year)) %>% 
  
  # Group by Player Number and nest the simulated data in the `training_data`
  # column
  group_by(No) %>%
  nest() %>% 
  rename(training_data = data)

Explore the Simulated Data

Let’s take a look at the first few rows of player data joined with the simulated data.

df %>%
  select(Player, No) %>%
  
  # Select the first three players in the list
  head(3) %>%
  
  # Join the player information (DOB) with the latest year (2018) from the
  # simulated exercise log
  inner_join(tmp_exercise_data %>% 
               unnest(training_data) %>% 
               filter(Year == max(Year)) %>% # 2018 in this example
               filter(! is.na(Volume)) %>% 
               select(-Year)
               ,
             by = "No") %>%
  select(-No) %>%
  
  # Spread the exercises as columns and populate Volume as its value
  pivot_wider(names_from = Exercise, values_from = Volume) %>%
  group_by(Player) %>% 
  
  # select the top three dates for each of the first three players
  top_n(3, wt = Date) %>%
  kable() %>%
  kable_styling(full_width = FALSE,
                font_size = 9) %>%
  column_spec(1, bold = TRUE) %>%
  collapse_rows(columns = 1:1, valign = "top")

The following graph shows the cumulative repetitions by player and exercise over a timeline, highlighting the missed training sessions in red.

The func_visualise_day_off function is used to impute a value for the days without exercise data for a player, making it explicit when visualising the data.

func_visualise_day_off <-
  
  # This function is to explicitly visualise the `Day Off` when graphing the exercise
  # log
  function(df) {
    df %>% 
      
      # Remove all entries with zero volume
      filter(! is.na(Volume)) %>% 
      
      # Extract the entries where all exercises for each player and day
      # combination have zero volume, and overwrite it with 100 in order to
      # visualise it in the context of the exercises
      union_all(
        df %>% 
          group_by(No, Date) %>% 
          filter(any(is.na(Volume))) %>% 
          distinct(No, Date) %>% 
          mutate(Exercise = "Day Off", 
                 Volume = 100)    
      ) %>% 
      return()
  }

param_colour_ramp <-
  
  # Create a colour ramp that maps the colours with the factored exercises, which
  # includes the `Day Off`
  function() {
    # Create an array of colour data
    tmp <- c(viridis::cividis(n = 6), "red")
    
    # Reorder colour values to align with the exercises and `Day Off`
    tmp <-
      c(
        tmp[1:3], # First 3 exercise colour values
        tmp[7], # Day Off colour in red
        tmp[4:6] # Last 3 exercise colour values
      )
  }

# Create a plot dataframe as we will use filtered parts of it in different geoms
# in the plot
plot_data <-
  df %>% 
  
  # Plot data for the first 9 players in the list
  head(9) %>% 
  
  # Join the exercise log with the player data
  inner_join(
    tmp_exercise_data %>% 
      unnest(training_data) %>% 
      filter(Year == 2018) %>%
      
      # Explicitly add in the missing days per player and add volume to plot it
      func_visualise_day_off(),
    by = "No") %>% 
  
  # Convert the exercises into levelled factors to retain the order of the exercises when plotting
  mutate_at(vars(Exercise), factor, levels = param_exercises_factored, ordered = TRUE)

# Now plot the data
plot_data %>%
  
  # Remove the `Day Off` from the tibble and plot the volume of exercises over
  # the timeline, splitting exercises by colour
  filter(! grepl("day", Exercise, ignore.case = TRUE)) %>%
  ggplot(aes(x = Date, y = Volume, fill = Exercise)) +
  geom_area() +
  
  # Plot the `Day Off` as bars in the timeline
  geom_col(data  =
             plot_data %>%
             filter(grepl("day", Exercise, ignore.case = TRUE)),
           width = 0.5
           ) +
  
  # Wrap the plot by player
  facet_wrap(~ Player) +
  
  # Tidy up the x (data) scale to a suitable format
  scale_x_date(date_labels = "%d-%b") +
  theme_classic() +
  
  # Manually populate the colour fill values with the function created
  scale_fill_manual(values = param_colour_ramp()) +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "bottom") +
  labs(title = "English football team training log",
       subtitle = "Volume of reps per exercise & days off over 28 days",
       x = "Date [2018]")

Export Process

The aim of this part is to output data into a variety of files to be consumed in Part 4, which is to Import Simulated Data.

The following image shows the process by which data is transformed, grouped and outputted into a variety of file types.

Data Export Process

The training log data is grouped by year, data nested and exported to two file-types, including Excel and CSV.

2017 data is exported to Excel, mapping each player and associated data to a tab. The 2018 data is exported to CSV file-type, with each exercise written to its own file.

library(openxlsx) 

wb <- createWorkbook()
# create workbook instance to populate with tabs and tables

# Join player and simulated data
df_exercise_tab <-
  df %>%
  inner_join(tmp_exercise_data %>%
               unnest(),
             by = "No") %>%
  
  # Filter on the initial year (2017)
  filter_at("Year", all_vars(. == min(.))) %>% 
  
  # Create new duplicage variable `tab` from Player, using it to group data and
  # output as tabs within the spreadsheet
  mutate(tab = Player) %>% 
  group_by(tab) %>%
  
  # And nest all data for each Player
  nest()

# populate the tabs by walking through the combination of tabs and associated
# data
list(
  df_exercise_tab$tab,
  df_exercise_tab$data
) %>%
  pwalk(function(file_tab, file_data) {
    
    # add a tab
    addWorksheet(wb, sheetName = file_tab, gridLines = FALSE)
    setColWidths(wb, file_tab, cols = 2:20, widths = 12)
    
    # Insert a datatable
    writeDataTable(
      wb,
      sheet = file_tab,
      file_data %>% unnest(),
      startCol = "A",
      startRow = 1,
      bandedRows = TRUE,
      tableStyle = "TableStyleLight1"
    )
  })

# IO: Out: Excel
saveWorkbook(
  wb = wb, 
  file = paste0(directory_path,
                "england_football_exercise_training_log_2017.xlsx"),
  overwrite = TRUE)

# Join Player data and simulated exercise data
df_exercise_tab <-
  df %>%
  inner_join(tmp_exercise_data %>%
               unnest(cols = c(training_data)),
             by = "No") %>% 
  
  # Filter to retain the max year only (2018)
  filter_at(vars(Year), all_vars(. == max(.))) %>% 
  
  # Create a duplicate variable for Exercise and group by it
  mutate(Exercise_csv = Exercise) %>% 
  group_by(Exercise_csv) %>% 
  
  # Nest the data within each exercise 
  nest()

# IO: Out: csv
list(
  df_exercise_tab$Exercise_csv,
  df_exercise_tab$data
) %>%
  
  # Step through list of exercises and nested data
  pwalk(function(csv_name, csv_data) {
    csv_data %>%
      
      # Write each exercise nested data to a file, appending `2018` to each
      # tidied exercise name to create a file name
      write_csv(
        path = paste0(
          directory_path,  # Directory Path
          csv_name %>%  # Tidied name of the Exercise
            func_rename_tidy() %>%
            str_to_lower(),
          "_2018.csv"  # Add the Year extention
        )
      )
  })

Import Process

The aim is to dynamically import data into a common dataframe. With Excel files, the function lists and unnest all the tabs, and import each table back into the calling files tibble as is the case with CSV files.

Data Import Process

Import Function

The func_get_file_dynamic function dynamically imports data depending on file-type, depicted in the process graph above.

func_get_file_dynamic <- 
  function(file_name) {
    
    # Check if file name contains .xlsx and map all tabs within it
    if(grepl("xlsx", file_name, ignore.case = TRUE)) {
      tibble(
        file_path = paste(directory_path, file_name, sep = "/"),
        file_tab = excel_sheets(path = paste(directory_path, file_name, sep = "/"))
      ) %>%
        
        # unnest the list of tabs for each file and import columns with detault
        # `text` datatype
        unnest(file_tab) %>%
        mutate(file = purrr::map2(file_path, file_tab, function(file_path, file_tab) {
          read_excel(path = file_path,
                     col_types = "text",
                     sheet = file_tab, 
                     guess_max = 100000)
        })) %>%
        unnest(file) %>%
        return()
    } else {
      
      # assume that alternative file type is .csv
      read_csv(
        file = paste(directory_path, file_name, sep = "/"),
        guess_max = 100000,
        
        # set default datatype as text, similar to Excel config
        col_types = cols(.default = col_character())
      ) %>%
        return()
    }
  }

List and import the files

In this section we generate a list of the files located in the directory_path parameter folder, import it using the func_get_file_dynamic function, unnest it and parse_guess the data-types.

files_expanded <-
  
  # find all files within directory and underlying folders
  list.files(path = directory_path,
           recursive = TRUE) %>%
  
  # create a tibble of the files and rename the file name to fil_name
  enframe(name = NULL) %>%
  rename(file_name = value) %>% 
  
  # exclude the football file from the results
  filter(! grepl(file_name, pattern = "football\\.csv$", ignore.case = TRUE)) %>% 
  
  # extract the file type for future processing
  mutate_at(vars(file_name), list(file_source = str_extract), pattern = "\\.(csv|xlsx)$") %>% 
  
  # dynamically import the files and nest the file column
  mutate_at(vars(file_name), list(file = purrr::map), func_get_file_dynamic) %>% 
  
  # Unnest all files and consolidate columns, then only guess the data type.
  # This prevents any errors if there are columns with the same file-names but
  # have different datatypes.
  unnest(file) %>% 
  mutate_all(parse_guess)

Let’s check the first few rows of the imported data.

# Inspect the first 6 rows of the newly imported files
files_expanded %>% 
  head() %>% 
  kable() %>%
  kable_styling(full_width = FALSE,
                font_size = 9) %>%
  column_spec(1, bold = TRUE)

Visualise Imported Data

Now create a couple of visualisations. The first is the number of records per CSV file or per Excel tab after removing entries with missing or zero volume.

# Visualise the imported file data
files_expanded %>%
  
  # filter to retain exercises with volume > 0 only, including removing those
  # with NA
  filter(Volume > 0) %>% 
  mutate_at(vars(file_tab), ~coalesce(., "None")) %>% 
  
  # This creates a count of rows for combination of file_name, file_tab and
  # file_source
  count(file_name, file_tab, file_source) %>% 
  
  # Create new feature showing tab and file names where relevant:
  # With CSV files:  remove .csv and 2018 from the file name
  # With Excel file: show the tabs only
  mutate(file_tab = case_when(
    grepl(file_name, pattern = "csv", ignore.case = TRUE) ~ 
      file_name %>%
      str_remove("\\.csv") %>% 
      str_remove("\\_2018"),
    TRUE ~ file_tab
  )) %>% 
  
  # Replace the underscore from the file_tab feature with spaces
  mutate_if(is.character, str_replace_all, pattern = "_", replacement = " ") %>% 
  
  # Turn file_tab into factor and order the descending count (n)
  arrange(desc(n)) %>% 
  mutate_at(vars(file_tab), fct_inorder) %>% 
  ggplot(aes(x = file_tab, y = n, fill = file_source)) +
  geom_col() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  scale_fill_viridis_d(option = "E") +
  labs(title = "Number of records by file source", 
       subtitle = "Empty records and zero counts removed", 
       fill = "File Source",
       x = "File or Tab",
       y = "# Records")

Now combine the file data and create a plot grouped by Player, file type and Year.

# Calculate the average count of records by player
param_player_file_source_ave <-
  files_expanded %>% 
  filter(Volume > 0) %>% 
  count(Player, file_source) %>%
  ungroup() %>% 
  summarise_if(is.numeric, mean) %>% 
  pull()
  
files_expanded %>% 
  filter(Volume > 0) %>% 
  mutate_at(vars(file_tab), ~coalesce(., "None")) %>% 
  count(Player, Year, file_source) %>% 
  mutate_if(is.character, str_replace_all, pattern = "_", replacement = " ") %>% 
  group_by(Player) %>% 
  mutate(total_score = sum(n)) %>% 
  arrange(desc(total_score)) %>% 
  ungroup() %>% 
  mutate_at(vars(Player), fct_inorder) %>% 
  ggplot(aes(x = Player, y = n, fill = n)) +
  geom_col() +
  geom_hline(yintercept = param_player_file_source_ave,
             col = "red",
             lty = 2,
             size = 0.5
             ) +
  annotate("text",
           x = 5,
           y = param_player_file_source_ave + 20,
           label = paste("Average:", round(param_player_file_source_ave)),
           col = "red",
           size = 4
           ) +
  facet_grid(file_source + Year ~ .) +
  scale_fill_viridis_c() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(title = "Number of records by player and file source", 
       subtitle = "Empty records and zero counts removed", 
       fill = "# Records",
       x = "Player",
       y = "# Records")