我有一个仪表板（我是使用“ shinydashboard”软件包制作的）。
仪表板的用途
仪表板在不同的选项卡中显示不同季度的查询结果，每个选项卡中都有单独的SQL查询。数据库中的模式仅授予某些用户访问权限，因此，如果未对用户进行身份验证，他将无法查看查询结果。
必需的操作
对于身份验证过程，仪表板的主页要求用户提供以下信息
问题（有关用户界面和服务器，请参见下面的示例代码）
一旦用户单击“ home_act”操作按钮，我想存储该值以在所有其他选项卡中使用。每个选项卡将具有一个“ tab_ {no} _act”操作按钮，单击该按钮将使用来自主选项卡的存储输入中的值来产生相应选项卡的SQL查询结果。我不希望用户每次必须执行每个单独的选项卡时都返回并单击“ home_act”操作按钮。
仪表板的理想行为是：
转到“表2”，单击“提交”并获取sql tab_2查询结果。
我尝试过使用reactValues（）函数存储值并将它们传递给不同的反应堆，但是它不起作用。请让我知道我需要更改/应该使用哪个新功能。
可复制的示例代码
library(shinydashboard)
library(shiny)
library(data.table)
library(RPostgres)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Home", tabName = "home"),
menuItem("Tab 1", tabName = "tab_1"),
menuItem("Tab 2", tabName = "tab_2")
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "home",
fluidPage(
fluidRow(
column(3,offset = 0,
textInput(inputId = "home_latest_qtr",label = "Most Recent Quarter")),
column(3,offset = 0,
textInput(inputId = "home_pnltmt_latest_qtr",label = "Penultimate Latest Quarter")),
column(3,offset = 0,
textInput(inputId = "home_user",label = "Database Username")),
column(3,offset = 0,
passwordInput(inputId = "home_pwd",label = "Database Password")),
column(12,
actionButton(inputId = "home_act",label = "Home Submit"))
)
)
),
# Second tab content
tabItem(tabName = "tab_1",
fluidPage(
fluidRow(
column(3,
actionButton("tab_1_act","Tab 1 Submit"))
)
,
dataTableOutput(outputId = "tab_1_output")
)
),
tabItem(tabName = "tab_2",
fluidPage(
fluidRow(
column(3,
actionButton("tab_2_act","Tab 2 Submit"))
)
,
dataTableOutput(outputId = "tab_2_output")
)
)
)
))
server <- function(input, output) {
user_credentials <- reactiveValues(user = '', pwd = '',latest_qtr = '',pnltmt_latest_qtr = '')
observeEvent(input$home_act,{
user_credentials$user <- input$home_user
user_credentials$pwd <- input$home_pwd
user_credentials$latest_qtr <- input$home_latst_qtr
user_credentials$pnltmt_latest_qtr <- input$home_pnltmt_latest_qtr
})
tab_1_sql <- reactive({
paste0("
select * from table_1
where quarter = '",user_credentials$latest_qtr,"'
limit 100
;")
})
tab_2_sql <- reactive({
paste0("
select * from table_1
where quarter = '",user_credentials$pnltmt_latest_qtr,"'
limit 100
;")
})
tab_1_reactive <- reactive({
if(user_credentials$user == '' | user_credentials$pwd == '')
return()
data.table::as.data.table(
RPostgres::dbGetQuery(RPostgres::dbConnect(
drv = RPostgres::Postgres(),
host = "xyz.com",
port = 1234,
dbname = 'db',
user = user_credentials$user,
password = user_credentials$pwd), tab_1_sql())
)
})
tab_2_reactive <- reactive({
if(user_credentials$user == '' | user_credentials$pwd == '')
return()
data.table::as.data.table(
RPostgres::dbGetQuery(RPostgres::dbConnect(
drv = RPostgres::Postgres(),
host = "xyz.com",
port = 8888,
dbname = 'db',
user = user_credentials$user,
password = user_credentials$pwd), tab_2_sql())
)
})
output$tab_1_output <- renderDataTable({
tab_1_reactive()
})
output$tab_2_output <- renderDataTable({
tab_2_reactive()
})
}
shinyApp(ui, server)
答案 0 :(得分：0)
经过这篇文章How to listen for more than one event expression within a Shiny eventReactive handler 的研究，我得到了一个使用observeEvent而不是reactValues的有效解决方案。 这是代码
library(shinydashboard)
library(shiny)
library(data.table)
library(RPostgres)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Home", tabName = "home"),
menuItem("Tab 1", tabName = "tab_1"),
menuItem("Tab 2", tabName = "tab_2") )
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "home",
fluidPage(
fluidRow(
column(3,offset = 0,
textInput(inputId = "home_latest_qtr",label = "Most Recent Quarter")),
column(3,offset = 0,
textInput(inputId = "home_pnltmt_latest_qtr",label = "Penultimate Latest Quarter")),
column(3,offset = 0,
textInput(inputId = "home_user",label = "Database Username")),
column(3,offset = 0,
passwordInput(inputId = "home_pwd",label = "Database Password")),
column(12,
actionButton(inputId = "home_act",label = "Home Submit"))
)
)
),
# Second tab content
tabItem(tabName = "tab_1",
fluidPage(
fluidRow(
column(3,
actionButton("tab_1_act","Tab 1 Submit"))
)
,
dataTableOutput(outputId = "tab_1_output")
)
),
tabItem(tabName = "tab_2",
fluidPage(
fluidRow(
column(3,
actionButton("tab_2_act","Tab 2 Submit"))
)
,
dataTableOutput(outputId = "tab_2_output")
)
)
)
))
server <- function(input, output) {
tab_1_sql <- reactive({
paste0("
select * from table_1
where quarter = '",input$home_latest_qtr,"'
limit 100
;")
})
tab_2_sql <- reactive({
paste0("
select * from table_1
where quarter = '",input$home_pnltmt_latest_qtr,"'
limit 100
;")
})
observeEvent(
{input$home_act
input$tab_1_act},{
tab_1_reactive <- reactive({
data.table::as.data.table(
RPostgres::dbGetQuery(RPostgres::dbConnect(
drv = RPostgres::Postgres(),
host = "xyz.com",
port = 1234,
dbname = 'db',
user = input$home_user,
password = input$home_pwd), tab_1_sql())
)
})
output$tab_1_output <- renderDataTable({
tab_1_reactive()
})
})
observeEvent({
input$home_act
input$tab_2_act},
{
tab_2_reactive <- reactive({
data.table::as.data.table(
RPostgres::dbGetQuery(RPostgres::dbConnect(
drv = RPostgres::Postgres(),
host = "xyz.com",
port = 1234,
dbname = 'db',
user = input$home_user,
password = input$home_pwd), tab_2_sql())
)
})
output$tab_2_output <- renderDataTable({
tab_2_reactive()
})
})
}
shinyApp(ui, server)