Trying to edit a reactive database so that updates to the database are reflected in the output. Have tried numerous variants, but none are working, general idea is shown - where I would like to have the figure update with changes to the 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(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)

CodePudding user response：

We can use input$x1_cell_edit and reactiveValues to modify the data that is passed to the plot.

Note the use of isolate inside renderDT, that is to prevent the table from re-rendering when db$database is modified.

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)