在 Shiny 中修改反应数据表的一列

Question

我正在尝试修改 Shiny 中的反应式数据表，其中用户可以使用在 selectInput 框中选择的值更改单个值或整列。

下面的代码用于普通表和数据表。 该代码正在使用 selectInput（但不是单个值）和数据表的单个值更改普通表的第一列。 但是我无法使用 selectInput 更改数据表的第一列。 请问有什么建议吗？

library(lubridate)
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT)

test_data<- data.frame(matrix(data=round(rnorm(8*5),2),ncol=8,nrow=5))

mod_data <- function(input, output, session, data_in) {

  data_x <- reactiveValues(
    data=data_in
  )
  proxy = dataTableProxy("data_in")

  # observe({
  #   newvar <- input$var_1
  #   data_x$data[, 1] <<- newvar
  #   replaceData(proxy, data_x$data, resetPaging = FALSE)
  # })

  observeEvent(input$var_1, {
    isolate(data_x$data[1, 1] <<- input$var_1)
    replaceData(proxy, data_x$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })

  #manual element update
  observeEvent(input$data_mod_cell_edit, {
    info = input$data_mod_cell_edit
    str(info)
    i = info$row
    j = info$col+1
    k = info$value
    str(info)

    isolate(
      if (j %in% match(c("X1","X2"), names(data_x$data))) {
        data_x$data[i, j] <<- DT::coerceValue(k, data_x$data[i, j])
      } 
    )
    replaceData(proxy, data_x$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })

  output$data_mod <- DT::renderDataTable({
    DT::datatable(
      data=data_x$data,
      editable = TRUE,
      rownames = FALSE,
      class="compact cell-border",
      selection = list(mode = "single",
                       target = "row"
      ),
      options = list(
        dom="t",
        autoWidth=TRUE,
        scrollX = TRUE,
        ordering=FALSE,
        pageLength = 16,
        bLengthChange= FALSE,
        searching=FALSE
      )
    )
  })

  }

modFunctionUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns(id))
}

# Define UI 
  #ui----
  ui= fluidPage(
    fluidRow(
      br(),
      br(),
      column(1,selectInput(inputId="var_1", label = h5("var 1"), choices=c(555,444),selected = 555)),
      column(4, tableOutput("data")),
      column(4, modFunctionUI("data_mod"))
    ),
    #set font size of tables
    useShinyjs(),
    inlineCSS(list("table" = "font-size: 12px"))
  )

  #shiny server ----
  server=function(input,output,session){

    #normal table
    global <- reactiveValues( df =test_data )
    observe({ global$df$X1 <- input$var_1 })
    output$data <- renderTable({global$df })

    #datatable
    callModule(module=mod_data,
               id="data_mod",
               data_in=test_data
    )
  }
# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

这应该会让你有所收获。 让我知道还需要什么。 请参阅无法将用户输入传递到 R 闪亮模块中。 重点是您需要将来自主应用程序的输入作为反应传递给模块。

library(lubridate)
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT)

test_data<- data.frame(matrix(data=round(rnorm(8*5),2),ncol=8,nrow=5))

mod_data <- function(input, output, session, data_in, var_1) {

    data_x <- reactiveValues(
        data=data_in
    )
    proxy = dataTableProxy("data_in")

    # observe({
    #   newvar <- var_1()
    #   data_x$data[, 1] <<- newvar
    #   replaceData(proxy, data_x$data, resetPaging = FALSE)
    # })

    observeEvent(var_1(), {
        isolate(data_x$data[1, 1] <<- var_1())
        replaceData(proxy, data_x$data, resetPaging = FALSE)  # replaces data displayed by the updated table
    })

    #manual element update
    observeEvent(input$data_mod_cell_edit, {
        info = input$data_mod_cell_edit
        str(info)
        i = info$row
        j = info$col+1
        k = info$value
        str(info)

        isolate(
            if (j %in% match(c("X1","X2"), names(data_x$data))) {
                data_x$data[i, j] <<- DT::coerceValue(k, data_x$data[i, j])
            } 
        )
        replaceData(proxy, data_x$data, resetPaging = FALSE)  # replaces data displayed by the updated table
    })

    output$data_mod <- DT::renderDataTable({
        DT::datatable(
            data=data_x$data,
            editable = TRUE,
            rownames = FALSE,
            class="compact cell-border",
            selection = list(mode = "single",
                             target = "row"
            ),
            options = list(
                dom="t",
                autoWidth=TRUE,
                scrollX = TRUE,
                ordering=FALSE,
                pageLength = 16,
                bLengthChange= FALSE,
                searching=FALSE
            )
        )
    })

}

modFunctionUI <- function(id) {
    ns <- NS(id)
    DT::dataTableOutput(ns(id))
}

# Define UI 
#ui----
ui= fluidPage(
    fluidRow(
        br(),
        br(),
        column(1,selectInput(inputId="var_1", label = h5("var 1"), choices=c(555,444),selected = 555)),
        column(4, tableOutput("data")),
        column(4, modFunctionUI("data_mod"))
    ),
    #set font size of tables
    useShinyjs(),
    inlineCSS(list("table" = "font-size: 12px"))
)

#shiny server ----
server=function(input,output,session){

    #normal table
    global <- reactiveValues( df =test_data )
    observe({ global$df$X1 <- input$var_1 })
    output$data <- renderTable({global$df })

    #datatable
    callModule(module=mod_data,
               id="data_mod",
               data_in=test_data,
               var_1=reactive(input$var_1)
    )
}
# Run the application 
shinyApp(ui = ui, server = server)