首页 > 解决方案 > rhandsontable 中条件值的持续更新

问题描述

我有一个按需要运行的迷你闪亮应用程序。首先,在应用程序的文件夹中,我为两个商店生成了一个包含数据框的列表:

stores <- list(store1 = tibble(Date = as.Date(c("2019-08-31", "2019-09-01", NA)), Item = c("A", "B", NA),
                              Price = c(100, 120, NA), Comment = as.character(rep(NA, 3))),
               store2 = tibble(Date = as.Date(c("2019-08-31", NA, NA)), Item = c("C", NA, NA),
                              Price = c(95, NA, NA), Comment = as.character(rep(NA, 3))))
saveRDS(stores, file = "stores.rds")
print(stores)

这是我的闪亮代码。我希望用户能够根据需要更新每个商店表中的信息,并通过单击“更新商店信息”操作按钮保存更改。

但是,请注意:在服务器代码的末尾我有这个“条件”行: mutate(Comment = ifelse(Price > 100, "Nice!", Comment)): If Price is > 100, a comment "Nice!" 应该出现 - 无需我手动输入。

问题:我不知道如何在单击 input$update_store 时使此条件注释出现在屏幕上的表格中。我可以在下拉菜单中切换到另一家商店,然后回到第一家商店 - 评论就会出现!但是有没有办法让它在点击 input$update_store 后立即更新?

非常感谢您的帮助!

library(shiny)
library(dplyr)
library(rhandsontable)
# Read in the existing list of stores:
stores <- readRDS("stores.rds")
print("Reading in stores the first time:")
print(stores)

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### ui code ####
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ui <- fluidPage(

    titlePanel("My UI"), # Application title
    sidebarLayout(       # Sidebar with a pull-down to select a store:
        sidebarPanel(
            selectizeInput("store_select", label = "Select store",
                           choices = names(stores), multiple = FALSE,
                           selected = names(stores)[1]),
            actionButton("update_store", "Update store Info")
        ),

        mainPanel(       # Main panel with an editable table:
            rHandsontableOutput("store_table")
        )
    )
)

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### server code ####
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
server <- function(input, output, session) {

    stores_reactive <- reactiveValues( # Creating reactive values for stores:
        stores = stores
    )

    # What happens when one store is selected:
    mystore <- eventReactive(input$store_select, {
        store_name <- input$store_select
        store_table <- stores_reactive$stores[[store_name]]
        return(store_table)
    })
    # rhandsontable to be shown:
    output$store_table <- renderRHandsontable({
        rhandsontable(mystore())
    })

    # What happens upon pressing button "Update store Info":
    observeEvent(input$update_store, {
        stores[[input$store_select]] <- hot_to_r(input$store_table) %>% 
            mutate(Comment = ifelse(Price > 100, "Nice!", Comment))
        stores_reactive$stores <- stores      # Update stores_reactive
        saveRDS(stores, file = "stores.rds")  # save stores to the file
        stores <<- stores                     # Update 'stores' list
    })
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Run the app #### 
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
shinyApp(ui = ui, server = server)

标签: rshinyreactiverhandsontable

解决方案


您不需要mystore成为eventReactive. input$store_select如果单击操作按钮 ( input$update_store),您的mystore方法将不会被调用,因为store_select没有改变。

如果要保留该mystore功能,可以执行以下操作,它应该可以工作。

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### server code ####
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
server <- function(input, output, session) {

  stores_reactive <- reactiveValues( # Creating reactive values for stores:
    stores = stores
  )

  # What happens when one store is selected:
  mystore <- function(store_name) {
    store_table <- stores_reactive$stores[[store_name]]
    return(store_table)
  }

  output$store_table <- renderRHandsontable({
    rhandsontable(mystore(input$store_select))
  })

  # What happens upon pressing button "Update store Info":
  observeEvent(input$update_store, {
    stores[[input$store_select]] <- hot_to_r(input$store_table) %>% 
      mutate(Comment = ifelse(Price > 100, "Nice!", Comment))
    stores_reactive$stores <- stores      # Update stores_reactive
    saveRDS(stores, file = "stores.rds")  # save stores to the file
    stores <<- stores                     # Update 'stores' list
  })
}

或者您可以使用以下方法完全不使用该mystore功能:

# rhandsontable to be shown:
output$store_table <- renderRHandsontable({
  rhandsontable(stores_reactive$stores[[input$store_select]])
})

推荐阅读