3 Visualising Results for a Single Stage | Visualising WRC Rally Timing and Results Data

3.1 Load Base Data

To get the splits data from a standing start, we can load in the current season list, select the rally we want, look up the itinerary from the rally, extract the sections and then the stages and the retrieve the stage ID for the stage we are interested in.

To begin with, load in our WRC API helper functions:

source('code/wrc-api.R')

Now let’s grab some data:

s = get_active_season()
eventId = get_eventId_from_name(s, 'arctic')

entries = get_rally_entries(eventId)

itinerary = get_itinerary(eventId)
sections = get_sections(itinerary)
stages = get_stages(sections)
stages_lookup = get_stages_lookup(stages)

Get a sample stage ID:

stageId = stages_lookup[['SS3']]

3.2 Get Stage Results Data

Start by loading in some stage times data and previewing the columns available to us:

stage_times = get_stage_times(eventId, stageId)

colnames(stage_times)

##  [1] "stageTimeId"       "stageId"           "entryId"          
##  [4] "elapsedDurationMs" "elapsedDuration"   "status"           
##  [7] "source"            "position"          "diffFirstMs"      
## [10] "diffFirst"         "diffPrevMs"        "diffPrev"

3.3 Previewing Stage Results Data

Just using the stage results data, how might we display it?

Let’s start with a view of the top 10. We can use the knitr::kable() function to provide a styled version of the table that slightly improves its appearance:

library(knitr)

kable( head(stage_times, 10))

stageTimeId	stageId	entryId	elapsedDurationMs	elapsedDuration	status	source	position	diffFirstMs	diffFirst	diffPrevMs	diffPrev
96580	1750	21536	834500	00:13:54.5000000	Completed	Default	1	0	00:00:00	0	00:00:00
96474	1750	21532	835500	00:13:55.5000000	Completed	Default	2	1000	00:00:01	1000	00:00:01
96623	1750	21539	839100	00:13:59.1000000	Completed	Default	3	4600	00:00:04.6000000	3600	00:00:03.6000000
96509	1750	21533	840200	00:14:00.2000000	Completed	Default	4	5700	00:00:05.7000000	1100	00:00:01.1000000
96656	1750	21538	841900	00:14:01.9000000	Completed	Default	5	7400	00:00:07.4000000	1700	00:00:01.7000000
96624	1750	21530	842000	00:14:02	Completed	Default	6	7500	00:00:07.5000000	100	00:00:00.1000000
96693	1750	21534	843200	00:14:03.2000000	Completed	Default	7	8700	00:00:08.7000000	1200	00:00:01.2000000
96480	1750	21540	844300	00:14:04.3000000	Completed	Default	8	9800	00:00:09.8000000	1100	00:00:01.1000000
96523	1750	21531	845800	00:14:05.8000000	Completed	Default	9	11300	00:00:11.3000000	1500	00:00:01.5000000
96419	1750	21537	846900	00:14:06.9000000	Completed	Default	10	12400	00:00:12.4000000	1100	00:00:01.1000000

An alternative rich table formatter is the formattable (example usage) R package which builds on kable() and provides even more comprehensive support,, including cell colour highlighting, for rendering tables in a stylised way. In interactive HTML environments, the tables are rendered as an HTML widget, which allows for even more customisation, such as the inclusion of interactive HTML sparklines.

library(formattable)

formattable( head(stage_times, 10) )

stageTimeId	stageId	entryId	elapsedDurationMs	elapsedDuration	status	source	position	diffFirstMs	diffFirst	diffPrevMs	diffPrev
96580	1750	21536	834500	00:13:54.5000000	Completed	Default	1	0	00:00:00	0	00:00:00
96474	1750	21532	835500	00:13:55.5000000	Completed	Default	2	1000	00:00:01	1000	00:00:01
96623	1750	21539	839100	00:13:59.1000000	Completed	Default	3	4600	00:00:04.6000000	3600	00:00:03.6000000
96509	1750	21533	840200	00:14:00.2000000	Completed	Default	4	5700	00:00:05.7000000	1100	00:00:01.1000000
96656	1750	21538	841900	00:14:01.9000000	Completed	Default	5	7400	00:00:07.4000000	1700	00:00:01.7000000
96624	1750	21530	842000	00:14:02	Completed	Default	6	7500	00:00:07.5000000	100	00:00:00.1000000
96693	1750	21534	843200	00:14:03.2000000	Completed	Default	7	8700	00:00:08.7000000	1200	00:00:01.2000000
96480	1750	21540	844300	00:14:04.3000000	Completed	Default	8	9800	00:00:09.8000000	1100	00:00:01.1000000
96523	1750	21531	845800	00:14:05.8000000	Completed	Default	9	11300	00:00:11.3000000	1500	00:00:01.5000000
96419	1750	21537	846900	00:14:06.9000000	Completed	Default	10	12400	00:00:12.4000000	1100	00:00:01.1000000

The data itself looks quite cryptic, so we need to convert it to something a little bit more human readable. To enrich the display, we might want to add in information relating to a stage, rather than just refer to it by stage ID, or to describe each entry in rather more detail than just by the entry ID.

The way the table is actually presented may also mean that not all the columns may be displayed, so reducing the number of columns would presumably help address that, in part at least.

3.3.1 Adding Entry Metadata

In the first instance, it would probably make sense to pull in some human readable data about each entry:

cars = get_car_data(entries)

cars %>% head(2)

##   entryId driverId codriverId manufacturerId vehicleModel eligibility classname
## 1   21530      670       3027             84    Yaris WRC           M       RC1
## 2   21531      534        553             84    Yaris WRC           M       RC1
##   manufacturer             entrantname groupname identifier drivername code
## 1       Toyota TOYOTA GAZOO RACING WRT       WRC          1   S. OGIER  OGI
## 2       Toyota TOYOTA GAZOO RACING WRT       WRC         33   E. EVANS  EVA
##    driverfullname codrivername codriverfullname
## 1 Sébastien OGIER J. INGRASSIA Julien INGRASSIA
## 2     Elfyn EVANS    S. MARTIN     Scott MARTIN

We can the merge this data into our original table, and filter out some of the less useful columns. Since the driver code may not be unique, we should retain the driver entryId in the table and then suppress its display when we render the dataframe. We’ll also limit ourselves to just the top 10 results.

top10_display_cols_base = c('position', 'identifier', 'code',
                            #'drivername', 'codrivername',
                            #'groupname', 'entrantname',
                            #'classname', 'eligibility',
                            #'elapsedDuration',
                            # gap is the time delta between a driver
                            # and the leader; diff (or interval)
                            # is the difference between a driver
                            # and the driver immediately ahead
                            'TimeInS', 'gap', 'diff')

top10_stage_times = stage_times %>%
                      # A minor optimisation step to 
                      # limit the amount of merging
                      arrange(position) %>%
                      head(10) %>%
                      # Merge in the entries data
                      merge(cars, by='entryId')  %>%
                      # Convert milliseconds to seconds
                      mutate(TimeInS = elapsedDurationMs/1000,
                             gap = diffFirstMs/1000,
                             diff = diffPrevMs/1000)  %>%
                      # Limit columns and set column order
                      select(all_of(top10_display_cols_base),
                             'entryId') %>%
                      # The merge may upset the row order
                      # so reset the order again
                      arrange(position) %>%
                      # Improve column names by renaming them
                      rename(Pos=position,
                             Car = identifier,
                             Code = code,
                             `Time (s)` = TimeInS,
                             Gap = gap, Diff = diff)

top10_stage_times %>% head(3) %>% formattable()

Pos	Car	Code	Time (s)	Gap	Diff	entryId
1	8	TÄN	834.5	0.0	0.0	21536
2	11	NEU	835.5	1.0	1.0	21532
3	2	SOL	839.1	4.6	3.6	21539

We can suppress the display of the entryId colum to keep the table tidy:

top10_stage_times %>% head(3) %>% formattable(list(entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6

3.4 Adding Stage Metadata to Table Captions

To improve the table further, we may want to add a caption to the table describing the stage to which the results actually refer.

The caption might include the stage code and the stage name, for example, and perhaps the stage distance. It might also be handy to retrieve the stage number so that if we are displaying several tables, we can check we present the stages in the correct running order:

stage_cols = c('stageId', 'number', 'name', 'distance', 'code')

stage_info = stages %>%
                select(all_of(stage_cols)) %>%
                # Tidy up the stage name
                mutate(name = str_replace(name, ' \\(Live TV\\)', ''))

stage_info %>% head(2)

##   stageId number          name distance code
## 1    1747      1 Sarriojärvi 1    31.05  SS1
## 2    1743      2 Sarriojärvi 2    31.05  SS2

We can create a caption for our selected stage using what essentially amounts to a string template:

stage_info_ = stage_info[stage_info['stageId']==stageId,]
# paste0() ensures there are no separators between substrings
caption = paste0('Stage ', stage_info_$code,
                 ', ', stage_info_$name, ' (',
                 stage_info_$distance, 'km)')

caption

## [1] "Stage SS3, Mustalampi 1 (24.43km)"

We can add a caption to the table via the caption parameter. Using the %>% pipe operator to pass the dataframe as the first argument of the formattable() function allows us to more clearly see what parameter we need to set in the function to create the caption.

The pipe operator also allows us to limit the number of rows in the dataframe passed to the formattable() function via the head() function:

top10_stage_times %>% head(3) %>% formattable(caption = caption,
                                              list(entryId=FALSE))

Table 3.1: Stage SS3, Mustalampi 1 (24.43km)
Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6

We can also align text within the columns:

top10_stage_times %>% head(3) %>% formattable(align='c',
                                              list(entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6

3.5 Colour Highlighting Stage Results

The formattable::formattable() function is capable of highlighting cell values in a variety of customisable ways.

One straightforward way of highlighting a table is to use colour to emphasise a ranking. Trivially, and perhaps redundantly, we might highlight stage positions for example:

top10_stage_times %>%
    head() %>%
    formattable(align='c',
                list(Pos = color_tile("#DeF7E9", "#71CA97"),
                     entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1

This may not make so much sense when the ranking we are highlighting is the sort order of the table, but it makes more sense when we want to compare two columns, such as the stage position and the start order.

So let’s also pull in the start order (that is, the road order) and see how it compares to the stage position.

TO DO: - get itinerarySectionId from stages (stages$itinerarySectionId) - get startListId (get_startlist_id(itinerary, itinerarySectionId)) - lookup startlist details (get_startlist(eventId, startListId)[,c('entryId','order')]) - merge startlist data into stage result

We can also explore highlights based on conditional requirements. For example, we can emphasise differences that exceed a specific amount:

large_diff = 2

formattable(top10_stage_times,
            list(Diff = formatter("span",
                          style = x ~ style(font.weight =
                                              ifelse(x>=large_diff,
                                                     "bold", 'normal'))),
                 entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1
7	18	KAT	843.2	8.7	1.2
8	7	LOU	844.3	9.8	1.1
9	33	EVA	845.8	11.3	1.5
10	3	SUN	846.9	12.4	1.1

Alternatively, we can add a coloured bar that depicts the increasing gap time down the leaderboard. If we pass an 8 hex digit colour code, rather than a sic digt RGB hex colour code, we can modify the transparency of the colour bar:

#https://www.displayr.com/formattable/
unit.scale = function(x) (x - min(x)) / (max(x) - min(x))

formattable(top10_stage_times,
            list(Gap = color_bar("#FA614B66", fun = unit.scale),
                 entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1
7	18	KAT	843.2	8.7	1.2
8	7	LOU	844.3	9.8	1.1
9	33	EVA	845.8	11.3	1.5
10	3	SUN	846.9	12.4	1.1

There seems to be an edge effect there for the zero gap value? Let’s see if we can tidy that up a bit:

new_color_bar <- function(color = "lightgreen", ...){
  formatter("span",
            style = function(x) style(
              display = "inline-block",
              direction = "rtl", 
              `unicode-bidi` = "plaintext",
              "border-radius" = "4px",
              "background-color" = color,
              width = percent(proportion(abs(as.numeric(x)), ...))
            ))
}

formattable(top10_stage_times,
            list(Gap =  new_color_bar("#FA614B66"),
                 entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1
7	18	KAT	843.2	8.7	1.2
8	7	LOU	844.3	9.8	1.1
9	33	EVA	845.8	11.3	1.5
10	3	SUN	846.9	12.4	1.1

The edge effect is gone, but the default color_bar() function doesn’t seem to render the values very well where the bars is narrow, at least when the table is rendered to HTML using bookdown.

If we provide am alternative color bar function that makes use of a CSS linear gradient to create the bar rather than a setting the width of text cell and colouring its background we can decouple the color bar and the size of the text area:

bg = function(start, end, color, ...) {
  paste("linear-gradient(90deg,transparent ",percent(start),",",
        color, percent(start), ",", color, percent(end),
        ", transparent", percent(end),")")
} 

color_bar2 =  function (color = "lightgray", fun = "proportion", ...) 
{
    fun <- match.fun(fun)
    formatter("span", style = function(x) style(display = "inline-block",
                `unicode-bidi` = "plaintext", 
                "background" = bg(1-fun(as.numeric(x), ...), 1, color), "width"="100%" ))
}

top10_stage_times %>% formattable(list(Gap = color_bar2("#FA614B66"),
                                       entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1
7	18	KAT	843.2	8.7	1.2
8	7	LOU	844.3	9.8	1.1
9	33	EVA	845.8	11.3	1.5
10	3	SUN	846.9	12.4	1.1

3.5.1 Heatmap Style Column Cell Backgrounds

As well as in cell bar charts, we can also use more of a heatmap style approach and colour the background down other numerical columns according to value.

top10_stage_times %>% 
  formattable(list(Gap = color_bar2("#FA614B66"),
                   Diff = color_tile("#DeF7E9","#71CA97"),
                   entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	834.5	0.0	0.0
2	11	NEU	835.5	1.0	1.0
3	2	SOL	839.1	4.6	3.6
4	69	ROV	840.2	5.7	1.1
5	42	BRE	841.9	7.4	1.7
6	1	OGI	842.0	7.5	0.1
7	18	KAT	843.2	8.7	1.2
8	7	LOU	844.3	9.8	1.1
9	33	EVA	845.8	11.3	1.5
10	3	SUN	846.9	12.4	1.1

3.6 An Aside — Calculating DIFF and GAP times

As has previously been mentioned, the GAP to leader and +/- DIFF times to any car placed directly ahead of a particular car, are typical across many forms of motorsport timing screen. In rally terms, these metrics might apply either in overall rally terms or in stage terms; in circuit racing, the measures might apply relative to overall race position or track position.

The GAP (time to leader) is calculated as the difference between a time associated with the current leader and a similarly measured time associated with every other driver.

The $\textrm{GAP}$ between driver in first position, $i=1$, and the driver in the $j$’th position is given in various abuses of the notation as:

\[\textrm{GAP}{_j}=t_{j,\textrm{GAP}}=t_{j,1,DIFF}=t_j-t_1\]

Alternatively, we can calculate the gap as the sum of differences between consecutively placed drivers, $j\neq1$, and the leader. The interval or DIFF between drivers in positions $i$ and $j$, where $i$ is ahead of $j$ (that is, $i<j$) and the driver in first position has $i=1$ is given as:

\[\textrm{DIFF}_{j,i}=t_{j,i,\textrm{DIFF}}=t_{j,i}=t_j-t_i: i<j, t_0=t_1\]

Strictly, $\textrm{GAP}_j=\textrm{DIFF}_{j,1}$.

To specify a particular stage, we might use ${_S}\textrm{GAP}{_j}$ and ${_S}\textrm{DIFF}{_j}$.

The $\textrm{GAP}$ between a driver in position $j=P$ and the leader $i=1$ is then:

\[\textrm{GAP}_j=t_{j,\textrm{GAP}}=\textrm{DIFF}_{2,1}+\textrm{DIFF}_{3,2}+..+\textrm{DIFF}_{P,P-1}\]

We can write this more succinctly as:

\[\textrm{GAP}{_j}=t_{j,\textrm{GAP}}=0+\sum_{m=1}^{j}\textrm{DIFF}_{m,m-1}=\sum_{m=1}^{j}\left ( t_m-t_{m-1} \right ): j\ge1, t_0=t_1\]

We can implement these calculations directly as follows:

top10_stage_times %>% 
  mutate(DIFF = c(0, diff(`Time (s)`)),
         GAP = cumsum(DIFF)) %>%
  select(c('Car', 'Gap', 'GAP', 'Diff', 'DIFF')) %>%
  formattable(caption = caption,
              list(entryId=FALSE))

Table 3.2: Stage SS3, Mustalampi 1 (24.43km)
Car	Gap	GAP	Diff	DIFF
8	0.0	0.0	0.0	0.0
11	1.0	1.0	1.0	1.0
2	4.6	4.6	3.6	3.6
69	5.7	5.7	1.1	1.1
42	7.4	7.4	1.7	1.7
1	7.5	7.5	0.1	0.1
18	8.7	8.7	1.2	1.2
7	9.8	9.8	1.1	1.1
33	11.3	11.3	1.5	1.5
3	12.4	12.4	1.1	1.1

3.7 Rebasing Stage Results

Simple as they are, the GAP and DIFF times are very powerful: for any driver, we can see how far off the stage winning time they were (the Gap) and by summing appropriate Diff values you can quickly determine the time difference between any two drivers.

However, if we are interested in a particular driver, we can “rebase” the table to show the time differences between that driver and the other drivers explicitly.

To rebase times, $t_i$ for a set of drivers, $i$, relative to a particular driver, $j$, we set:

\[ t_{i}^{j} = t_i - t_j \] For a stage $S$, we might extend the notation to write:

\[ {_S}t_{i}^{j} = {_S}t_{i} - {_S}t_{j} \]

using the simpler form with the $S$ prefix where the stage is known.

We might also abuse the $textrm{GAP}$ notation to specify a rebased time $_S\textrm{GAP}_{i,j}={_S}t_{i}^{j}$ noting ${_S}\textrm{GAP}_i={_S}\textrm{GAP}_{i,1}={_S}\textrm{DIFF}_{i,1}$.

In passing, we note that we can calculate the overall rally time (without penalties) for driver $i$, up to and including stage $N$ as:

\[ {_N}T_{i}=\sum_{S=1}^{N}{_S}t_{i} \]

The overall time at the end of the rally is then given as:

\[ T_{i}=\sum_{S=1}^{S{_{max}}}{_S}t_{i} + {penalties}_i \]

Let’s see how the rebasing works.

First, get a driver code:

ogier = get_person_id(cars, 'ogier', ret='identifier')
ogier

## [1] "1"

Now we can start to build up a rebase function that takes a data frame, an entryId and a set of columns we want to rebase.

To begin with, we note that we can rebase a single column simply by finding the value associated with a particular driver in that column and subtracting that value from each row in the column.

For example, we can get Ogier’s stage time:

ogier_time = top10_stage_times[top10_stage_times[['Car']]==ogier,
                               "Time (s)"]
ogier_time

## [1] 842

And we can then subtract that time from every other car’s time:

top10_stage_times$`Time (s)` - ogier_time

##  [1] -7.5 -6.5 -2.9 -1.8 -0.1  0.0  1.2  2.3  3.8  4.9

To rebase more than one column, we can specify a list of columns we want to rebase and then process the response as a named list before subtracting the items in that named list from each of the correspondingly named columns in each row of the dataframe:

#https://stackoverflow.com/a/32267785/454773
rebase_cols = c('Time (s)', 'Gap')

df = top10_stage_times

# From each row, select specific columns
# From those values subtract correspondingly named items
# representing the times in those columns for our specified driver
df[,rebase_cols] - c(df[df$Car==ogier, rebase_cols])

##    Time (s)  Gap
## 1      -7.5 -7.5
## 2      -6.5 -6.5
## 3      -2.9 -2.9
## 4      -1.8 -1.8
## 5      -0.1 -0.1
## 6       0.0  0.0
## 7       1.2  1.2
## 8       2.3  2.3
## 9       3.8  3.8
## 10      4.9  4.9

Let’s put that into a function, generalised to allow is to specify which column we want to use as a rebasing identifier column. Optionally allow the return of either just the rebased columns (and identifier) or the complete dataframe, including rebased columns, we well as the ability to “flip” the basis of the differences:

rebase = function(df, id, rebase_cols,
                  id_col='entryId', base=FALSE,
                  base_id=FALSE, flip=FALSE) {
  
  df_ =  df
  
  rebase_cols = as.character(rebase_cols)
  
  # The rebase values are the ones
  # we want to subtract from each row
  rebase_vals = c(df[df[[id_col]]==id, rebase_cols])
  
  # Do the rebasing
  df_[,rebase_cols] =  df[,rebase_cols] - rebase_vals
  
  if (flip)
    df_[,rebase_cols] =  -df_[,rebase_cols]

  df_[[id_col]] = df[[id_col]]
  
  # Return just the rebased and identifier columns or the
  # whole dataframe
  cols = rebase_cols
  if (base_id)
    cols = c(id_col, cols)
  if (base)
    df_ %>% select(cols)
  else
    df_
}

We can now rebase the stage times across one or more columns relative to a specified driver:

rebase_cols = c('Time (s)', 'Gap')

rov = get_person_id(cars, 'rov', ret='identifier')

rov_rebased_gap = rebase(top10_stage_times, rov, rebase_cols,
                           id_col='Car')
rov_rebased_gap

##    Pos Car Code Time (s)  Gap Diff entryId
## 1    1   8  TÄN     -5.7 -5.7  0.0   21536
## 2    2  11  NEU     -4.7 -4.7  1.0   21532
## 3    3   2  SOL     -1.1 -1.1  3.6   21539
## 4    4  69  ROV      0.0  0.0  1.1   21533
## 5    5  42  BRE      1.7  1.7  1.7   21538
## 6    6   1  OGI      1.8  1.8  0.1   21530
## 7    7  18  KAT      3.0  3.0  1.2   21534
## 8    8   7  LOU      4.1  4.1  1.1   21540
## 9    9  33  EVA      5.6  5.6  1.5   21531
## 10  10   3  SUN      6.7  6.7  1.1   21537

The rebased time dataframe makes it easier to see how a specified driver compares with every other driver. But can we make the differences jump out in a more striking fashion?

3.8 Colour Highlighting Rebased Values

In the rebased tables, we are likely to be presented with a range of positive and negative values within a rebased column.

We can highlight the positive and negative values using colour. For example:

formattable(rov_rebased_gap,
            list(Gap = formatter("span",
                          style = x ~ style(color = ifelse(x<0,
                                              "red", 
                                              ifelse(x>0, 'green', 'grey')),
                                            # Example additional style
                                            font.weight = ifelse(abs(x)>=2,
                                                            'bold',
                                                            'normal') )),
                 entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	-5.7	-5.7	0.0
2	11	NEU	-4.7	-4.7	1.0
3	2	SOL	-1.1	-1.1	3.6
4	69	ROV	0.0	0.0	1.1
5	42	BRE	1.7	1.7	1.7
6	1	OGI	1.8	1.8	0.1
7	18	KAT	3.0	3.0	1.2
8	7	LOU	4.1	4.1	1.1
9	33	EVA	5.6	5.6	1.5
10	3	SUN	6.7	6.7	1.1

Although the formattable() function does not directly support divergent colour indicators, we can create a custom formatter that does provide such a view over the data.

For example, we can create a mapping that will display coloured backgrounds that diverge around the zero value to give distinct hues for positive and negative values.

The easiest way to render such a mapping is to map the rage of value onto the unit range, and map the 0 value in the original range to the 0.5 value in the normalised unit range.

The following function will create a normalised range across a set of positive and negative values, mapping the origin (0) to the normalised 0.5 value:

xnormalize = function(x){
  # Normalise to the full range of values about 0
  # O will map to 0.5 in the normalised range
  x = c(x, -max(abs(x)), max(abs(x)))
  normalize(x)[1:(length(x)-2)]
}

Let’s see how it works:

xnormalize(c(-1, 0, 2))

## [1] 0.25 0.50 1.00

We can now define a custom mapping to render red and green palettised backgrounds depending on whether the value is negative or positive. To maintain contrast in the displayed text values, we can render white or black text depending on the likely intensity of the background colour:

#https://stackoverflow.com/a/49887341/454773
color_tile2 <- function (...) {
  formatter("span", style = function(x) {
    style(display = "block",
          'text-align' = 'center',
          padding = "0 4px", 
          `border-radius` = "4px",
          `font.weight` = ifelse(abs(x)> 0.3*max(x), "bold", "normal"),
          color = ifelse(abs(x)> 0.3*max(x),'white',
                         ifelse(x==0,'lightgrey','black')),
          `background-color` = csscolor(matrix(as.integer(colorRamp(...)(xnormalize(as.numeric(x)))), 
                byrow=TRUE, 
                dimnames=list(c("red","green","blue"), NULL),
                nrow=3)))
  })}

formattable(rov_rebased_gap, align='c',
            list(Gap = color_tile2(c("red",'white', "forestgreen")),
                 entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	-5.7	-5.7	0.0
2	11	NEU	-4.7	-4.7	1.0
3	2	SOL	-1.1	-1.1	3.6
4	69	ROV	0.0	0.0	1.1
5	42	BRE	1.7	1.7	1.7
6	1	OGI	1.8	1.8	0.1
7	18	KAT	3.0	3.0	1.2
8	7	LOU	4.1	4.1	1.1
9	33	EVA	5.6	5.6	1.5
10	3	SUN	6.7	6.7	1.1

For further possible discussions about divergent palette definitions, see here.

# Recall the CSS style from previously
#bg = function(start, end, color, ...) {
#  paste("linear-gradient(90deg,transparent ",percent(start),",",
#        color, percent(start), ",", color, percent(end),
#        ", transparent", percent(end),")")
#} 

pm_color_bar2 <- function(color1 = "lightgreen", color2 = "pink", ...){
  formatter("span",
            style = function(x) style(
              display = "inline-block",
              color = ifelse(x> 0,'green',ifelse(x<0,'red','lightgrey')),
              "text-align" = ifelse(x > 0, 'left', ifelse(x<0, 'right', 'center')),
              "width"='100%',
              "background" = bg(ifelse(x >= 0, 0.5,xnormalize(x)),
                                ifelse(x >= 0,xnormalize(x),0.5),
                                ifelse(x >= 0, color1, color2))
            ))
}

rov_rebased_gap %>%
  formattable(align='c',
              list(Gap = pm_color_bar2(),
                   entryId=FALSE))

Pos	Car	Code	Time (s)	Gap	Diff
1	8	TÄN	-5.7	-5.7	0.0
2	11	NEU	-4.7	-4.7	1.0
3	2	SOL	-1.1	-1.1	3.6
4	69	ROV	0.0	0.0	1.1
5	42	BRE	1.7	1.7	1.7
6	1	OGI	1.8	1.8	0.1
7	18	KAT	3.0	3.0	1.2
8	7	LOU	4.1	4.1	1.1
9	33	EVA	5.6	5.6	1.5
10	3	SUN	6.7	6.7	1.1