在 R Shiny 中 [=10th=] 处理后，根据用户先前的选择在 selectInput 中显示选项
Display options in selectInput based on user's previous selection after table processing in RShiny
我有一个闪亮的应用程序，它根据数据库过滤值的总和（第一行）和第一行（第二行）的比率的计算显示 table。在当前情况下，table 的过滤和处理工作完全正常，仅显示已 selected 的结果，如果不是所有过滤器都已编辑，则始终聚合数据选择。
但是，我希望 select 输入下拉列表仅显示基于用户已经做出的任何 selection 的可能选项，这样用户就不需要猜测原始数据越大，组合越多，有哪些组合。
示例：
在营销活动过滤器中 select 营销活动 F 时，只有 Objective 过滤器中的选项 'Objective 1' 和代码过滤器中的代码 608、609 出现，而 table 显示具有 'Campaign F' 的所有行的总和和比率。
或者，如果 'Objective 1' 被 selected，'Campaign A'、'Campaign C' 和 'Campaign F' 将作为选项出现在过滤器广告系列中，但 table 显示所有 'Objective 1' 行的值总和。
如果我select'Objective 1'和'Campaign F'，只剩下Code筛选器显示更多选项，而table显示的是求和的结果相应的行。等等。
Date Objective Campaign Code Metric_One Metric_Two Metric_Three Metric_Four
2018-09-04 Objective 1 Campaign A 601 8273 7417 415 129
2018-09-04 Objective 2 Campaign B 602 2390 818 30 4
2018-09-04 Objective 2 Campaign B 603 2485 1354 34 7
2018-09-05 Objective 1 Campaign C 604 537513 532170 18693 2136
2018-09-05 Objective 2 Campaign D 605 13 13 3 1
2018-09-08 Objective 3 Campaign E 606 14855 12505 676 162
2018-09-08 Objective 3 Campaign E 607 24363 20270 790 180
2018-09-10 Objective 1 Campaign F 608 155 148 11 1
2018-09-10 Objective 1 Campaign F 609 1320 974 79 11
我唯一的线索是它与 UI 反应性有关，也许与 observeEvent 有关。但是我只找到了那些显示数据库本身或纯数字的例子，我无法调整它们来计算 table.
的值
这是代码：
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output) { # Server
line_one <- reactive({
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)
感谢您的帮助和意见。
像这样就可以了，请注意我主要使用 observeEvent
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output,session) { # Server
observeEvent(input$objective,{
req(input$objective)
if(input$objective == "Nothing Selected"){
return()
}
updateSelectInput(session,"name_campaign", choices = c("Nothing Selected",campaigns$Campaign[campaigns$Objective %in% input$objective]),selected = "Nothing Selected")
})
observeEvent(c(input$objective,input$name_campaign),{
req(input$objective)
req(input$name_campaign)
if(input$objective == "Nothing Selected" || input$name_campaign == "Nothing Selected"){
return()
}
updateSelectInput(session,"code", choices = c("Nothing Selected",campaigns$Code[campaigns$Objective %in% input$objective & campaigns$Campaign %in% input$name_campaign]),selected = "Nothing Selected")
})
line_one <- reactive({
req(input$name_campaign)
req(input$code)
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)
我有一个闪亮的应用程序，它根据数据库过滤值的总和（第一行）和第一行（第二行）的比率的计算显示 table。在当前情况下，table 的过滤和处理工作完全正常，仅显示已 selected 的结果，如果不是所有过滤器都已编辑，则始终聚合数据选择。
但是，我希望 select 输入下拉列表仅显示基于用户已经做出的任何 selection 的可能选项，这样用户就不需要猜测原始数据越大，组合越多，有哪些组合。
示例：
在营销活动过滤器中 select 营销活动 F 时，只有 Objective 过滤器中的选项 'Objective 1' 和代码过滤器中的代码 608、609 出现，而 table 显示具有 'Campaign F' 的所有行的总和和比率。
或者，如果 'Objective 1' 被 selected，'Campaign A'、'Campaign C' 和 'Campaign F' 将作为选项出现在过滤器广告系列中，但 table 显示所有 'Objective 1' 行的值总和。
如果我select'Objective 1'和'Campaign F'，只剩下Code筛选器显示更多选项，而table显示的是求和的结果相应的行。等等。
Date Objective Campaign Code Metric_One Metric_Two Metric_Three Metric_Four
2018-09-04 Objective 1 Campaign A 601 8273 7417 415 129
2018-09-04 Objective 2 Campaign B 602 2390 818 30 4
2018-09-04 Objective 2 Campaign B 603 2485 1354 34 7
2018-09-05 Objective 1 Campaign C 604 537513 532170 18693 2136
2018-09-05 Objective 2 Campaign D 605 13 13 3 1
2018-09-08 Objective 3 Campaign E 606 14855 12505 676 162
2018-09-08 Objective 3 Campaign E 607 24363 20270 790 180
2018-09-10 Objective 1 Campaign F 608 155 148 11 1
2018-09-10 Objective 1 Campaign F 609 1320 974 79 11
我唯一的线索是它与 UI 反应性有关，也许与 observeEvent 有关。但是我只找到了那些显示数据库本身或纯数字的例子，我无法调整它们来计算 table.
的值这是代码：
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output) { # Server
line_one <- reactive({
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)
感谢您的帮助和意见。
像这样就可以了，请注意我主要使用 observeEvent
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output,session) { # Server
observeEvent(input$objective,{
req(input$objective)
if(input$objective == "Nothing Selected"){
return()
}
updateSelectInput(session,"name_campaign", choices = c("Nothing Selected",campaigns$Campaign[campaigns$Objective %in% input$objective]),selected = "Nothing Selected")
})
observeEvent(c(input$objective,input$name_campaign),{
req(input$objective)
req(input$name_campaign)
if(input$objective == "Nothing Selected" || input$name_campaign == "Nothing Selected"){
return()
}
updateSelectInput(session,"code", choices = c("Nothing Selected",campaigns$Code[campaigns$Objective %in% input$objective & campaigns$Campaign %in% input$name_campaign]),selected = "Nothing Selected")
})
line_one <- reactive({
req(input$name_campaign)
req(input$code)
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)