动态添加闪亮的模块

Question

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

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

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

视觉上

我想知道一个动作按钮如何在 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)

交叉张贴在闪亮的组

Answer 1

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

基本上，如果你想从零添加一个模块（没有渲染函数），它必须通过 JavaScript。这分为三个步骤：

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

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

我的代码的重要部分发生在script. 在那里我创建了元素（您之前在函数中尝试过的sliderUI），然后调用ionRangeSlider, 使其看起来像一个真正的滑块，最后Shiny.unbindAll() / Shiny.bindAll()为相应的input变量创建一个绑定。

其他添加仅用于说明。

享受！

代码：

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))