程序问答   发布时间:2022-06-01  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。

如何解决在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入?

开发过程中遇到在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入的问题如何解决?下面主要结合日常开发的经验,给出你关于在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入的解决方法建议,希望对你解决在 Shiny 中创建的每个新动态选项卡的独特侧边栏输入有所启发或帮助;

我希望在 Shiny 中为每个新创建的选项卡提供唯一的用户输入,但是一旦用户选择了它存储的输入并且不会为创建的其他选项卡更改。

场景:

  1. 用户从本地计算机中选择的数据
  2. 用户从下拉列表中进行选择
  3. 点击添加新标签
  4. 点击新标签
  5. 用户自定义输入 = 图表动态变化
  6. 返回主页选择新数据并点击添加新标签
  7. 点击新标签
  8. 用户自定义输入 = 图形不会更改,并且会根据第 5 步中的用户输入进行更改

数据:任何包含两列 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,请注明来意。
标签: