Search code examples
rplotly

Changing the color of text in plotly based on background?

I have this plot in R (I wrote a function to select date labels to be spaced by 60 days to avoid clutter):

library(plotly)

n <- 100
mydf <- data.frame(
  col1 = rnorm(n),
  col2 = runif(n, min = 0, max = 10),
  col3 = runif(n, min = 0, max = 10)
)

start_date <- as.Date("2020-01-01")
end_date <- as.Date("2020-12-31")
mydf$point <- format(sample(seq(start_date, end_date, by="day"), n, replace = TRUE), "%Y-%m-%d")

mydf <- mydf[order(as.Date(mydf$point)), ]

filtered_dates <- mydf$point[1]
for (i in 2:nrow(mydf)) {
  if (as.Date(mydf$point[i]) >= as.Date(filtered_dates[length(filtered_dates)]) + 60) {
    filtered_dates <- c(filtered_dates, mydf$point[i])
  }
}
if (filtered_dates[length(filtered_dates)] != mydf$point[nrow(mydf)]) {
  filtered_dates <- c(filtered_dates, mydf$point[nrow(mydf)])
}

p <- plot_ly(data = mydf, x = ~col2, y = ~col3, z = ~col1, type = "contour")

x_min <- min(mydf$col2)
x_max <- max(mydf$col2)
y_min <- min(mydf$col3)
y_max <- max(mydf$col3)

for(i in 1:nrow(mydf)) {
  if (mydf$point[i] %in% filtered_dates) {
    x_pos <- max(min(mydf$col2[i], x_max), x_min)
    y_pos <- max(min(mydf$col3[i], y_max), y_min)
    
    label_x_pos <- jitter(x_pos, amount = 0.5)
    label_y_pos <- jitter(y_pos, amount = 0.5)
    
    p <- p %>% 
      add_annotations(x = label_x_pos, 
                      y = label_y_pos, 
                      text = paste0("• <b>", mydf$point[i], "</b>"), 
                      showarrow = FALSE,
                      font = list(size = 12, color = 'black'))
  }
}

p

enter image description here

I am trying to modify this plot so that the date labels around darker areas of the plot appear in white, and date labels around lighter areas of the plot appear in black (to improve visibility).

I tried looking for an automatic way to do this, but could not really find anything. I thought of the following idea:

  • For each label on the plot, identify the color of all pixels that surround this label (e.g. 5 pixels in each direction)
  • Take the average color of all those pixels: if the average is greater than some threshold "c" then black else white

But I am not sure how to access the underlying colors of the plotly plot. Can someone please show me how to do this?

Some ideas?

Thanks!

Solution

  • The problem with taking the average pixel value or a similar methodology is that your label might be over an area with the lightest colour and the darkest colour. For instance, consider the top right label in your example plot.

    To get around this issue, one possible option is to add a transparent background to your annotations using a combination of bgcolor, borderpad, and borderwidth.

    In the example below, I have used an alpha value of 0.25 to minimise obscuring the plot 'real estate' under the labels. You can experiment with different background colours and alpha values to get an aesthetically balanced result.

    library(plotly)

set.seed(42) # For reproducibility
n <- 100
mydf <- data.frame(
  col1 = rnorm(n),
  col2 = runif(n, min = 0, max = 10),
  col3 = runif(n, min = 0, max = 10)
)

start_date <- as.Date("2020-01-01")
end_date <- as.Date("2020-12-31")
mydf$point <- format(sample(seq(start_date, end_date, by="day"), n, replace = TRUE), "%Y-%m-%d")

mydf <- mydf[order(as.Date(mydf$point)), ]

filtered_dates <- mydf$point[1]
for (i in 2:nrow(mydf)) {
  if (as.Date(mydf$point[i]) >= as.Date(filtered_dates[length(filtered_dates)]) + 60) {
    filtered_dates <- c(filtered_dates, mydf$point[i])
  }
}
if (filtered_dates[length(filtered_dates)] != mydf$point[nrow(mydf)]) {
  filtered_dates <- c(filtered_dates, mydf$point[nrow(mydf)])
}

p <- plot_ly(data = mydf, x = ~col2, y = ~col3, z = ~col1, type = "contour")

x_min <- min(mydf$col2)
x_max <- max(mydf$col2)
y_min <- min(mydf$col3)
y_max <- max(mydf$col3)

for(i in 1:nrow(mydf)) {
  if (mydf$point[i] %in% filtered_dates) {
    x_pos <- max(min(mydf$col2[i], x_max), x_min)
    y_pos <- max(min(mydf$col3[i], y_max), y_min)
    
    label_x_pos <- jitter(x_pos, amount = 0.5)
    label_y_pos <- jitter(y_pos, amount = 0.5)
    
    p <- p %>% 
      add_annotations(x = label_x_pos, 
                      y = label_y_pos, 
                      text = paste0("• <b>", mydf$point[i], "</b>"), 
                      showarrow = FALSE,
                      font = list(size = 12, color = 'black'),
                      bgcolor = "rgba(255,255,255,0.25)",
                      borderpad = 0,
                      borderwidth = 0)
  }
}

p

    1