Here’s the example of a working code. The idea is to have a data table output, where user may adjust the colors of the plotted points; the colors should stay changed during the session; the colors serves as inputs for the different outputs. It works with hex strings, but I’d like to switch to kind of color picking instead of the hex values.
Reprex
library(shiny)
library(DT)
library(ggplot2)
ui <- fluidPage(
DTOutput("table"),
plotOutput("plot")
)
server <- function(input, output, session) {
mdf <- data.frame(
station = c("Station 1", "Station 2", "Station 3"),
color = c("#1f77b4", "#ff7f0e", "#d62728"),
value = c(1, 2, 3)
)
meta <- reactiveValues(data = mdf)
proxy <- dataTableProxy("table")
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col + 1
k <- info$value
isolate({
meta$data[i, j] <- k
})
replaceData(proxy, meta$data, resetPaging = FALSE)
})
observe({
print(meta$data$color)
})
output$table <- renderDT({
datatable(
meta$data,
editable = TRUE,
rownames = FALSE
)
})
output$plot <- renderPlot({
ggplot(meta$data, aes(x = station, y = value)) +
geom_point(aes(color = station), size = 5) +
scale_color_manual(values = meta$data$color)
})
}
shinyApp(ui, server)
I’ve tried using colourpicker and shinyWidgets, but neither of that worked out: colors are changed in the DT visually, but seem not to impress the observer as an edit events…
here’s the Reprex of one of my trial, where hex values are replaced with color pickers, but not update reactive “meta” when adjusted.
library(shiny)
library(DT)
library(ggplot2)
library(shinyWidgets)
ui <- fluidPage(
DTOutput("table"),
plotOutput("plot")
)
server <- function(input, output, session) {
mdf <- data.frame(
station = c("Station 1", "Station 2", "Station 3"),
color = c("#1f77b4", "#ff7f0e", "#d62728"),
value = c(1, 2, 3)
)
meta <- reactiveValues(data = mdf)
proxy <- dataTableProxy("table")
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
i <- info$row
j <- info$col + 1
k <- info$value
isolate({
meta$data[i, j] <- k
})
replaceData(proxy, meta$data, resetPaging = FALSE)
})
observe({
print(meta$data$color)
})
output$table <- renderDT({
datatable(
meta$data,
editable = TRUE,
rownames = FALSE,
escape = FALSE,
options = list(
columnDefs = list(
list(targets = 1, render = JS(
"function(data, type, row, meta) {",
"return '<input type="color" value="' + data + '">';",
"}")
)
)
)
)
})
output$plot <- renderPlot({
ggplot(meta$data, aes(x = station, y = value)) +
geom_point(aes(color = station), size = 5) +
scale_color_manual(values = meta$data$color)
})
}
shinyApp(ui, server)