编辑反应性数据库

Question

尝试编辑反应性数据库，以便在输出中反映对数据库的更新。已经尝试了许多变体，但没有工作，一般的想法是显示-在这里，我希望有更改的数据库图形更新。

library(tidyverse)
library(shiny)
library(DT)

# Define UI for application that draws a histogram
ui <- fluidPage(

    sidebarLayout(
        sidebarPanel(
            sliderInput("ages", "Max age:", 10, 100, 15),
            sliderInput("nsamp",
                        "Sample size:",
                        min = 10,
                        max = 1000,
                        value = 100)),
        
        mainPanel(dt_output('Sample sizes and weighting', 'x1'),
                  plotOutput("fig"))
    )
)

server <- function(input, output) {
   
    x = reactive({
        df = data.frame(age = 1:input$ages,
                        samples = input$nsamp,
                        weighting = 1)
    })

    output$x1 = renderDT(x(), 
                         selection = 'none', 
                         editable = TRUE,
                         server = TRUE,
                         rownames = FALSE)

    output$fig =  renderPlot({
        ggplot(x(), aes(age, samples)) +
          geom_line() +
          geom_point()
    })
    
}

shinyApp(ui = ui, server = server)

Answer 1

我们可以使用input$x1_cell_edit和reactiveValues来修改传递给绘图的数据。

注意isolate在renderDT中的使用，即在修改db$database时防止表重新呈现。

library(tidyverse)
library(shiny)
library(DT)

# Define UI for application that draws a histogram
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("ages", "Max age:", 10, 100, 15),
      sliderInput("nsamp",
        "Sample size:",
        min = 10,
        max = 1000,
        value = 100
      )
    ),
    mainPanel(
      dataTableOutput("x1"),
      plotOutput("fig")
    )
  )
)

server <- function(input, output) {

  # all the data will be stored in this two objects
  db <- reactiveValues(database = NULL)

  # to store the modified values
  edited_vals <- reactiveVal(tibble(row = numeric(), col = numeric(), value = numeric()))

  # create a new table each time the sliders are changed
  observeEvent(c(input$ages, input$nsamp), {
    df <- data.frame(
      age = 1:input$ages,
      samples = input$nsamp,
      weighting = 1
    )
    db$database <- df
  })



  observeEvent(input$x1_cell_edit, {
    db$database[as.numeric(input$x1_cell_edit$row), as.numeric(input$x1_cell_edit$col + 1)] <- as.numeric(input$x1_cell_edit$value)
  })

  output$x1 <- renderDT(
    {
      input$ages
      input$nsamp

      datatable(
        isolate(db$database),
        selection = "none",
        editable = TRUE,
        rownames = FALSE,
        options = list(stateSave = TRUE)
      )
    },
    server = TRUE
  )

  output$fig <- renderPlot({
    ggplot(db$database, aes(as.numeric(age), as.numeric(samples))) +
      geom_point() +
      geom_line()
  })
}

shinyApp(ui = ui, server = server)

​

​