在shiny中动态添加模块

这与使用 renderUI 创建模块无关。 据我了解，使用 renderUI，您可以在 UI 函数中放置一个占位符，然后在服务器函数中编写控件/小部件。

模块分为两部分。您必须使用 callModule() 将一部分添加到 UI 函数，将另一部分添加到服务器函数。

我有一个滑块模块。我想在单击“添加”操作按钮时将其添加到井面板中。如果它有帮助，您可以考虑在单击按钮时多次复制模块。重复的模块应该都是独立的。

Visually

我想知道操作按钮如何在 UI 函数内添加模块的 UI 部分，在服务器函数内添加服务器部分。

#Dynamically adding modules
library(shiny)

#slider module ------------------------
sliderUI <- function(id) {
  ns <- NS(id)
  sliderInput(ns("bins"), "Number of Bins:", min = 1, max = 5, value = 3)
}

slider <- function(input, output, session) {}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("slider"),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
  hr())
    )
  )
)

server <- function(input, output, session) {
   observeEvent(input$addSliderModule, {
      #what goes here
   })
}

shinyApp(ui, server)

交叉发布于闪亮组

好的，这是您的解决方案。我很高兴我找到了一个，因为我花了几个小时。

基本上，如果您想从无到有（无渲染函数）添加模块，则必须通过 JavaScript。这分为三个步骤：

• 创建 HTML 元素
• 使用 ionrangeslider.js 库将其注册为滑块
• 创建闪亮的回调

如果你打电话inputSlider来自 Shiny，这三个都为您完成。但如果没有它，我们就必须独自完成这些事情。好事，如果你知道该怎么做，这并不难。

我的代码的重要部分发生在script。我在那里创建了元素（您之前在函数中尝试过的内容）sliderUI），然后致电ionRangeSlider，让它看起来像一个真正的滑块，最后，Shiny.unbindAll() / Shiny.bindAll()创建对应的绑定input多变的。

其他添加仅用于说明。

Enjoy!

Code:

library(shiny)

  ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      tags$div(
        sliderInput("slider-bins", "Number of Bins:", min = 1, max = 5, value = 3)
      ),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(id = "target",
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
      hr(),

      tags$script('
        Shiny.addCustomMessageHandler("createSlider",
          function(ID) {
            Shiny.unbindAll();

            var targetContainer = document.getElementById("target");

            var container = document.createElement("div");
            container.setAttribute("class", "form-group shiny-input-container");

            var label = document.createElement("label");
            label.setAttribute("class", "control-label");
            label.setAttribute("for", "ID");

            var labelText = document.createTextNode("Number of Bins");

            label.appendChild(labelText);
            container.appendChild(label);

            var input = document.createElement("input");
            input.setAttribute("class", "js-range-slider");
            input.setAttribute("id", ID);
            input.setAttribute("data-min", "1");
            input.setAttribute("data-max", "5");
            input.setAttribute("data-from", "3");
            input.setAttribute("data-step", "1");
            input.setAttribute("data-grid", "true");
            input.setAttribute("data-grid-num", "4");
            input.setAttribute("data-grid-snap", "false");
            input.setAttribute("data-prettify-separator", ",");
            input.setAttribute("data-keyboard", "true");
            input.setAttribute("data-keyboard-step", "25");
            input.setAttribute("data-drag-interval", "true");
            input.setAttribute("data-data-type", "number");

            container.appendChild(input);

            targetContainer.appendChild(container);

            $("#" + ID).ionRangeSlider();

            Shiny.bindAll();
          }
        );'
      )
    )),
    column(width = 4, wellPanel(
      uiOutput("response") 
    ))
  )
)

server <- function(input, output, session) {
  observeEvent(input$addSliderModule, {
    session$sendCustomMessage(type = "createSlider", message = paste0("slider-", input$addSliderModule))
  })
  output$response <- renderUI({
    if(input$addSliderModule >0){

      lapply(1:input$addSliderModule, function(x){

        output[[paste("response", x)]] <- renderText({paste("Value of slider", x, ":", input[[paste0("slider-", x)]])})

        textOutput(paste("response", x))
      })
    }
  })
}

runApp(shinyApp(ui, server))