大佬教程收集整理的这篇文章主要介绍了在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入,大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。
我希望在 Shiny 中为每个新创建的选项卡提供唯一的用户输入,但是一旦用户选择了它存储的输入并且不会为创建的其他选项卡更改。
场景:
数据:任何包含两列 A 和 B 的简单 csv 表都会复制下面的结果
预期结果:每个标签都有唯一的用户输入并动态更改活动标签图
我认为问题所在的代码部分:在第 68 和 120 行。有没有办法为每个修改后的选项卡设置唯一的输入?
感谢您调查我的问题。
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(shinyJs)
library(data.tablE)
library(ggplot2)
ui <- fluIDPage(
useShinyJs(),navbarPage(title = "Test",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"),texTinput("x","X-axis label"),texTinput("titlename","title"),slIDerinput("bins","number of bins",value = 50,min = 1,max = 100)
),mainPanel(
plotOutput(paste0("dp2",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")
lapply(tabnamesinput(),function(X) {
df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
output[[paste0("dp2",input$tabnamesui)]] <- renderPlot({
bins <- seq(min(as.numeric(unList(df))),max(as.numeric(unList(df))),length.out = input$bins + 1)
hist(as.numeric(unList(df)),# histogram
col="gray",xlim=c(min(as.numeric(unList(df))),max(as.numeric(unList(df)))),border="black",breaks = seq(min(as.numeric(unList(df))),length.out = input$bins+1),prob = TRUE,# show densitIEs instead of frequencIEs
xlab = input$x,main = input$titleName)
})
})
})
shinyJs::disable("append")
observeEvent(input$file,{
shinyJs::enable("append")
})
}
shinyApp(ui,server)
试试这个
ui <- fluidPage(
useShinyjs(),navbarPage(title = "Test",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"),texTinput(paste0("x.","X-axis label"),texTinput(paste0("titlename","title"),sliderInput("bins","number of bins",value = 50,min = 1,max = 100)
),mainPanel(
plotOutput(paste0("dp2",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")
lapply(tabnamesinput(),function(X) {
df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
tab_name <- input$tabnamesui
output[[paste0("dp2",input$tabnamesui)]] <- renderPlot({
bins <- seq(min(as.numeric(unlist(df))),max(as.numeric(unlist(df))),length.out = input$bins + 1)
hist(as.numeric(unlist(df)),# histogram
col="gray",xlim=c(min(as.numeric(unlist(df))),max(as.numeric(unlist(df)))),border="black",breaks = seq(min(as.numeric(unlist(df))),length.out = input$bins+1),prob = TRUE,# show densities instead of frequencies
xlab = input[[paste0("x.",tab_Name)]],main = input[[paste0("titlename",tab_Name)]] )
})
})
})
shinyjs::disable("append")
observeEvent(input$file,{
shinyjs::enable("append")
})
}
shinyApp(ui,server)
以上是大佬教程为你收集整理的在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入全部内容,希望文章能够帮你解决在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入所遇到的程序开发问题。
如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。
本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。