ggtext colors - How to include input from a function within text markdown for axis label

Hello,

I'm making a function/package for R that helps to visualise a measure of effect size known as the Probability of Superiority (PoS). For this particular function, you can provide a cohen's d value (e.g., .5), and the function will calculate the PoS and provide 2 plots that help visualise the statistic.

I would like to give the user the option to specify what colors will represent 'superiority' and 'inferiority'. This works very easily for the geoms in the plot, by specifying your own color to 'sup.fill' and 'inf.fill'. However, I would also like these colors to appear in the axis.title.y.right element, so that the axis title functions as a plot legend as well. Hence, the words 'superiority' and 'inferiority' should be colored according to the specified colors too. I am using ggtext to do this, and you can see if you run the function as it is that the colors appear correctly in the y axis title. However, I have simply specified the html color codes directly in the ggtext markdown. If I try to put 'sup.fill' or 'inf.fill' in there, of course it just tries to read them like a color, and this does not work.

Is there a way I can stitch together pieces of the markdown text so that including 'sup.fill' and 'inf.fill' inserts the specified html color codes, rather than trying to just read them as text?

The code below requires tidyverse, ggforce, and ggtext. You might also not have the font Gill Sans MT installed, but it should still plot with a default text option. When you run test[3] and test[4] you should get a plot for each. I've put comments above the crucial lines where I would like to have the code changed.

Any help would be much appreciated!

slot.plot <- function(d , sup.fill = "#7ecad2" , inf.fill = "#cc5551") {
  
  superiority <- pnorm( d  / sqrt(2))
  
  rounded.superiority <- round(pnorm( d / sqrt(2)) , 2) 

  sup.inf.tibble <- tibble(sup.inf = c( rep(1 , (rounded.superiority * 100) ) , rep(0 , 100 - (rounded.superiority * 100) ) ),
                           x = c(rep (seq(from = 1, to = 10, by = 1) , 10) ) ,
                           y = c(rep(10 , 10), rep(9 , 10) , rep(8 , 10), rep(7 , 10) , rep(6 , 10), rep(5 , 10) , rep(4 , 10), rep(3 , 10) , rep(2 , 10), rep(1 , 10) ) ,
                           random.sup.inf = c(sample(sup.inf, size = 100, replace = FALSE))
  )
  
  random.slotplot <- 
    ggplot(data = sup.inf.tibble) +
    scale_y_continuous(limits = c(0.5, 10.5), breaks = seq(from = 10, to = 1, by = -1), labels = c("1-10" , "11-20" , "21-30" , "31-40" , "41-50" , "51-60" , "61-70" , "71-80" , "81-90" , "91-100"),  position = "right", expand = c(0 , 0) ) +
    geom_circle(aes(x0 = x, y0 = y, r = .33, fill = as.factor(random.sup.inf) ), linetype = "blank") +
    scale_fill_manual(values = c( inf.fill , sup.fill )) +
# here is where the ggtext markdown for the colored axis is specified
# I want the colors to be able to call sup.fill and inf.fill, rather than having to be directly specified as html codes
    labs(y = "Random Draws<br></span><span style = 'color:#7ecad2;'>Superior</span> *vs.* <span style = 'color:#cc5551;'>Inferior</span>") +
    theme(
      panel.background = element_blank(),
      axis.title = element_text(family = "Gill Sans MT", color = "black"),
      axis.line.y.right = element_line(color = "black"),
      axis.ticks.y = element_line(color = "black"),
      axis.text.y = element_text(family = "Gill Sans MT", color = "black"),
      axis.title.y.right = element_markdown(lineheight = 1.2),
      axis.title.x = element_blank(),
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      legend.position = "none",
      aspect.ratio = 1
    )
  
  ordered.slotplot <-
    ggplot(data = sup.inf.tibble) +
    scale_y_continuous(limits = c(0.5, 10.5), breaks = seq(from = 10.5, to = 0.5, by = -1), labels = c("0%" , "10%" , "20%" , "30%" , "40%" , "50%" , "60%" , "70%" , "80%" , "90%" , "100%" ),  position = "right", expand = c(0 , 0) ) +
    geom_circle(aes(x0 = x, y0 = y, r = .33, fill = as.factor(sup.inf) ), linetype = "blank") +
    scale_fill_manual(values = c( inf.fill , sup.fill )) +
# the same solution can be applied to the second graph as well
    labs(y = "Probability of Superiority<br>
         </span><span style = 'color:#7ecad2;'>Superior</span> *vs.* <span style = 'color:#cc5551;'>Inferior</span>") +
    theme(
      axis.title = element_text(family = "Gill Sans MT", color = "black"),
      panel.background = element_blank(),
      axis.line.y.right = element_line(color = "black"),
      axis.ticks.y = element_line(color = "black"),
      axis.text.y = element_text(family = "Gill Sans MT" , color = "black"),
      axis.title.y.right = element_markdown(lineheight = 1.2),
      axis.title.x = element_blank(),
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      legend.position = "none",
      aspect.ratio = 1
    )
  
  slotplot.list <- list(superiority , sup.inf.tibble , random.slotplot , ordered.slotplot)
  
  return(slotplot.list)
}

test <- slot.plot(d = .5)

test[3]
test[4]

20 minutes of more rigorous searching would have solved this for me. The solution is to use the package 'glue'. The line:

labs(y = "Random Draws<br></span><span style = 'color:#7ecad2;'>Superior</span> *vs.* <span style = 'color:#cc5551;'>Inferior</span>") 

can be changed to the following, which seems to work perfectly:

    labs(y = glue("Random Draws<br></span><span style = 'color:{sup.fill};';'>Superior</span> *vs.* <span style = 'color:{inf.fill};';'>Inferior</span>")) +
1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.