Post-rsses on Duc Quang Nguyen

Smooth animated temperature shift in R

Sun, 16 Dec 2018 00:00:00 +0000

Here is a rundown of the R code I used to create the following animated graphic. This graphic is part of a long form story (paywall, in French) on global warming focused on Switzerland. It shows the shift in monthly temperatures in Geneva for 1864-1900 vs 1982-2018.

It relies on ggplot2 for the chart and on gganimate to, well, you know, animate it. It was my first use of gganimate, a pretty new amazing R package. Its documentation and examples are sometimes lacking, but are growing strong! For this animated graphic, I use only the most basic functionality of that package to tween, i.e. smoothly interpolate, between two states.

First, let’s download and wrangle the data. The data is regularly updated/added comes from MeteoSuisse as a text file.

suppressPackageStartupMessages(library(tidyverse))
library(gganimate)
library(ggalt) # to plot splines

data_url <- "https://www.meteosuisse.admin.ch/product/output/climate-data/homogenous-monthly-data-processing/data/homog_mo_GVE.txt"

# skip all the metadata to read only the data table 
table <- read.table(data_url, skip = 27, header = T) %>% 
  select(-Precipitation)

months <- structure(1:12, 
                    names = c('Jan', 'Feb', 'Mar',  'Apr',  'May',  'Jun',  
                              'Jul',    'Aug',  'Sep',  'Oct',  'Nov',  'Dec'))
# express month as factor
table <- table %>% mutate(
  month = factor(names(months)[match(Month, months)], 
                 levels = names(months)))

ylim <- table %>% .$Temperature %>% range()

The animated graphic has only 2 states, but it compensates with quite a few geoms/layers. For each state/time period, there are: the monthly temperatures (as splines), the monthly average (dashed line), the columns showing the shift and even a curved arrow to annotate the monthly average. And three text labels are animated, the time period, the monthly average and the shift of monthly temperatures in °C.

I create a data frame/tibble for each layer:

  # Define the two time periods 1864-1900 & 1982-2018s
  periods <- tibble(
    start = c(1864, 1982),
    end = c(1900, 2018),
    color = c("#2a3589", "#c6266d")
  ) %>% 
    mutate(name = paste0(start, "-", end))
  
  # filter data within two periods, will be plotted as splines
  df <- table %>% 
    filter((Year >= periods$start[1] & Year <= periods$end[1]) | Year >= periods$start[2]) %>% 
    mutate(
      timeP = factor(ifelse(Year <= periods$end[1], periods$name[1], periods$name[2])),
      colour = ifelse(timeP == periods$name[1], periods$color[1], periods$color[2])
  )
  
  # create a tibble w/ the average monthly temperature for each time period
  mAverageByP <- df %>% 
    group_by(timeP, month) %>% 
    summarise(average_temp = mean(Temperature)) %>% 
    ungroup() %>% 
    mutate(colour = ifelse(timeP == periods$name[1], periods$color[1], 
                           periods$color[2]))
  
  # create a tibble of the monthly temperature shift
  shift <- mAverageByP %>% 
    group_by(month) %>% 
    summarise(y0 = average_temp[1], y1 = average_temp[2]) %>% 
    ungroup() %>% 
    mutate(timeP = factor(periods$name[2], levels = periods$name))
  
  # bind the first period, there is no shift, i.e y1 = y0
  shift <- rbind(shift %>% 
                  mutate(y1 = y0, 
                         timeP = periods$name[1]), shift) %>% 
    mutate(timeP = as.factor(timeP))
  
  # the text label for the monthly temperature shift, if 0 replace by ""
  shiftLabel <- shift %>% 
    mutate(
      diff = y1 - y0,
      label = ifelse(
        diff == 0, "", paste0("+", formatC(diff, digits = 2), "°"))
    )
  # text label for the time period
  timePLabel <- tibble(
    x = 7.15, y = 8.4, label = levels(df$timeP), 
    timeP = factor(levels(df$timeP))) %>% 
    mutate(colour = ifelse(timeP == periods$name[1], 
                           periods$color[1], periods$color[2]))
  
  # text label for the monthly average temperature by time period
  moyenneMLabel <- cbind(
    tibble(
      x = 7.15, y = 4.4, 
      label = paste0(levels(df$timeP), " average")),
    mAverageByP %>% filter(month == "Mar")
  )

my_theme <- function(base_size = 22) {
  ggplot() +
    geom_hline(yintercept = 0, colour = "darkgrey", alpha = 0.6, size = 0.7) + 
  scale_x_discrete(name = "", position = "top", expand = c(0.02, 0.1)) +
  scale_y_continuous(
    name = "", expand = c(0.03, 0), limits = ylim, 
    labels = function(x) paste0(x,'°'),
    breaks = scales::pretty_breaks(n = 5)
  ) +
  theme_minimal(base_size = base_size ) +
  theme(
    plot.title = element_text(hjust = 0, face = "bold"),
    plot.subtitle = element_text(hjust = 0),
    plot.caption = element_text(colour = "#666666", 
                                margin = margin(0, 22, 24, 0, "pt")),
    axis.ticks.length = unit(0.7, "lines"),
    axis.ticks.y = element_blank(),
    panel.grid.major.x = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.y =  element_line(
      color = "#c2c4d6", linetype = "dotted", size = 0.35),
    plot.margin = margin(5, 5, 3, -4, "pt"),
    axis.line = element_blank()
  )
}

Plot the different ggplot2 layers in an object called p here. Printing p will gengerate an error, but you can test it before animating it with a facet_wrap. Yes, the font size might seem gigantic at this point.

fontSize <- 34

p <- my_theme(base_size = fontSize) + 
  scale_colour_identity() +
  geom_segment(
    data = shift,
    aes(x = month, xend = month, y = y0, yend = y1), 
    size = fontSize / 2.5, colour = "#b30047", alpha = 0.6
  ) +
  geom_xspline(
    data = df,
    aes(x = month, y = Temperature, group = Year, colour = colour), 
    size = 0.15, alpha  = 0.9
  ) +
  geom_line(
    data = mAverageByP,
    aes(x = month, y = average_temp, group = 1, colour = colour),
    size = fontSize / 10, linetype = "dashed"
  ) +
  geom_text(
    data = shiftLabel, hjust = 0.5, vjust = 0, nudge_y = 0.45,
    aes(x = month, y = y1, label = label), 
    size = fontSize / 3, colour = '#16040c'
  ) +
  geom_text(
    data = timePLabel, 
    aes(x = x, y = y, label = label, colour = colour),
    hjust = 0.5, size = fontSize * 0.8, fontface = "bold",
    alpha = 0.8
  ) +
  geom_text(
    data = moyenneMLabel, aes(x = x, y = y, label = label),
    hjust = 0.5, size = fontSize / 3,
    vjust = -1.1, colour = "#666666"
  ) +
  geom_curve(
    data = moyenneMLabel, size = fontSize / 20, 
    colour = "#666666", alpha = 0.7,
    aes(x = x, y = y, xend = month, yend = average_temp), 
    curvature = -0.8,  arrow = arrow(length = unit(0.01, "npc"))
  ) +
  scale_x_discrete(name = "", position = "top", expand = c(0.04, 0.1)) + 
  labs(title = "Geneva already warmed up by 2°C since 1864",
       subtitle = "Monthly temperatures in Geneva 1864-1900 vs 1982-2018",
       caption = "Source: MétéoSuisse | @duc_qn ")

## Scale for 'x' is already present. Adding another scale for 'x', which
## will replace the existing scale.

# p + facet_wrap(~timeP)

Animate using gganimate::transition_states as stated from the help > This transition splits your data into multiple states based on the levels in a given column, much like ggplot2::facet_wrap() splits up the data in multiple panels. It then tweens between the defined states and pauses at each state.

ap <- p + 
  transition_states(
    timeP, transition_length = 10, state_length = 10, wrap = T
  ) +
  enter_fade() +
  exit_fade()

animate(ap, height = 1200, width = 1000)

For the animated graphic I used in the long form story, I saved the animation as a mp4 movie rather than a gif to get a much smaller file size. Movie can be looped then using HTML.

  vid_ap <- animate(ap, height = 1500, width = 1200, fps = 100, 
                 renderer = ffmpeg_renderer(
                   options = list(pix_fmt = "yuv420p", loop = 0)))

I hope this helps. As mentioned earlier, you can so much more with gganimate. Check its wiki for more examples.

Fails et succès en mi-saison 2017/18 de Super League: comparaison historique

Thu, 01 Feb 2018 00:00:00 +0000

_{This post is part of a dataviz remix series of the Swiss football league’s results. The motivations behind it are explained in this post.}

La Super League reprend ses droits ce samedi après la trêve hivernale. L’occasion de faire le point sur les (contre-)performances à la mi-saison.

De leur histoire en Super League, la meilleure saison de Young Boys

Mon, 27 Nov 2017 00:00:00 +0000

_{This post is part of a dataviz remix series of the Swiss football league’s results. The motivations behind it are explained in this post.}

Bouleversement dans la Super League, du suspense ?

Un mini séisme se profile-t-il cette année en Super League ? Au terme du 19^ème tour, les Bernois devancent le FC Bâle de 2 points.

Super insipide

S’il y a bien quelque chose de super dans la Super League de football suisse, c’est sa prévisibilité.

Pour cause, l’insolente domination du FC Bâle, tenante du titre depuis huit années. Depuis la création de la Super League en 2003, le club Rhénan a remporté le championnat à treize reprises.

Face à cette monotonie, les dirigeants de la Swiss Football League ont envisagé cette année divers scénarios pour pimenter le Championnat.

Les examens de la compétition ont accouché d’une souris. Le statu quo est maintenu, seule l’introduction d’un barrage pourrait avoir lieu.

SwissSuperLeague series delayed

Mon, 20 Nov 2017 00:00:00 +0000

This post is part of a dataviz remix series of the Swiss football league’s results. The motivations behind it are explained in this post.

Write a #rstats scraper, bother to make a package for it and see that the data have been migrated to a new website/data structure @SFV_ASF pic.twitter.com/pEVHqLefyN
— 𝙳𝚞𝚌-𝚀𝚞𝚊𝚗𝚐 𝙽𝚐𝚞𝚢𝚎𝚗 (@duc_qn) November 20, 2017

Pour des raisons indépendantes de ma volonté, la série de visualisation de la #SwissSuperLeague est contrainte à un hiatus de quelques semaines.

Les données des matchs précédemment disponibles par l’Association Suisse de Football ont été migrées sur le site officiel de la Swiss Football League. Un travail pour accommoder mon code à ce changement des données est donc nécessaire.

Mais du côté positif, la Swiss Football League dispose de bien plus de données détaillées, une aubaine pour le journalisme et la visualisation de données! Ce changement ouvre la porte à une kyrielle de nouvelles possibilités.

SwissSuperLeague dataviz remix 1 - Points evolution

Mon, 13 Nov 2017 00:00:00 +0000

This post is part of a dataviz remix series of the Swiss football league’s results. The motivations behind it are explained in this post.

Première mouture

Mon but ici, visualiser l’évolution des résultats des équipes. En comparaison avec le graphique officiel de la Swiss Football League ci-desssous, je suis plutôt satisfait.

J’apprécie de pouvoir constaster les passages à vide ou la constance de certaines équipes. Par exemple, le début de saison calamiteux du Lausanne Sport, suivi d’une jolie remontée.

Dataviz details

It is a small multiple chart of the cumulative points by round.

The stats in each facet is the: cumulative points | goals scored : goals conceded
The colour used for each team is encoded by the goal differential at the last round
All teams are showed with some transparency. To plot the background data in all facets, I used this trick.

R code

## Data wrangle
f_pts <- ts %>% 
  filter(nmatch == max(nmatch)) %>%
  select(team, cum_pts, cum_balance) %>%
  rename(f_pts = cum_pts, f_balance = cum_balance)

tsf <- left_join(ts, f_pts)

# trick to display background data in all facets # https://drsimonj.svbtle.com/plotting-background-data-for-groups-with-ggplot2
ts.bg <- tsf %>% 
  mutate(team.ori = team) %>% 
  select(nmatch, cum_pts, team.ori, f_pts, f_balance)
ts.last <- tsf %>% 
  filter(nmatch == max(nmatch)) %>%
  mutate(
    xlab1 = 1.2, 
    ylab1 = max(cum_pts) -0.1, 
    xlab2 = nmatch -0.1,
    ylab2 = 1,
    stats = paste0(cum_pts, " pts | ", cum_scored, " : ", cum_against),
    ystart = 0
  )

nround <- max(tsf$nmatch)
aratio <- (nround / max(tsf$cum_pts)) / 1.25
  
## PLOT
gp <- ggplot(data = tsf) + 
  geom_step(data = ts.bg, 
            aes(x = nmatch, y = cum_pts, group = team.ori, colour = f_balance), 
            size = 0.25, alpha = 0.4) +
  geom_step(aes(x = nmatch, y = cum_pts, group = team, colour = f_balance), 
            size = 0.75, direction = "hv") +
   dqn_theme() + 
  facet_wrap(~team, ncol = 2, strip.position = "top") +
  theme(
    legend.position = "bottom",
    #plot.background = element_rect(fill = '#EFF2F4'),
    axis.ticks = element_line(size = 0.2),
    plot.margin = unit(c(0.4, 0.4, 0.1, -0.4), "cm"),
    strip.text = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank()
  ) + 
  scale_x_continuous(
    name = "", minor_breaks = NULL,
    breaks = scales::pretty_breaks(n = 5), expand = c(0,0),
    limits = c(1, nround + 0.4)) +
  scale_y_continuous(
    name = "", 
    breaks = scales::pretty_breaks(n = 3), expand = c(0,1)) +
  scale_color_viridis(option = "C", direction = -1, name = "Différence de buts") +
  labs(caption = "source: www.sfl.ch | dqn.website | CC-BY-NC-SA ", 
       title = "Swiss Super League - saison 2017/2018", 
       subtitle = paste0(
         "Points cumulés par tour. Mise à jour: tour " , 
         nround, " (", Sys.Date(), ")")
       ) +
  annotate("segment", x=-Inf, xend=Inf, y=-Inf, yend=-Inf, color = "#C2BABA") +
  annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf, color = "#C2BABA") +
  theme(aspect.ratio = aratio)

# add faceted text
gp2 <- gp + 
  geom_text(
    data = ts.last, aes(x = xlab1, y = ylab1, label = team), 
    hjust = 0, vjust = 1,
    size = 5.4,
    alpha = 0.75,
    family =  "Raleway") +
  geom_text(
      data = ts.last, aes(x = xlab2, y = ylab2, label = stats), 
      hjust = 1, vjust = 0,
      colour = "black",
      alpha = 0.9,
      size = 4.7,
      family =  "Raleway Light")
# add lollipop for the last game
  gp2 + 
    geom_point(data = ts.last, size = 2,
                   aes(x = nmatch, y = cum_pts, colour = f_balance)) +
    geom_segment(data = ts.last, 
                 aes(x = nmatch, xend = nmatch, y = ystart, yend = cum_pts, 
                     colour = f_balance),
                 alpha = 0.7, size = 0.25)

Trials

ggplot(data = ts) + 
  geom_step(aes(x = nmatch, y = cum_pts, group = team, colour = team), size = 1, alpha = 0.7) + dqn_theme()

Figure 1: Step chart withtout faceting and background data

ggplot(data = ts) + 
  geom_line(aes(x = nmatch, y = rank, group = team, colour = team), size = 1, alpha = 0.8) +
  dqn_theme()

Figure 2: Plotting rank over time should make sense right?

ggplot(data = ts) + 
  geom_step(aes(x = nmatch, y = cum_pts, group = team, colour = rank), 
            size = 1, alpha = 0.7) +
  dqn_theme() + facet_wrap(~team, ncol = 2) +
  scale_x_continuous(
    name = "Tours", minor_breaks = NULL, 
    breaks = scales::pretty_breaks(n = 1), expand = c(0,0)) +
  scale_color_viridis()

Figure 3: Colour is encoded by the (continous) rank, unsure whether this is a useful feature

Time for sports to get a dataviz makeover

Sat, 11 Nov 2017 00:00:00 +0000

I have to confess, I am not into sports. Nor do I know much about football. But as media and data professional, I am irked by how sport is summarised and visually conveyed.

I am referring here to the ubiquitous league table. Present everywhere, whether being in print or online. All team sports’ results are recapped in such table.

_{^{RTS Sports’s football table for the Swiss Super League}}

What’s wrong with league table?

I am aware I am having a rather a diehard stance here. Of course league tables are useful to show where team currently stand and to cram stats such as points, wins, loss, goals,…

My issue with it is for people like me who do not regularly follow sports. One cannot get from such table how teams performed over time, like has a team been any good/bad lately?

IMHO, league table is a legacy of old day media/journalism where data/news were scarce. And like with the current general media crisis, there is an unmet demand to synthesise sports information. Furthermore, sports generate more and more data. There are hence plenty of ways to summarise its information to be both insightful and visually attractive.

But most importantly, league table fails to achieve its purpose. According to Wikipedia’s definition:

A league table is a chart or list which compares sports teams ….. by ranking them in order of ability or achievement

League table does the job listing achievements, but does not fulfil its primary purpose to rank teams by ability. Summing up different metrics (such as goals, wins, losses) as it is done routinely, is both primitive and fallacious.

I am not a statistician nor a mathematician, but there have been for decades much more insightful metrics in sports (and in football in particular) that are informative to anybody. For instance, metrics such as the expected number of goals scored or conceded per game by a team would be understandable and useful to anybody (much more so than summing up the number of goals).

Content produced by media needs of course to be understandable and to appeal to the largest audience possible, but it should also be able to give to convey the most relevant information at hand. So my aim here is to post more insightful football metrics instead of a race to the bottom.

There are of course plenty of people and media that came to that same conclusion before. 538 and the Financial Times, to mention only two, have done outstanding work visualising, modelling and conveying football analysis. As often, English-speaking media are the forefront.

_{^{The official Swiss Football League’s actually provides an evolution chart. The expression “spaghetti chart”" brought to a new level…}}

It is easy to only criticze, so as a challenge I will regulary post quick data visualisation “remix” of the Raiffeisen Swiss Super League results.. I hope this will be interesting and not appeal only to stathead or dataviz amateurs. In a second step, I hope to look into alternative (and better) metrics to rank and classify teams’ ability.

If you are interested, check the posts tagged as #remix, #football, #swisssuperleague

Interactive mekko charts in R

Thu, 19 Oct 2017 00:00:00 +0000

Mekko what?

Despite its confusing name, Mekko or Marimekko chart is a simple yet effective data visualisation form.

Here is a rundown in R for the interactive Mekko chart under (which is part of this story). I used ggiraph, a great ggplot2 extension that binds d3.js to ggplot2. This allows to easily turn a ggplot2 object into an interactive graphic.

The bar height here is proportional to the number of jobs and shows the large difference of jobs for different occupations.

It can be thought of a regular stacked bar chart with an additional axis. The only alternative to a Mekko chart would be to “facet” as shown under.

_{^{Data and graphic: NCCR}}

FT Chart Doctor provides an excellent explanation of the Mekko chart’s pros & cons. And most importantly, it explains the origins of its enigmatic name (spoiler - a Finnish textile and fashion company’s renowned for its bright repeating patterns).

Mekko chart can boast one on the largest number of synonyms: Mekko, Marimekko, mosaic, matrix or proportional stacked bar chart. I’ll stick here with FT’s designation, proportional stacked bar chart. IMHO, the most meaningful name.

Proportional stacked bar chart chart in R

There are various ways to create such chart in R. There is of course a dedicated R package for it, ggmosaic built on top of ggplot2. And various gists or posts about it.

I use ggiraph a great ggplot2 extension that binds d3.js to ggplot2. This allows to easily render a ggplot2 object as an interactive graphic.

Wrangle the data

Here is the data to plot in a tidy form. They are the job figures in Switzerland, by occupation group (group, an ordered factor) and by country of origin (origin, Swiss or foreigner)

library(magrittr) library(tidyverse) library(ggiraph) jobs <- c("Managers", "Professionals", "Technicians and associate professionals", "Clerical support workers", "Service and sales workers", "Skilled agricultural workers", "Craft and related trades workers", "Machine operators and assemblers", "Elementary occupations") data <- tibble( group = factor(rep(jobs, each = 2), levels = jobs), origin = rep(c( "foreigner", "swiss"), 9), value = c( 128640.53, 297823.49, 219209.61, 615405.86, 168977.09, 606273.69, 77485.11, 298635.30, 210439.96, 412074.04, 8740.28, 83336.17, 151257.24, 323894.43, 68990.99, 93424.47, 126136.14, 86100.60 ) ) data

Compute for each occupation, the proportion of Swiss/foreigner and the total number of jobs.

data %<>% group_by(group) %>% mutate( share = value / sum(value), tot_group = sum(value) ) %>% ungroup()

A proportional stacked bar is composed of rectangles. Rectangles’ coordinates are computed in two steps.

The number of jobs by occupation (y dimension) and the proportion of Swiss/foreigner (x) by occupation. It relies on cumsum() to express all values in a 0 to 1 coordinates.

data %<>% group_by(origin) %>% arrange(desc(group)) %>% mutate( ymax = cumsum(tot_group) / sum(tot_group), ymin = (ymax - (tot_group/sum(tot_group))) ) %>% ungroup() %>% group_by(group) %>% arrange(desc(origin)) %>% mutate(xmax = cumsum(share), xmin = xmax - share) %>% ungroup() %>% arrange(group) data %>% select(group, origin, ymin, ymax, xmin, xmax) %>% arrange(desc(group))

## # A tibble: 18 x 6 ## group origin ymin ymax ## <fctr> <chr> <dbl> <dbl> ## 1 Elementary occupations swiss 0.00000000 0.05336812 ## 2 Elementary occupations foreigner 0.00000000 0.05336812 ## 3 Machine operators and assemblers swiss 0.05336812 0.09420840 ## 4 Machine operators and assemblers foreigner 0.05336812 0.09420840 ## 5 Craft and related trades workers swiss 0.09420840 0.21368795 ## 6 Craft and related trades workers foreigner 0.09420840 0.21368795 ## 7 Skilled agricultural workers swiss 0.21368795 0.23684109 ## 8 Skilled agricultural workers foreigner 0.21368795 0.23684109 ## 9 Service and sales workers swiss 0.23684109 0.39337573 ## 10 Service and sales workers foreigner 0.23684109 0.39337573 ## 11 Clerical support workers swiss 0.39337573 0.48795332 ## 12 Clerical support workers foreigner 0.39337573 0.48795332 ## 13 Technicians and associate professionals swiss 0.48795332 0.68289448 ## 14 Technicians and associate professionals foreigner 0.48795332 0.68289448 ## 15 Professionals swiss 0.68289448 0.89276323 ## 16 Professionals foreigner 0.68289448 0.89276323 ## 17 Managers swiss 0.89276323 1.00000000 ## 18 Managers foreigner 0.89276323 1.00000000 ## # ... with 2 more variables: xmin <dbl>, xmax <dbl>

This is enough to plot a basic proportional stacked bar chart chart

gp <- ggplot(data) + geom_rect(aes(ymin = ymin, ymax = ymax, xmin = xmin, xmax = xmax, fill = origin), colour = "white", size = 0.2) gp

Make it interactive

For an interactive version, two additional optional aesthetic can be provided to ggiraph:

data_id an aesthetic to identify elements on hovering

tooltip the HTML tooltip text

data %<>% mutate( data_id = paste0(origin, group), tooltip = paste0( "<em>", as.character(group), "</em><br>", origin, " ", round(share * 100, 1), "%<br>", "(", prettyNum(round(value), big.mark = " ", mode = "character"), " jobs)" ) ) # hack to escape single quote data %<>% mutate(tooltip = gsub("'", "`", tooltip))

Same ggplot2 call as previously, replacing geom_rect() with ggiraph::geom_rect_interactive(), and add the two freshly created aesthetics.

ggiraph() renders a ggplot2 object as an interactive chart in RStudio’s Viewer or for the web browser.

gp <- ggplot(data) + geom_rect_interactive( aes(ymin = ymin, ymax = ymax, xmin = xmin, xmax = xmax, fill = origin, data_id = data_id, tooltip = tooltip), colour = "white", size = 0.2) ggiraph({print(gp)})

Et voilà, a plain looking but functional interactive proportional stacked bar chart

Prettify

Direct labelling

I labelled the jobs directly in the chart’s bars. In this case, because some bars are narrow I scaled the labels according the bars’ height. I added also the % values.

# job labels tibble labels <- data %>% filter(origin == "swiss") %>% mutate(y = ymax - 0.01, yRange = (ymax - ymin)* 100) %>% select(group, xmin, y, yRange) %>% ungroup() value_labels <- data %>% select(group, origin, xmin, xmax, ymax, share) %>% mutate( x = ifelse(origin == "swiss", xmax, xmin), y = ymax - 0.005, label = paste0(round(share * 100), "%"), hjust = ifelse(origin == "swiss", 1.05, -0.25) ) gp2 <- gp + geom_text( data = labels, aes(x = xmin + 0.008, y = y, label = as.character(group), size = yRange), hjust = 0, vjust = 1, colour = "white" ) + geom_text( data = value_labels, aes(x = x, y = y, label = label, hjust = hjust), vjust = 1, size = 2.7, alpha = 0.7, colour = "white" ) + scale_size_continuous(range = c(2.2, 4.5), guide = F) ggiraph({print(gp2)})

Theming

gp3 <- gp2 + theme_minimal() + scale_x_continuous( position = "top", expand = c(0.01, 0.01), labels = scales::percent, breaks = scales::pretty_breaks(n = 4)) + scale_y_continuous( expand = c(0,0), limits = c(0, 1.02) ) + scale_fill_manual( values = c('#4c6570', '#b15953') ) + theme( axis.line.x = element_blank(), axis.text.y = element_blank(), axis.title = element_blank(), legend.position = "none" ) ggiraph({print(gp3)}, width = 0.9)