如何创建闪亮应用程序输入的摘要 table（均值）？

Question

我有一个 Shiny 应用程序，它使用 Shiny 应用程序的界面收集身高和体重数据。

我想要的是一个 table 刚好低于原始值 table 的值，它给我输入到应用程序中的身高和体重的平均值，并随着行的变化而变化被输入或删除。

我尝试向 replaceData 函数添加一些代码，但会引发错误。

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

df <- dplyr::tibble(Height = numeric(), Weight = numeric())

ui <- fluidPage(
  
  # App title ----
  titlePanel("DT + Proxy + Replace Data"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      # Input: Slider for the number of bins ----
      shiny::textInput(inputId = "height", label = "height"),
      shiny::textInput(inputId = "weight", label = "weight"),
      
      shiny::actionButton(inputId = "add", label = "Add"),
      
      shiny::selectInput(inputId = "remove_row", label = "Remove Row",
                         choices = 1:nrow(df)),
      
      shiny::actionButton(inputId = "remove", label = "Remove")
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: Histogram ----
      DT::DTOutput(outputId = "table"),
      DT::DTOutput(outputId = "mean_table"),
      
      
    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output, session) {
  
  mod_df <- shiny::reactiveValues(x = df)
  
  output$table <- DT::renderDT({
    
   mod_df$x
    
  })
  
#table 2
  output$mean_table <- DT::renderDT({
    
    mod_df$x
    
  })
  
  
  shiny::observe({
    shiny::updateSelectInput(session, inputId = "remove_row",
                             choices = 1:nrow(mod_df$x))
  })
  
  shiny::observeEvent(input$add, {
    
    mod_df$x <- mod_df$x %>%
      dplyr::bind_rows(
        dplyr::tibble(Height = as.numeric(input$height),
                      Weight = as.numeric(input$weight))) 
    
    
  })
  
  shiny::observeEvent(input$remove, {
    
    mod_df$x <- mod_df$x[-as.integer(input$remove_row), ]
    
  })
  
  proxy <- DT::dataTableProxy('table')

  
  shiny::observe({
    
    DT::replaceData(proxy, mod_df$x) 
  
  
  })
  
  
}

shinyApp(ui, server)

Answer 1

我们可以用Height和Weight来创建一个reactive。这将确保在计算平均值时反映来自 mod_df$x 的更改。

  mean_table_df <- eventReactive(mod_df$x, {
    mod_df$x %>%
      summarise(across(c("Height", "Weight"), ~ mean(., na.rm = TRUE)))
  })

  # table 2
  output$mean_table <- DT::renderDT({
    datatable(mean_table_df())
  })

完整的应用程序：

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

df <- dplyr::tibble(Height = numeric(), Weight = numeric())

ui <- fluidPage(

  # App title ----
  titlePanel("DT + Proxy + Replace Data"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Slider for the number of bins ----
      shiny::textInput(inputId = "height", label = "height"),
      shiny::textInput(inputId = "weight", label = "weight"),
      shiny::actionButton(inputId = "add", label = "Add"),
      shiny::selectInput(
        inputId = "remove_row", label = "Remove Row",
        choices = 1:nrow(df)
      ),
      shiny::actionButton(inputId = "remove", label = "Remove")
    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      DT::DTOutput(outputId = "table"),
      DT::DTOutput(outputId = "mean_table"),
    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output, session) {
  mod_df <- shiny::reactiveValues(x = df)

  output$table <- DT::renderDT({
    mod_df$x
  })




  shiny::observe({
    shiny::updateSelectInput(session,
      inputId = "remove_row",
      choices = 1:nrow(mod_df$x)
    )
  })

  shiny::observeEvent(input$add, {
    mod_df$x <- mod_df$x %>%
      dplyr::bind_rows(
        dplyr::tibble(
          Height = as.numeric(input$height),
          Weight = as.numeric(input$weight)
        )
      )
  })

  shiny::observeEvent(input$remove, {
    mod_df$x <- mod_df$x[-as.integer(input$remove_row), ]
  })

  proxy <- DT::dataTableProxy("table")


  shiny::observe({
    DT::replaceData(proxy, mod_df$x)
  })

  # TABLE 2

  mean_table_df <- eventReactive(mod_df$x, {
    mod_df$x %>%
      summarise(across(c("Height", "Weight"), ~ mean(., na.rm = TRUE)))
  })

  # table 2
  output$mean_table <- DT::renderDT({
    datatable(mean_table_df())
  })
}

shinyApp(ui, server)

如何创建闪亮应用程序输入的摘要 table（均值）？

How to create a summary table (means) of the inputs from a shiny app?

proxy

r

shiny