Shiny - 如何根据原始数据第一个表中的用户输入更新 Shiny 中的第二个汇总表？

Question

I am building my first Shiny App to replace an Excel report. One feature that is necessary is the option to be able to edit the data in the table and see summarized values update with the user-inputted value.

I am stuck figuring out how to capture that new value and refresh the summary table using that new value.

If there is another similar question, please share it.

I have tried using Observe, ObserveEvent and Reactive. I do not grasp these concepts completely, however, when I have used them as intended, they have worked as I expected.

I have tried to replicate the issue using some available R Datasets. See code below.

The tableOutput containing the initial data based on user selection is editable. Hence, when a new number is placed in that column, I expect the summaryOutput to update and reflect accordingly.

Any guidance or input is greatly appreciated. This will be a big win over Excel once this works.

Thank you!

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(DT)

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

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            selectInput("data",
                        "Select Dataset",
                        choices = c( "iris", "mtcars", "faithful"),
                        selected = "faithful")
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("distPlot"),
           DT::dataTableOutput("tableOutput"),
           DT::dataTableOutput("summaryOutput"),
           textOutput("text")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    # https://nbisweden.github.io/RaukR-2019/shiny/lab/shiny_lab.html
    getdata <- reactive({ get(input$data, 'package:datasets') })
    getsummary <- reactive({summary(getdata()[2])})

    output$distPlot <- renderPlot({
        
        # generate bins based on input$bins from ui.R
        
        x    <- as.numeric(getdata()[,2])
        xname <- colnames(getdata()[2])
        bins <- seq(min(x), max(x), length.out = input$bins + 1)
        
        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white',
             main = paste("Histogram of" , xname),)
        #hist(x)
    })
    
    output$tableOutput <- DT::renderDataTable({
        DT::datatable(getdata(),
                      editable = TRUE,
                      options = list(orderClasses = TRUE
                                     )
        )
    })
    
    
    output$summaryOutput <- DT::renderDataTable({
        DT::datatable(getsummary())
    })
    
    
    proxy = dataTableProxy('tableOutput')
    
    observeEvent(input$x1_cell_edit, {
        info = input$x1_cell_edit
        str(info)
        i = info$row
        j = info$col
        v = info$value
        getdata()[i, j] <<- DT::coerceValue(v, getdata()[i, j])
        replaceData(proxy, getdata(), resetPaging = FALSE)  # important
    })
    

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

One can't modify the output of a reactive conductor, as you're trying to do like this:

getdata()[i, j] <- ......

Use reactive values instead:

getdata <- reactiveVal()
getsummary <- reactiveVal()

observeEvent(input$data, {
  dataset <- get(input$data, 'package:datasets')
  getdata(dataset)
})

observeEvent(getdata(), {
  datasummary <- summary(getdata()[2])
  getsummary(datasummary)
})

Then:

observeEvent(input$x1_cell_edit, {
  info <- input$x1_cell_edit
  i <- info$row
  j <- info$col
  v <- info$value
  dataset <- getdata()
  dataset[i, j] <- coerceValue(v, dataset[i, j])
  replaceData(proxy, dataset, resetPaging = FALSE)
  getdata(dataset)
})