gt::data_color doesn't seem scaled correctly

[GabeTheEngineer]

I am having some issues where it doesn't appear gt::data_color is scaling with the scale correctly. The maximum and minimum shades/domain/max and min data seem to align, but the cells in between seem to be biased toward the lower end of the scale. 70% in the filled cells seems about 50% in the gradient. I'm really at a loss as to what's causing the issue so any help is appreciated.

    # color numbers
    gt_tbl <- gt_tbl %>%
        gt::data_color(
            columns = c(freq, upper, lower),
            colors = scales::col_numeric(
                palette = paletteer::paletteer_c("viridis::inferno", n=201) %>% as.character(),
                domain=c(0,1)
            )
        ) 

[GabeTheEngineer]

If I replace lower->freq->upper with evenly spaced values, I get this which seems as if the top quarter of the domain is mapped to the top half of the color scale and the bottom 10% of the domain is basically the bottom black of the color scale.

[tom_rstudio]

Howdy!

I have a reprex below, and I think that the colors in ggplot2 and gt both track very closely.

library(gt)
library(dplyr)
library(tidyr)
library(ggplot2)

fake_data <- tibble(
  text = letters[1:10],
  n = 293,
  low = seq(0, 0.33, length.out = 10),
  mid = seq(0.34, 0.66, length.out = 10), 
  high = seq(0.67, 1, length.out = 10)
) 

gt_out <- fake_data %>% 
  gt() %>% 
  fmt_percent(columns = low:high, decimals = 1) %>% 
  data_color(
    columns = low:high,
    colors = scales::col_numeric(
      palette = paletteer::paletteer_c("viridis::inferno", n = 201) %>% as.character(),
      domain = c(0,1)
    )
  ) 


plot_out <- fake_data %>% 
  pivot_longer(
    cols = low:high
  ) %>% 
  mutate(
    name = factor(name, levels = c("low","mid", "high")),
    color = scales::col_numeric(
      palette = paletteer::paletteer_c("viridis::inferno", n = 201) %>% as.character(),
      domain = c(0,1)
    )(value),
    y = rep(1:10, each = 3),
    text_col = if_else(value > 0.6, "black", "white")
    ) %>% 
  ggplot(aes(x = name,y = y)) +
  scale_y_reverse() +
  geom_tile(aes(fill = I(color))) +
  geom_text(aes(label = round(value, 2), color = I(text_col)), size = 6)

plot_out
gt_out

^{Created on 2021-06-21 by the reprex package (v2.0.0)}

[tom_rstudio]

The plot you shared does have a very broad range for yellow and a very small range for the black/dark purple.

I attempted a recreation below and it looks to align pretty tightly with the gt/ggplot2 versions - it's possible that the plot that was embedded had something going on?

library(tidyverse)
(
  tibble(
    n = 1:100
  ) %>%
    ggplot(aes(x = n, y = "", fill = n)) +
    geom_tile() +
    viridis::scale_fill_viridis(option = "B") +
    theme(legend.position = "top", axis.text.y = element_blank()) +
    scale_x_continuous(breaks = seq(0, 100, by = 4))
) %>%
  ggsave("wide_plot.png", ., height = 1.5, width = 8, dpi = "retina")

[tom_rstudio]

Thank you. There is another thing. In the long/wide legend, the text is size 80. If height is in pixels width should be 50 * 9 = 450 or 6.25 in @ 72dpi (worse case). Is something else making the plot big?

The gt::ggplot_image() function uses the code below internally, which ends up with a 3000 x 500 plot at 100 DPI with an aspect ratio of 6 (30 wide by 5 high).

ggplot2::ggsave(
  filename = "temp_ggplot.png",
  plot = plot_object,
  device = "png",
  dpi = 100,
  width = 5 * aspect_ratio,
  height = 5
)

We can show an example of the embedded "legend" in the footnotes like so:

library(gt)
library(dplyr)
library(tidyr)
library(ggplot2)

fake_data <- tibble(
  text = letters[1:10],
  n = 293,
  low = seq(0, 0.33, length.out = 10),
  mid = seq(0.34, 0.66, length.out = 10), #%>% rev(),
  high = seq(0.67, 1, length.out = 10)
) 

wide_legend <- tibble(
  n = 1:100
) %>%
  ggplot(aes(x = n, y = "", fill = n)) +
  geom_tile() +
  viridis::scale_fill_viridis(option = "B") +
  theme_void() +
  theme(legend.position = "none", axis.text.y = element_blank(),
        axis.text.x = element_text(size = 90)) +
  scale_x_continuous(breaks = seq(0, 100, by = 10))

gt_out <- fake_data %>% 
  gt() %>% 
  fmt_percent(columns = low:high, decimals = 1) %>% 
  data_color(
    columns = low:high,
    colors = scales::col_numeric(
      palette = paletteer::paletteer_c("viridis::inferno", n = 201) %>% as.character(),
      domain = c(0,1)
    )
  ) %>% 
  tab_footnote(
    footnote = gt::html(gt::ggplot_image(wide_legend, aspect_ratio = 7, height = px(35))),
    locations = cells_column_labels(low:high)
  )

gt_out

To see just the ggplot using the output defaults from the gt package:

ggsave("test-img.png", wide_legend, dpi = 100, height = 5, width = 30)

[GabeTheEngineer]

Thank you. So the 'height' (pixels) from ggplot_image() is applied in HTML but not in the ggsave() command.