r-如何从一个闪亮的应用程序中创建一个输入汇总表(均值)

Question

我有一个Shiny应用程序，它使用闪亮应用程序的接口收集Heights和Weights。

我想要的是一个位于原始值表下方的表，它可以给我输入到应用程序中的高度和重量的平均值，以及随着行的输入或删除而发生的变化。

我试图向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)