在RShiny
我有一个闪亮的应用程序，它根据数据库的过滤值的总和（第一行）和第一行（第二行）的比率显示一个表格。在当前情况下，表的过滤和处理正在按应有的方式工作，仅显示所选内容的结果，如果未选择所有过滤器，则始终汇总数据。
但是，我希望selectInput下拉列表根据用户已经做出的选择仅显示可能的选项，以便用户无需猜测哪些组合是可用的，因为原始数据较大且具有更多组合。
示例：
在“广告系列”过滤器中选择“广告系列F”时，仅显示“目标”过滤器中的“目标1”选项和“代码”过滤器中的代码608、609，而该表显示所有具有“广告系列”的行的总和和费率F'。
或者，如果选择了“目标1”，则“广告系列A”，“广告系列C”和“广告系列F”将作为过滤器“广告系列”的选项出现，但该表显示的是“目标”所有行的值之和1'。
如果我选择“目标1”和“广告系列F”，则只剩下“代码”过滤器以显示更多选项，而表格则显示相应行总和的结果。依此类推。
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有关。但是我只发现了一些示例，这些示例显示了数据库本身或纯数字，但是我无法使其适应于计算表的值。
这是代码：
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)
感谢您的帮助和投入。
1 个答案:
答案 0 :(得分：1)
像这样的事情可以解决问题，请注意，我主要使用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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？