r - 将过滤后的数据(用户选择)显示/绘制到 Shiny 中新创建的导航栏选项卡中
问题描述
我目前在 Shiny 中遇到一个问题,我无法将过滤后的数据(用户选择)显示到新创建的导航栏选项卡中。这也导致了另一个奇怪的新标签删除问题。
问题:我被 Shiny 中的选择数据、附加选项卡(在导航栏中)、outputUI 和显示/绘图逻辑序列卡住了。
设想:
- 用户从本地计算机中选择的数据
- 用户从下拉列表中进行第一次选择
- 点击添加新标签
- 用户从下拉列表中进行第二次选择
- 点击添加新标签
使用的数据: 我不知道如何在 stackover flow 上上传数据,但是一个包含两列 A 和 B 的简单 csv 表将复制下面的结果
结果: 选项卡 A:显示“错误:无法将类型‘闭包’强制转换为‘字符’类型的向量”选项卡 B:删除选项卡功能现在也被破坏
我的最终目标是提供更多上下文:为了能够在新选项卡中使用此用户选择的数据显示图表、计算、表格。
在它开始出错之前我做了什么:我遵循了与这篇文章类似的逻辑,在新选项卡中显示用户过滤的数据(虽然不是新的 navbartab):
在此问题开始之前,我还从 Stackoverflow 获得了一些帮助。这可能有助于提供更多上下文,贡献者的所有答案都有效:
一如既往,非常感谢您调查我的问题。干杯
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(shinyjs)
library(data.table)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Stackoverflow help", id = "tabs",
tabPanel("Home",
sidebarPanel(
fileInput("file", "Upload data",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
#checkboxInput("header", "Header", TRUE),
actionButton("append", "Add new tab"),
uiOutput('tabnamesui')
),
mainPanel(
)
)
)
)
server <- function(input, output, session) {
userfile <- reactive({
input$file
})
filereact <- reactive({
read.table(
file = userfile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(filereact())
})
output$tabnamesui <- renderUI({
req(userfile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
selected="",multiple = FALSE
)
})
tabnamesinput <- reactive({
input$tabnamesui})
#Delete selected tab logic
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$tabnamesui,
sidebarPanel(
actionButton(paste0("remove_", input$tabnamesui), "Delete")),
mainPanel(
uiOutput("tabsets") #This is where I think something is broken
)
)
)
})
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "tabnamesui", selected = input$tabnamesui) # keep the selection when re-rendering sidebarPanel
}
})
#New tab logic to prevent inserting same tab twice with enable/disable action button
forcecombine = function(idtab,checker) {
colnames(idtab) = colnames(checker)
rbind(idtab,checker)
}
checker<-as.data.frame("checker")
idtab<-as.data.frame("checkers")
#only allow tab entry once
observeEvent(input$append, {
idtab <- paste0(tabnamesinput())
idtab<-as.data.frame(idtab)
checkerx<-forcecombine(idtab,checker)
repeated<-length(grep(idtab,checkerx))
if(repeated==1)
{
shinyjs::disable("append")
}
else {shinyjs::enable("append")
}
})
observeEvent(tabnamesinput(), {
shinyjs::enable("append")
})
shinyjs::disable("append")
observeEvent(input$file, {
shinyjs::enable("append")
})
#Subdata section, I want to only use the data the user has selected for the new Navbar tab
output$tabsets<-renderUI({
req(userfile())
tabtable<-reactive({
lapply(tabnamesinput(), function(x)
dataTableOutput(paste0('table',x)))
})
})
subsetdata<-reactive({
list_of_subdata<-lapply(tabnamesinput(), function(x) {
as.data.table((select(filereact(),x)))
})
names(list_of_subdata)<-tabnamesinput()
return(list_of_subdata)
})
observe(
lapply(tabnamesinput(), function(x) {
output[[paste0('table',x)]] <-
renderDataTable({
subsetdata()[[x]]
})}))
}
shinyApp(ui, server)
解决方案
您不能ID
在多个选项卡中输出相同的内容。一旦你解决了这个问题,它就可以工作了。您仍然需要定义希望在每个选项卡中显示的内容。我只是显示一个过滤表和一个示例图。此外,标签删除需要进行微调。工作代码如下所示。
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Stackoverflow help", id = "tabs",
tabPanel("Home",
sidebarPanel(
fileInput("file", "Upload data",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
#checkboxInput("header", "Header", TRUE),
actionButton("append", "Add new tab"),
uiOutput('tabnamesui')
),
mainPanel(
)
)
)
)
server <- function(input, output, session) {
userfile <- reactive({
input$file
})
filereact <- reactive({
read.table(
file = userfile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(filereact())
})
output$tabnamesui <- renderUI({
req(userfile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
selected="",multiple = FALSE
)
})
tabnamesinput <- reactive({
input$tabnamesui})
#Append selected tab logic
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$tabnamesui,
sidebarPanel(
actionButton(paste0("remove_", input$tabnamesui), "Delete")),
mainPanel(
#uiOutput("tabsets") #This is where I think something is broken
DTOutput(paste0("table",input$tabnamesui)),
plotOutput(paste0("plot",input$tabnamesui))
)
)
)
})
# Delete selected tab logic
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
if (input[[paste0("remove_",input$tabs)]]) { ## remove tab only if delete button has been clicked
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "tabnamesui", selected = input$tabnamesui) # keep the selection when re-rendering sidebarPanel
}
}
})
#New tab logic to prevent inserting same tab twice with enable/disable action button
forcecombine = function(idtab,checker) {
colnames(idtab) = colnames(checker)
rbind(idtab,checker)
}
checker<-as.data.frame("checker")
idtab<-as.data.frame("checkers")
#only allow tab entry once
observeEvent(input$append, {
idtab <- paste0(tabnamesinput())
idtab<-as.data.frame(idtab)
checkerx<-forcecombine(idtab,checker)
repeated<-length(grep(idtab,checkerx))
if(repeated==1)
{
shinyjs::disable("append")
}
else {shinyjs::enable("append")
}
})
observeEvent(input$tabnamesui, {
shinyjs::enable("append")
output[[paste0("plot",input$tabnamesui)]] <- renderPlot(plot(cars))
lapply(tabnamesinput(), function(x) {
df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
output[[paste0('table',x)]] <- renderDT({
df
#subsetdata()[[x]]
})})
})
shinyjs::disable("append")
observeEvent(input$file, {
shinyjs::enable("append")
})
}
shinyApp(ui, server)
推荐阅读
- html - Youtube iframe - 缩放以填充整个空间
- php - 使用透明度 Codeigniter 上传图像
- python - 有没有办法在将对象附加到列表时保留正在创建的 python 对象的别名?
- ios - 隐藏 UIStackview 的子视图时自动布局冲突
- python - 将循环写入pythonic方式
- graphics - WebGL 不会渲染任何东西,什么是合适的矩阵?
- c# - 如何在 foreach 循环中修复 SELECT 语句和 cookie 计数
- python - 为什么查询返回相同的对象并对数据库执行两次查询
- java - 如何修复在包中移动我的 java 文件后出现的错误“java.lang.NoClassDefFoundError”?
- npm - NPM FontAwesome 安装 --dev