Putting `plotly` table below a `plotly` scatter plot

[JauntyJJS]

Hi,

I wanted to create a plotly table below a plotly scatter plot.
Something like this example from https://www.exceldashboardtemplates.com/how-to-add-a-line-to-an-excel-chart-data-table-and-not-to-the-excel-graph/ but a scatter plot instead.

Below is the code that I have tried.

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    type = "scatter",
                    mode = 'markers')

fig <- plotly::subplot(fig2, fig1, nrows = 2)

fig
#> Warning: Can't display both discrete & non-discrete data on same axis
#> Warning: 'layout' objects don't have these attributes: 'NA'
#> Valid attributes include:
#> 'font', 'title', 'uniformtext', 'autosize', 'width', 'height', 'margin', 'computed', 'paper_bgcolor', 'plot_bgcolor', 'separators', 'hidesources', 'showlegend', 'colorway', 'datarevision', 'uirevision', 'editrevision', 'selectionrevision', 'template', 'modebar', 'newshape', 'activeshape', 'meta', 'transition', '_deprecated', 'clickmode', 'dragmode', 'hovermode', 'hoverdistance', 'spikedistance', 'hoverlabel', 'selectdirection', 'grid', 'calendar', 'xaxis', 'yaxis', 'ternary', 'scene', 'geo', 'mapbox', 'polar', 'radialaxis', 'angularaxis', 'direction', 'orientation', 'editType', 'legend', 'annotations', 'shapes', 'images', 'updatemenus', 'sliders', 'colorscale', 'coloraxis', 'metasrc', 'barmode', 'bargap', 'mapType'

Unfortunately, it seems that that table is created on top of the scatter plot instead.

I tried to fix the situation by creating empty plots

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    type = "scatter",
                    mode = 'markers')

fig3 <- plotly::plotly_empty(type = "scatter", 
                             mode = 'markers')

fig <- plotly::subplot(fig3, fig3, fig2, fig1, nrows = 2)

fig
#> Warning: 'layout' objects don't have these attributes: 'NA'
#> Valid attributes include:
#> 'font', 'title', 'uniformtext', 'autosize', 'width', 'height', 'margin', 'computed', 'paper_bgcolor', 'plot_bgcolor', 'separators', 'hidesources', 'showlegend', 'colorway', 'datarevision', 'uirevision', 'editrevision', 'selectionrevision', 'template', 'modebar', 'newshape', 'activeshape', 'meta', 'transition', '_deprecated', 'clickmode', 'dragmode', 'hovermode', 'hoverdistance', 'spikedistance', 'hoverlabel', 'selectdirection', 'grid', 'calendar', 'xaxis', 'yaxis', 'ternary', 'scene', 'geo', 'mapbox', 'polar', 'radialaxis', 'angularaxis', 'direction', 'orientation', 'editType', 'legend', 'annotations', 'shapes', 'images', 'updatemenus', 'sliders', 'colorscale', 'coloraxis', 'metasrc', 'barmode', 'bargap', 'mapType'

This gives the output as follows:

While I can now see the scatter plot, it is below the table instead of being on top.

Is there a way to move the table down ?

Thank you.

[stla]

As an alternative, you could use manipulateWidgets::combineWdigets.

[JauntyJJS]

@stla

Thank you for the feedback.

I have tried to used this function. It gives no issue when I did not add any colour parameters

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- c("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    # color = data[["cut"]],
                    # colors = cut_pal,
                    type = "scatter",
                    mode = 'markers')

fig <- manipulateWidget::combineWidgets(list = list(fig2, fig1))

fig


Created on 2021-08-12 by the reprex package (v2.0.1)

However, when I add my own color palatte, this strange message appeared
"Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON."

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- c("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    color = data[["cut"]],
                    colors = cut_pal,
                    type = "scatter",
                    mode = 'markers')

fig <- manipulateWidget::combineWidgets(list = list(fig2, fig1))

fig
#> Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.


Created on 2021-08-12 by the reprex package (v2.0.1)

It gives a decent plot though

Any idea what when wrong ?

[stla]

I think you have to transform cut_pal to a list.

cut_pal <- list("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

[JauntyJJS]

I am sorry but I got a new error message instead "Error in UseMethod("toPaletteFunc"): no applicable method for 'toPaletteFunc' applied to an object of class "list"

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)
library(manipulateWidget)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- list("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    color = data[["cut"]],
                    colors = cut_pal,
                    type = "scatter",
                    mode = 'markers')

fig <- manipulateWidget::combineWidgets(list = list(fig2, fig1))

fig
#> Error in UseMethod("toPaletteFunc"): no applicable method for 'toPaletteFunc' applied to an object of class "list"
Created on 2021-08-13 by the reprex package (v2.0.1)

[JauntyJJS]

Hi @stla ,

I think I manage to find a way to stop this message "Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON." from appearing.

You see, the message actually complains about the presence of a named vector. In this case my named vector is cut_pal

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- c("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

print(cut_pal)
#>     Ideal   Premium      Good Very Good 
#> "#377eb8" "#b72e92" "#322eb7" "#b7772e"

^{Created on 2022-02-15 by the reprex package (v2.0.1)}

The key was to remove the "name" of the named list using the function unname
giving

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- c("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    color = data[["cut"]],
                    colors = unname(cut_pal),
                    type = "scatter",
                    mode = 'markers')

fig2

^{Created on 2022-02-15 by the reprex package (v2.0.1)}

Unfortunately, this also means that now plotly does not know what colours goes to what group. So what I did was the following.

# Convert the column that holds the dilution_batch_var
# to factors
data[["cut"]] <- data[["cut"]] %>%
  # To handle the case that groups are named "1", "2", "3"
  as.character() %>%
  # Factor batch based on the order of the palette colours
  # So that the order will match
  factor(levels = names(cut_pal))

I basically convert the cut column to a factor and reorder them based on the cut palette name so that there is a one to one mapping.

If I am not happy with the factor order, I simply just reorder cut_pal before converting the column cut to a factor.

Putting all together, this is what i have.

library(plotly)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
#> Loading required package: ggplot2
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
library(ggplot2)
library(magrittr)

data <- head(ggplot2::diamonds)

fig1 <- plotly::plot_ly(
  type = 'table',
  columnwidth = c(100, 100),
  columnorder = c(0, 1),
  header = list(
    values = c("Cut","Price"),
    align = c("center", "center"),
    line = list(width = 1, color = 'black'),
    fill = list(color = c("grey", "grey")),
    font = list(family = "Arial", size = 14, color = "white")
  ),
  cells = list(
    values = rbind(data$cut, data$price),
    align = c("center", "center"),
    line = list(color = "black", width = 1),
    font = list(family = "Arial", size = 12, color = c("black"))
  ))

cut_name <- data  %>%
  dplyr::pull(.data[["cut"]]) %>%
  unique() %>%
  as.character()

cut_pal <- c("#377eb8","#b72e92","#322eb7","#b7772e") %>%
  stats::setNames(cut_name)

print(cut_pal)
#>     Ideal   Premium      Good Very Good 
#> "#377eb8" "#b72e92" "#322eb7" "#b7772e"

scales::show_col(cut_pal)

# Convert the column that holds the dilution_batch_var
# to factors
data[["cut"]] <- data[["cut"]] %>%
  # To handle the case that batches are named "1", "2", "3"
  as.character() %>%
  # Factor batch based on the order of the palette colours
  # So that the order will match
  factor(levels = names(cut_pal))

fig2 <- plotly::plot_ly() %>% 
  plotly::add_trace(data = data, 
                    x = data[["cut"]], 
                    y = data[["price"]],
                    color = data[["cut"]],
                    colors = unname(cut_pal),
                    type = "scatter",
                    mode = 'markers')

fig <- manipulateWidget::combineWidgets(list = list(fig2, fig1))

fig

^{Created on 2022-02-15 by the reprex package (v2.0.1)}

Do let me know if this method also works from your end.