如何解决如何修复在 Shiny 中没有为 esquisserUI 弹出的过滤器选项？
我对我的应用有一些要求。
{1} 重新调整 mainPanel 后，esquisserUI 过滤器不再弹出。这是我遵循的工作示例 https://dreamrs.github.io/esquisse/articles/shiny-usage.html
此外，我还查看了这个 GitHub 问题，但它是为了禁用过滤器：https://github.com/dreamRs/esquisse/issues/71
关于一般信息的最终请求：
{2} server = FALSE 对庞大的数据集有什么作用？ (https://rstudio.github.io/DT/server.html) DT 建议将其默认设置为 TRUE 状态，但是如果我这样做，下载时将无法获得完整数据。我只获取当前页面中的数据。是否有您预见的问题？
谢谢，这是一个可重现的例子。
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)
# Credit: @Iz100 helped me a lot with UI.
ui <- fluidPage(
theme = shinytheme("simplex"),useShinyjs(),# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),tabPanel("Data Set Info",materialSwitch(inputId = "toggleSidebar",label = "Toggle Panel: ",value = TRUE,status = "warning"),sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",prettyRadioButtons(
inputId = "controller",label = "Choose:",choices = c("About"= 1,"iris"= 2,"mtcars" = 3),icon= icon("check"),selected = 1,status = "success",animation="smooth"
),br(),a(actionButton(inputId = "admin_email",label = "Contact Admin",icon = icon("envelope",lib = "font-awesome")),href="mailto:my_awesome_email_address.com")
),#panel where output is shown from server
mainPanel(
id = "main_panel",tabsetPanel(
id = "hidden_tabs",type = "hidden",tabPanelBody(
"panel1","navigation"
),tabPanelBody(
"panel2",tabsetPanel(
tabPanel("Data",DT::DTOutput('panel1_data')),tabPanel("Summary",verbatimtextoutput("panel1_sum")),tabPanel(
"Plot",esquisserUI(
id = "esquisse2",header = FALSE,choose_data = FALSE
)
)
)
),tabPanelBody(
"panel3",DT::DTOutput('panel3_data')),verbatimtextoutput("panel3_sum")),esquisserUI(
id = "esquisse3",choose_data = FALSE
)
)
)
)
)
)
)
),#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
)
)
server <- function(input,output,session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar,{
shinyjs::toggle(id = "Sidebar",condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
myModal <- function() {
div(id = "Download_DATA",modalDialog(easyClose = TRUE,title = "Alert!","Please remove all the filters if you want a full dataset.",downloadButton("download_excel","Download as XLSX")
)
)
}
# here we put all the data
data_sets <- list(df1 = data.frame(),df2= iris,df3 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df",data = data.frame())
# modules only need to be called it once but individually for esquisse
callModule(
module = esquisserServer,id = "esquisse2",data = data_to_use
)
callModule(
module = esquisserServer,id = "esquisse3",data = data_to_use
)
observeEvent(input$controller,{
# skip first panel since it is used to display navigation
updateTabsetPanel(session,inputId= "hidden_tabs",selected = paste0("panel",input$controller))
# enswure value is avilable throught selected tabSet
req(input$controller)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum
output[[paste0('panel',input$controller,'_data')]] <- DT::renderDT(server = FALSE,{
DT::datatable(data_to_use$data,filter = 'top',extensions = 'Buttons',options = list(scrollY = 600,scrollX = TRUE,dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',lengthMenu= list(c(10,25,50,-1),c('10','25','50','All')),buttons = list(
list(extend = "collection",text = "Download",filename = "data_excel",exportOptions = list(
modifier = list(page = "all")
),action = DT::JS("function ( e,dt,node,config ) {
Shiny.setInputValue('Download_DATA',true,{priority: 'event'});}"
)
)
),scrollCollapse= TRUE,lengthChange = TRUE,widthChange= TRUE,rownames = TRUE))})
output[[paste0('panel','_sum')]] <- renderPrint(summary(data_to_use$data))
})
# observes if download is clicked
observeEvent(input$Download_DATA,{
showModal(myModal())
})
# writes to an excel file
output$download_excel <- downloadHandler(
filename = function() {
paste("data-",Sys.Date(),".xlsx",sep="")
},content = function(file) {
write.xlsx(data_to_use$data,file,row.names = FALSE)
}
)
}
#runs the app
shinyApp(ui= ui,server= server)
解决方法
1。我检查了 esquisserUI 的 HTML，如果您使用多个 esquisserUI，它们会为所有下拉菜单提供相同的 ID。这在 HTML 开发中是一个很大的问题，会导致很多问题。他们称其为模块，但他们没有遵循 Shiny 模块指南，在何处将 NS() 用于所有 UI ID。简单的证明是在下面试试这个。然后取消注释第二组 esquisserUI 和 esquisserServer 并重试。您会发现下拉菜单不再有效。
library(esquisse)
ui <- fluidPage(
esquisserUI(
id = "esquisse1",header = FALSE,choose_data = FALSE
)#,# esquisserUI(
# id = "esquisse2",# header = FALSE,# choose_data = FALSE
# )
)
server <- function(input,output,session) {
data_to_use <- reactiveValues(data = iris,name = "iris")
callModule(
module = esquisserServer,id = "esquisse1",data = data_to_use
)
# callModule(
# module = esquisserServer,# id = "esquisse2",# data = data_to_use
# )
}
shinyApp(ui,server)
目前没有直接的解决方法，除非你要求他们修复它。我们需要使用一种解决方法：
我在主面板中添加了一个名为“plot”的新选项卡，即 esquisserUI，以及数据面板中的两个按钮，因此当您单击该按钮时，它会跳转到带有正确的数据。
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)
# Credit: @Iz100 helped me a lot with UI.
ns <- NS("myapp")
ui <- fluidPage(
theme = shinytheme("simplex"),useShinyjs(),# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),tabPanel("Data Set Info",materialSwitch(inputId = "toggleSidebar",label = "Toggle Panel: ",value = TRUE,status = "warning"),sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",prettyRadioButtons(
inputId = "controller",label = "Choose:",choices = c("About"= 1,"iris"= 2,"mtcars" = 3,"plots" = 4),icon= icon("check"),selected = 1,status = "success",animation="smooth"
),br(),a(actionButton(inputId = "admin_email",label = "Contact Admin",icon = icon("envelope",lib = "font-awesome")),href="mailto:my_awesome_email_address.com")
),#panel where output is shown from server
mainPanel(
id = "main_panel",tabsetPanel(
id = "hidden_tabs",type = "hidden",tabPanelBody(
"panel1","navigation"
),tabPanelBody(
"panel2",tabsetPanel(
tabPanel(
"Data",DT::DTOutput('panel2_data'),actionButton("plot2","Plot iris")
),tabPanel("Summary",verbatimTextOutput("panel2_sum"))
)
),tabPanelBody(
"panel3",DT::DTOutput('panel3_data'),actionButton("plot3","Plot mtcars")
),verbatimTextOutput("panel3_sum"))
)
),tabPanelBody(
"panel4",esquisserUI(
id = "esquisse",choose_data = FALSE
)
)
)
)
)
),#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
)
)
server <- function(input,session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar,{
shinyjs::toggle(id = "Sidebar",condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
myModal <- function() {
div(id = "Download_DATA",modalDialog(easyClose = TRUE,title = "Alert!","Please remove all the filters if you want a full dataset.",downloadButton("download_excel","Download as XLSX")
)
)
}
# here we put all the data
data_sets <- list(df1 = data.frame(),df2= iris,df3 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df",data = data.frame())
# modules only need to be called it once but individually for esquisse
callModule(
module = esquisserServer,id = "esquisse",data = data_to_use
)
# go to plot panel if plot button clicked
observeEvent(c(input$plot2,input$plot3),{
updatePrettyRadioButtons(session,"controller",selected = 4)
},ignoreInit = TRUE)
observeEvent(input$controller,{
# skip first panel since it is used to display navigation
updateTabsetPanel(session,inputId= "hidden_tabs",selected = paste0("panel",input$controller))
# enswure value is avilable throught selected tabSet
# only render data if data panels are selected
req(input$controller %in% 2:3)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum
output[[paste0('panel',input$controller,'_data')]] <- DT::renderDT(server = FALSE,{
DT::datatable(data_to_use$data,filter = 'top',extensions = 'Buttons',options = list(scrollY = 600,scrollX = TRUE,dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',lengthMenu= list(c(10,25,50,-1),c('10','25','50','All')),buttons = list(
list(extend = "collection",text = "Download",filename = "data_excel",exportOptions = list(
modifier = list(page = "all")
),action = DT::JS("function ( e,dt,node,config ) {
Shiny.setInputValue('Download_DATA',true,{priority: 'event'});}"
)
)
),scrollCollapse= TRUE,lengthChange = TRUE,widthChange= TRUE,rownames = TRUE))})
output[[paste0('panel','_sum')]] <- renderPrint(summary(data_to_use$data))
})
# observes if download is clicked
observeEvent(input$Download_DATA,{
showModal(myModal())
})
# writes to an excel file
output$download_excel <- downloadHandler(
filename = function() {
paste("data-",Sys.Date(),".xlsx",sep="")
},content = function(file) {
write.xlsx(data_to_use$data,file,row.names = FALSE)
}
)
}
#runs the app
shinyApp(ui= ui,server= server)
2. 所以 server = TRUE 只将整个数据集的很小一部分发送到 UI 以获取大型数据集。当您滚动或跳转页面时，将发送新数据。这样可以节省时间并具有更好的性能。如果是FALSE，所有数据将被一次性发送。想象一下，每次启动应用程序时，您都需要在浏览器中加载一个 2GB 的表，它会有多慢。对于小型数据集，您可以将其保留为 FALSE。
更新 似乎 esquisse 人修复了这个错误。安装开发版本，然后：
ui <- fluidPage(
esquisse_ui(
id = "esquisse1",header = FALSE
),esquisse_ui(
id = "esquisse2",header = FALSE
)
)
server <- function(input,name = "iris")
esquisse_server(id = "esquisse1",data_rv = data_to_use)
esquisse_server(id = "esquisse2",data_rv = data_to_use)
}
shinyApp(ui,server)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
