DT 中的反应式颜色选择器

问题描述 投票:0回答:1

这是工作代码的示例。这个想法是有一个数据表输出,用户可以在其中调整绘制点的颜色;会话期间颜色应保持变化;颜色作为不同输出的输入。它适用于十六进制字符串,但我想切换到颜色选择而不是十六进制值。

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)

我尝试过使用colourpicker和shinyWidgets,但都没有成功:颜色在DT中视觉上发生了变化,但作为编辑事件似乎没有给观察者留下深刻的印象...

这是我的一项试验的 Reprex,其中十六进制值被颜色选择器替换,但在调整时不更新反应性“元”。

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)

r shiny dt color-picker shinywidgets
1个回答
0
投票

你可以使用rhandsontable

library(shiny)
library(rhandsontable)
library(colourpicker)

ui <- fluidPage(
      rHandsontableOutput("hot"),
      plotOutput("plot")
    )

server <- function(input, output, session) {
  mdf <- data.frame(
      station = c("Station 1", "Station 2", "Station 3"),
      Color = c("#1f77b4", "#ff7f0e", "#d62728"),  # Default colors
      value = c(1, 2, 3),
      stringsAsFactors = FALSE
    
  )
  
  meta <- reactiveValues(data = mdf)
  
  output$hot <- renderRHandsontable({
    req(meta$data)
    rhandsontable(meta$data,rowHeaders = NULL) %>%
      hot_col("Color", renderer = "
        function(instance, td, row, col, prop, value, cellProperties) {
          Handsontable.renderers.TextRenderer.apply(this, arguments);
          var colorPicker = document.createElement('input');
          colorPicker.type = 'color';
          colorPicker.value = value;
          colorPicker.style.width = '100%';
          colorPicker.style.border = 'none';
          
          colorPicker.oninput = function() {
            td.style.backgroundColor = this.value;
            Shiny.setInputValue('color_clicked', {row: row, color: this.value}, {priority: 'event'});
          };
          
          td.innerHTML = '';
          td.appendChild(colorPicker);
          td.style.backgroundColor = value;
        }",
              editor = "text")
  })
  

 observeEvent(input$color_clicked, {
    meta$data$Color[input$color_clicked$row+1] <- input$color_clicked$color
      })

  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 = ui, server = server)
© www.soinside.com 2019 - 2024. All rights reserved.