闪亮的“删除标签”功能会在选中时自动删除新创建的标签

Question

有一个闪亮的删除标签回归问题，其中删除标签功能一直在工作，直到添加了新功能以动态添加数据表并在闪亮的新标签中绘图。

场景：

1. 用户从本地计算机中选择的数据
2. 用户从下拉列表中进行选择
3. 点击添加新标签
4. 点击新标签

结果：新标签页在第 4 步后自动删除

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

期望的结果：防止自动删除，只通过点击删除按钮删除选定的标签

以下代码中标记的问题区域： # 删除选中的选项卡逻辑。如果这部分逻辑被注释掉，自动删除问题就消失了，但不能由用户手动删除标签。

感谢您调查我的问题。

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})
  
  #Append selected tab logic
  observeEvent(input$append,{
    appendTab(inputId = "tabs",
              tabPanel(input$tabnamesui, 
                       sidebarPanel(
                         actionButton(paste0("remove_", input$tabnamesui), "Delete")),
                       mainPanel(
                         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"){
       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")
    lapply(tabnamesinput(), function(x) {
      df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
      output[[paste0('table',x)]] <- renderDT({df})
      output[[paste0("plot",input$tabnamesui)]] <- renderPlot(boxplot(df,data=df, main="", xlab="", ylab=""))
      })
  })
  
  shinyjs::disable("append")
  
  observeEvent(input$file, {
    shinyjs::enable("append")
  })
  
}

shinyApp(ui, server)

Answer 1

您需要检查按钮是否已被点击。试试这个

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)