Обновление нескольких виджетов по событию клика (Shiny) - PullRequest
0 голосов
/ 02 марта 2019

Я относительно новый пользователь R, и у меня есть следующий фрагмент кода: (как показано ниже).В настоящее время я определил кадры данных в самом примере, но в будущем я хотел бы прочитать их из базы данных.Я отобразил 3 выходных значения для риска с помощью функции TestOutput и на стороне сервера я прочитал значения из первого кадра данных (sc.risk.df).Нажав кнопку действия «Обновить», я хотел бы изменить значения на значения, считываемые со второго кадра данных (sc.risk.df_New).Итак, я справился с этим, поместив выходные операторы внутри функции ObserveEvent (в основном дублируя код).Я уверен, что есть лучший способ справиться с этим, но я не могу понять это.Может кто-нибудь любезно сказать мне, как лучше всего обрабатывать такие случаи, когда мне нужно обновить несколько элементов пользовательского интерфейса при нажатии кнопки «Обновить»?Заранее спасибо!Ура!

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)


#sample dataframe but will be read from DB
sc.risk.df <- data.frame(
  Category = c("High_Risk", "Medium_Risk", "Low_Risk"),
  Values = c(80, 300, 400)
)
#sample dataframe but will be read from DB 
sc.risk.df_New <- data.frame(
  Category = c("High_Risk", "Medium_Risk", "Low_Risk"),
  Values = c(100, 410, 500)
)

# ui function
ui <- fluidPage(

  actionButton("update", label = "Update"),

  column(width = 12,
         box(
           solidHeader = FALSE,
           title = "Status Summary",
           background = NULL,
           width = 12,
           status = "primary",
           footer = fluidRow(
             column(
               width = 4,
               descriptionBlock(

                 number_color = "green",
                 number_icon = "fa fa-refresh",
                 header = textOutput("test1_2"),
                 text = "High Risk",
                 right_border = TRUE,
                 margin_bottom = TRUE
               )
             ),
             column(
               width = 4,
               descriptionBlock(

                 number_color = "green",
                 number_icon = "fa fa-refresh",
                 header = textOutput("test2_2"),
                 text = "Medium Risk",
                 right_border = TRUE,
                 margin_bottom = TRUE
               )
             ),
             column(
               width = 4,
               descriptionBlock(

                 number_color = "orange",
                 number_icon = "fa fa-refresh",
                 header = textOutput("test3_2"),
                 text = "Low Risk",
                 right_border = TRUE,
                 margin_bottom = TRUE
               )
             )
           )
         ))

  )



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

   output$test1_2 = renderText({
     a <- sc.risk.df[1,2]
   })    

   output$test2_2 = renderText({
     a <- sc.risk.df[2,2]
   }) 

   output$test3_2 = renderText({
     a <- sc.risk.df[3,2]
   }) 

   observeEvent(input$update,
                {
                  output$test1_2 = renderText({
                    a <- sc.risk.df_New[1,2]
                  })
                  output$test2_2 = renderText({
                    a <- sc.risk.df_New[2,2]
                  })  
                  output$test3_2 = renderText({
                    a <- sc.risk.df_New[3,2]
                  })  

                }
   )

}

shinyApp(ui = ui, server = server)
...