使用shinyjs、insertUI()和removeUI()与Shiny模块

Question

编辑：我只需要更改 insertUI 选择器的命名空间！会留给别人的。

insertUI(
        selector = paste0("#",ns(add)),
        where = "afterEnd",
        ui = tags$div(
          id = ui_id,
          box(
            textInput(paste0("txt", added_ui_count()), "Insert some text")
          )
        )
      )

我尝试使用shinyjs来控制fileInputs的数量，一旦用户将文件上传到所有输入，它最终会显示一个绘图。我无法让它作为较大应用程序的一部分运行，因此我专注于较小的案例。

我能够在常规的 Shiny 应用程序中使用它，但是当我尝试模块化代码时，我什至无法让添加和删除按钮工作，所以我认为我对闪亮js和命名空间的使用在这里不太正确但我不太确定我做错了什么。代表：

使用常规的 Shiny 应用程序：

library(shiny)
library(shinydashboardPlus)
library(shinyjs)

# Define UI
ui <- fluidPage(
  useShinyjs(),  # Initialize shinyjs
  
 # Disable the Remove UI button initially
  fluidRow(div(id = "box1", box(
    fileInput("plotFile1", "Upload 1")
  ))),
  fluidRow(div(id = "box2", box(
    fileInput("plotFile2", "Upload 2")
  ))),
 actionButton("add", "Add"),
 actionButton("remove", "Remove last input"),
 plotOutput("seeplot")
)

# Server logic
server <- function(input, output, session) {
  
  added <- reactive({
    print(added_ui_count())
    added_ui_count()
    })
  # Reactive value to track the added UI elements
  added_ui_count <- reactiveVal(2)  # Initialize with 2
  
  # Create a condition for enabling/disabling the "Add UI" button
  enable_add_button <- reactive({
    added_ui_count() < 4  # Adjust the number as needed
  })
  
  enable_remove_button <- reactive({
    added_ui_count() > 2  # Adjust the number as needed
  })
  
  observeEvent(enable_add_button(), {
    # Enable or disable the "Add UI" button based on the condition
    if (enable_add_button()) {
      enable("add")  # Enable the button
    } else {
      disable("add")  # Disable the button
    }
  })
  
  observeEvent(enable_remove_button(), {
    # Enable or disable the "Remove UI" button based on the condition
    if (enable_remove_button()) {
      enable("remove")  # Enable the button
    } else {
      disable("remove")  # Disable the button
    }
  })
  
  observeEvent(input$add, {
    if (enable_add_button()) {
      # Increment the count of added UI elements
      added_ui_count(added_ui_count() + 1)
      
      # Generate a unique ID for the new UI element
      ui_id <- paste0("box", added_ui_count())
      
      insertUI(
        selector = "#add",
        where = "beforeBegin",
        ui = tags$div(
          id = ui_id,
          fluidRow(
            box(fileInput(paste0("plotFile", added_ui_count()), paste0("Upload ", added_ui_count())))
          )
        )
      )
    }
  })
  
  observeEvent(input$remove, {
    if (enable_remove_button()) {
      current_count <- added_ui_count()
      
      # Remove the UI element with the corresponding ID
      removeUI(
        selector = paste0("#box", current_count)
      )
      
      # Decrement the count of added UI elements
      added_ui_count(current_count - 1)
    }
  })
  
  loadData <- function(number){
    #should be reactive to the download buttons
    
    n <- number
    for(i in 1:n){
      eval(parse(text=paste0("req(input$plotFile",i,")")))
    }
  }
  
  seePlot <- reactive({
    loadData(added())
    plot(1:10)
  })

  output$seeplot <- renderPlot({
     seePlot()  
   })
  
}

# Complete app with UI and server components
shinyApp(ui, server)

有问题的模块化代码：

library(shiny)
library(shinydashboardPlus)
library(shinyjs)


# Define UI
inputUI <- function(id){
  ns <- NS(id) # Initialize shinyjs
  
  
  # Disable the Remove UI button initially
  tagList(
    fluidRow(div(id = ns("box1"), box(
      fileInput(ns("plotFile1"), "Upload 1")
    ))),
    fluidRow(div(id = ns("box2"), box(
      fileInput(ns("plotFile2"), "Upload 2")
    ))),
    actionButton(ns("add"), "Add"),
    actionButton(ns("remove"), "Remove last input")
  )
}

# Server logic
inputServer <- function(id) {
  library(shinyjs)
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    
    added <- reactive({
      print(added_ui_count())
      added_ui_count()
    })
    
    # Reactive value to track the added UI elements
    added_ui_count <- reactiveVal(2)  # Initialize with 2
    
    # Create a condition for enabling/disabling the "Add UI" button
    enable_add_button <- reactive({
      added_ui_count() < 4  # Adjust the number as needed
    })
    
    enable_remove_button <- reactive({
      added_ui_count() > 2  # Adjust the number as needed
    })
    
    observeEvent(enable_add_button(), {
      # Enable or disable the "Add UI" button based on the condition
      if (enable_add_button()) {
        enable("add")  # Enable the button
      } else {
        disable("add")  # Disable the button
      }
    })
    
    observeEvent(enable_remove_button(), {
      # Enable or disable the "Remove UI" button based on the condition
      if (enable_remove_button()) {
        enable("remove")  # Enable the button
      } else {
        disable("remove")  # Disable the button
      }
    })
    
    observeEvent(input$add, {
      if (enable_add_button()) {
        # Increment the count of added UI elements
        added_ui_count(added_ui_count() + 1)
        
        # Generate a unique ID for the new UI element
        ui_id <- paste0("box", added_ui_count())
        
        insertUI(
          selector = "#add",
          where = "beforeBegin",
          ui = tags$div(
            id = ui_id,
            fluidRow(
              box(fileInput(ns(paste0("plotFile", added_ui_count())), paste0("Upload ", added_ui_count())))
            )
          )
        )
      }
    })
    
    observeEvent(input$remove, {
      if (enable_remove_button()) {
        current_count <- added_ui_count()
        
        # Remove the UI element with the corresponding ID
        removeUI(
          selector = paste0("#box", current_count)
        )
        
        # Decrement the count of added UI elements
        added_ui_count(current_count - 1)
      }
    })
  })
}

ui <- fluidPage(
  useShinyjs(), # Initialize ShinyJS
  inputUI("module1"),
  # Other UI components
)

server <- function(input, output, session) {
  inputServer("module1")
  # Other server logic
}

# Complete app with UI and server components
shinyApp(ui, server)

蒂亚:)

Answer 1

我只需要更改 insertUI 选择器的命名空间！会留给别人的。

insertUI(
        selector = paste0("#",ns(add)),
        where = "afterEnd",
        ui = tags$div(
          id = ui_id,
          box(
            textInput(paste0("txt", added_ui_count()), "Insert some text")
          )
        )
      )