# 3 Visualising Results for a Single Stage

In this chapter, we’ll introduce some basic chart and chartable techniques for displaying stage timing and results 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.

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) %>%
# 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

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 (stagesitinerarySectionId) - 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",
"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, ...) {
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')),
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',
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, ...) {
#        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