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

Question

我想在 Shiny 中为每个新创建的选项卡提供唯一的用户输入，但是一旦用户 selects 输入它存储并且不会因创建的其他选项卡而改变。

场景：

用户select从本地计算机编辑数据
用户从下拉列表中选择 selection
点击添加新标签
点击新标签
用户自定义输入 = 图形动态变化
返回主页select新数据并点击添加新标签
点击新标签
用户自定义输入 = 图形不会更改，并会根据步骤 5 中的用户输入进行更改

数据：任何具有两列 A 和 B 的简单 csv table 将复制以下结果

期望的结果：每个选项卡都有唯一的用户输入并动态更改活动选项卡图形

我认为问题所在的代码部分： 在第 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))), max(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)

Answer 1

试试这个

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.",input$tabnamesui), "X-axis label"),
                         textInput(paste0("titlename",input$tabnamesui), "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))), max(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 中创建的每个新动态选项卡的独特侧边栏输入

Unique sidebar inputs for each new dynamic tab created in Shiny

tabs

r

input

output

shiny