下面这个闪亮的应用运行得很好，但是有一个问题:由于动态过滤，它会显示错误或警告。
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
titlePanel(
div(style="line-height: 100%",
align = 'center',
span("Awesome reprex"),
hr()
)
),
sidebarMenu(
menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
)
),
dashboardBody(
tabItems(tabItem(tabName = "Home"),
tabItem(tabName = "Main",
fluidRow(
),
fluidRow(),
hr(),
fluidRow(style = 'background: white;',
div(
box(
title= "Much filters",
style = 'height:420px; background: gainsboro; margin-top: 5vw;',
width=3,
solidHeader = TRUE,
uiOutput("continent"),
uiOutput("country")
),
tabBox(
width = 9,
title = "Results",
id = "tabset1",
tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
style="zoom: 90%;",
DT::dataTableOutput("awesometable")
)
)
)
)
)
)
)
)
library(data.table)
library(shiny)
library(gapminder
server <- function(input, output, session) {
df <- gapminder::gapminder
output$continent = renderUI({
selectizeInput(inputId = "continent",
label = "Continent :",
choices = unique(df[,"continent"]),
selected = unique(df[,"continent"])[1])
})
# #
datasub <- reactive({
df[df$continent == input$continent,]
})
output$country = renderUI({
selectizeInput(inputId = "country",
label = "Country :",
choices = unique(datasub()[,"country"])
)
})
#
datasub2 <- reactive({
datasub()[datasub()$country == input$country, ]
})
output$awesometable <- DT::renderDataTable({
datasub2()
})
}
shinyApp(ui, server)
问题的第一部分:一旦我包含了一个过滤方法，错误就开始显示了:https://stackoverflow.com/a/51153769/12131069
在尝试了不同的方法之后，这是一个非常接近我正在寻找的工作。
然而，一旦应用程序被加载，这将出现在控制台中:
逻辑下标必须匹配索引输入的大小。输入的大小为392，但下标datasub2()$country== input$country的大小为0。
问题的第二部分:该应用程序正在使用{golem}包进行开发，这在构建可扩展和可维护的闪亮基础设施时非常有用。然而，我没有得到我所期望的(并且我得到了错误)。怎么解呢?我怎样才能"模块化"呢?我找到的创建相互依赖的过滤器的解决方案?
我一直在尝试这样做:
#' awesome_app_ui UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @import DT
#' @import plotly
#' @import htmltools
#' @import shinydashboard
#' @importFrom reactable JS
#' @importFrom shiny NS tagList
mod_chiffres_cles_ts_ui <- function(id){
ns <- NS(id)
df <- gapminder::gapminder
tabBox(width = 9,title = "Results",d = "tabset1",
tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
style="zoom: 90%;",DT::dataTableOutput("awesometable"))
}
#' awesome_app Server Functions
#'
#' @noRd
mod_chiffres_cles_ts_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
df <- gapminder::gapminder
output$continent = renderUI({
selectizeInput(inputId = "continent",
label = "Continent :",
choices = unique(df[,"continent"]),
selected = unique(df[,"continent"])[1])
})
# #
datasub <- reactive({
df[df$continent == input$continent,]
})
output$country = renderUI({
selectizeInput(inputId = "country",
label = "Country :",
choices = unique(datasub()[,"country"])
)
})
#
datasub2 <- reactive({
datasub()[datasub()$country == input$country, ]
})
output$awesometable <- DT::renderDataTable({
datasub2()
})
}
谢谢!
一旦你正确地使用req()，你的程序就会运行良好。
library(shiny)
library(data.table)
library(shiny)
library(gapminder)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
titlePanel(
div(style="line-height: 100%",
align = 'center',
span("Awesome reprex"),
hr()
)
),
sidebarMenu(
menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
)
),
dashboardBody(
tabItems(tabItem(tabName = "Home"),
tabItem(tabName = "Main",
fluidRow(
),
fluidRow(),
hr(),
fluidRow(style = 'background: white;',
div(
box(
title= "Much filters",
style = 'height:420px; background: gainsboro; margin-top: 5vw;',
width=3,
solidHeader = TRUE,
uiOutput("continent"),
uiOutput("country")
),
tabBox(
width = 9,
title = "Results",
id = "tabset1",
tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
style="zoom: 90%;",
DT::dataTableOutput("awesometable")
)
)
)
)
)
)
)
)
server <- function(input, output, session) {
df <- gapminder::gapminder
output$continent = renderUI({
selectizeInput(inputId = "continent",
label = "Continent :",
choices = unique(df[,"continent"]),
selected = unique(df[,"continent"])[1])
})
datasub <- reactive({
req(input$continent)
df[df$continent == input$continent,]
})
output$country = renderUI({
req(datasub())
selectizeInput(inputId = "country",
label = "Country :",
choices = unique(datasub()[,"country"])
)
})
datasub2 <- reactive({
req(datasub(),input$country)
datasub()[datasub()$country == input$country, ]
})
output$awesometable <- DT::renderDataTable({
req(datasub2())
datasub2()
})
}
shinyApp(ui, server)
您还可以使用模块，如下所示。您可能需要调整您想要放置selectInputs的位置。
library(shiny)
library(data.table)
library(shiny)
library(gapminder)
moduleServer <- function(id, module) {
callModule(module, id)
}
mod_chiffres_cles_ts_ui <- function(id){
ns <- NS(id)
tagList(
box(
title= "Filter",
style = 'height:420px; background: gainsboro; margin-top: 3vw;',
#width=3,
solidHeader = TRUE,
uiOutput(ns("mycontinent"))
)
)
}
mod_chiffres_cles_ts_server <- function(id,dat,var){
moduleServer( id, function(input, output, session){
ns <- session$ns
df <- isolate(dat())
output$mycontinent = renderUI({
selectizeInput(inputId = ns("continent"),
label = paste(var, ":"),
choices = unique(df[,var]),
selected = unique(df[,var])[1])
})
#print(var)
return(reactive(input$continent))
})
}
mod_chiffres_cles_ds_server <- function(id,dat,var,value){
moduleServer( id, function(input, output, session){
df <- isolate(dat())
datasub <- reactive({
val = as.character(value())
df[df[[as.name(var)]] == val,]
})
#print(var)
return(reactive(as.data.frame(datasub())))
})
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
titlePanel(
div(style="line-height: 100%",
align = 'center',
span("Awesome reprex"),
hr()
)
),
sidebarMenu(
menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
)
),
dashboardBody(
tabItems(tabItem(tabName = "Home"),
tabItem(tabName = "Main",
fluidRow(
column(6,mod_chiffres_cles_ts_ui("gap1"),
mod_chiffres_cles_ts_ui("gap2")
),
column(6,style = 'background: white;',
div(
tabBox(
width = 12,
title = "Results",
id = "tabset1",
tabPanel(style = 'overflow-y:scroll;height:560px;',"Awesome results !",
style="zoom: 90%;",
DTOutput("awesometable")
)
)
)
)
)
)
)
)
)
server <- function(input, output, session) {
dfa <- reactive(gapminder)
session$userData$settings <- reactiveValues(df1=NULL,df2=NULL)
rv <- reactiveValues()
var1 <- mod_chiffres_cles_ts_server("gap1",dfa,"continent")
observeEvent(var1(), {
data1 <- mod_chiffres_cles_ds_server("gap1",dfa,"continent", var1 )
session$userData$settings$df1 <- data1()
var21 <- mod_chiffres_cles_ts_server("gap2",data1,"country")
df21 <- mod_chiffres_cles_ds_server("gap2",data1,"country", var21 )
session$userData$settings$df2 <- df21()
print(var21)
})
df22 <- reactive(session$userData$settings$df1)
var22 <- mod_chiffres_cles_ts_server("gap2",df22,"country")
observeEvent(var22(), {
print(var22())
data2 <- mod_chiffres_cles_ds_server("gap2",df22,"country",var22)
session$userData$settings$df2 <- data2()
})
output$awesometable <- renderDT({
datatable(session$userData$settings$df2)
})
}
shinyApp(ui, server)