R Plotly - 根据大小分配标记的颜色

Question

I am using plotly to create an interactive pie chart for a shiny app. The underlying data is comparable to sales data. Each observation corresponds to a sale of a product. The pie chart then sums up the sales by product category.

I am looking for a way to assign color (gradient) by size of the respective pie piece, ie I would like the biggest share to have the darkest and the smallest share to have the lightest color. I know how to do this manually as shown in the example. However, since these shares will change over time, I am looking for a dynamic solution.

This is my solution to a fixed color assignment by product category:

library(plotly)
library(dplyr)

Product <- c("Product1","Product1","Product1","Product2","Product2","Product2","Product3")
Value <- c(100,100,50,400,50,50,350)

df <- data.frame(Product,Value)

colors_list <- list(
  'Product2' = '#003f5c',
  'Product3' = '#444e86',
  'Product1' = '#955196')

df$color <- dplyr::recode(df$Product, !!!colors_list)


plot_ly(df, labels = ~Product, values = ~Value, type = 'pie', textinfo = 'label+percent',
        marker = list(colors = ~color,
                      line = list(color = '#FFFFFF', width = 0.5))) %>%
  layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

Here is the link to the corresponding plot

Thank you very much in advance.

Edit: The solution presented by Kat works great with the working example that I provided. However, when I apply it to my "real data" the colors get mixed up as shown below. Unfortunately, I cannot share the data as it is sensitive. The data is imported from an excel sheet and perform some manipulations to extract numeric values from a string using gsub and as.numeric(str_trim(...)). This not a lot of information, but do you have an idea what could be the issue here?

Answer 1

I tried to make this as repeatable as possible. This does assume that you have only one trace and at least 1 trace (the pie plot). If so, you can you use this to identify all the colors in the gradient and assign the color map to the plot. I used the 'high' and 'low' colors you originally chose for your chart for the gradient in this function.

library(shades)
library(tidyverse)
library(plotly)

updater <- function(plt) {
  plt <- plotly_build(plt)
  if(length(plt$x$data) < 2) { # if there is only 1 trace
    df1 <- data.frame(labs = plt$x$data[[1]]$labels,
                      vals = plt$x$data[[1]]$values)
    vals <- df1 %>% group_by(labs) %>%  # find value
      summarise(perc = sum(df1$vals/sum(vals))) %>% 
      arrange(perc)            # assign colors to values/labels
    vals$colr <- gradient(c('#003f5c', '#955196'), steps = nrow(vals))
    # establish color order by data order in length of data
    df1 <- inner_join(df1, vals, by = "labs", keep = F) 
    # change the plot
    plt$x$data[[1]]$marker$colors <- df1$colr %>% unlist(use.names = F)
    plt # return the updated plot
  }
}

Here are some examples of how you might incorporate this.

plot_ly(iris, labels = ~Species, values = ~Sepal.Length, type = 'pie',
        textinfo = 'label+percent') %>% 
  updater()

plot_ly(diamonds, labels = ~cut, values = ~price, type = "pie",
        textinfo = 'label+percent') %>% 
  updater()

Now when it comes to your original plot, whether you designate color or not, this will work. (It will override whatever you designate for colors.)

plot_ly(df, labels = ~Product, values = ~Value, type = 'pie', 
        textinfo = 'label+percent',
        marker = list(colors = ~color,
                      line = list(color = '#FFFFFF', width = 0.5))) %>%
  updater() %>% 
  layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

You may not be aware, but all of the arguments you designated in layout are the defaults for a pie plot. Whether you include them or not, you're getting the same plot.

plot_ly(df, labels = ~Product, values = ~Value, type = 'pie', 
        textinfo = 'label+percent') %>% updater()

Last but not least, if you assign your plot to an object name like plt1 <- plot_ly(... , you can call this function, as well.

updater(plt1)         # an alternative
plt2 <- updater(plt1) # an alternative

------- Update --------

From your comments, @Brani brought up a great point. Perhaps you could swap your real labels for letters and share some of the values you're seeing? I'm not able to reproduce your issue, unfortunately. I'm going to guess it's either an issue with negative values, a grouping issue, or both.

Is your data clean? Is your label a factor?

In the function updater , I group by labels ( labs ). You could add print(df1) immediately following the creation of the vals data frame to find out what is getting sent to the creation of vals$colr .

Check out what happens with negatives.

set.seed(354)
dfn <- data.frame(letters = sample(
  rep(LETTERS[1:7], 10) %>% as.factor(), 50),
  vals = rnorm(50, 0, 10) %>% round(1))

plot_ly(dfn, labels = ~letters, values = ~vals, type = 'pie',
        textinfo = 'label+percent') %>% updater()

See how a slice is unlabeled? Where did E & C go? Let's take a closer look at this data.

dfn2 <- dfn %>% group_by(letters) %>% 
  summarise(vals = sum(vals))
# # A tibble: 7 × 2
#   letters  vals
#   <fct>   <dbl>
# 1 A        25  
# 2 B         6.6
# 3 C        -5  
# 4 D        47.2
# 5 E       -29.7
# 6 F         7.7
# 7 G        19.8 

The negatives are missing. That still doesn't account for why D didn't get a label.

At the beginning of this update, I said you could add print(vals) to updater . I added that call before running this last plot. This is what was printed in the console:

# A tibble: 7 × 2
  labs    perc
  <fct>  <dbl>
1 C     -14.3 
2 E      -2.41
3 D       1.52
4 A       2.86
5 G       3.62
6 F       9.30
7 B      10.8 

If I add the lowest possible value (so that the lowest value is 0), see what happens.

dfn2 <- dfn2 %>% 
  mutate(vals = vals + 29.7)

plot_ly(dfn2, labels = ~letters, values = ~vals, type = 'pie',
        textinfo = 'label+percent') %>% updater()

For this plot, this is what was printed in the console.

# A tibble: 7 × 2
  labs    perc
  <fct>  <dbl>
1 D       3.63
2 A       5.11
3 G       5.65
4 F       7.47
5 B       7.70
6 C      11.3 
7 E     NaN   

Since you're getting more than one slice with the same color, I'm curious about what you see if you add print .