在shiny中动态添加模块

Question

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

模块分为两个部分。您需要将其中一部分添加到UI函数中，另一部分使用callModule()添加到服务器函数中。

我有一个滑块模块。当单击“添加”操作按钮时，我想将其添加到wellpanel中。如果有帮助，您可以将复制模块想象为每次单击按钮时都会重复多次。复制的模块应该都是独立的。

外观上：

我想知道如何在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)

在闪亮小组上交叉发布

- MySchizoBuddy

---

我无法理解您实际想要做什么。您首先想在一个 Well 中呈现一个 Slider，并在按钮单击时将其位置更改为另一个 Well 吗？您的服务器中没有任何代码来响应您的按钮吗？而且为什么 renderUI 不是您要寻找的东西呢？ - K. Rohde

使用renderUI，您可以在UI函数中放置占位符，然后在服务器函数中编写控件/小部件。模块分为两个部分。一个部分必须添加到UI函数中，另一个部分必须使用callModule添加到服务器函数中。如果有帮助的话，您可以想象在单击按钮时将模块复制多次。复制的模块应该都是独立的。 - MySchizoBuddy

我已经改进了问题并通过视觉更好地解释了我的意图。 - MySchizoBuddy

Answer 1

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

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

- 创建HTML元素 - 使用ionrangeslider.js库将其注册为滑块 - 创建Shiny回调

如果您从Shiny中调用inputSlider，则三个步骤都会为您完成。但是，如果没有它，我们必须自己完成这些事情。好在，如果您知道该做什么，它并不难。

我的代码的重要部分发生在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))

- K. Rohde

---

这个解决方案是可行的，但它现在只与滑块模块绑定，因为你正在使用ionrangeslider.js。应该有一种通用的方式，可以添加/复制任何模块。虽然我不反对使用渲染函数。 - MySchizoBuddy

@MySchizoBuddy 我不认为有任何模块的短函数，因为在闪亮的源代码中肯定没有。但是所有模块将以大致相同的方式创建，这使得此示例至少有点通用。如果您需要另一个示例，请查看我发布了类似内容的问题这里。在此示例中，我插入了一个带有JavaScript的工作plotOutput。 - K. Rohde

Answer 2

另一个回答是在扩展 MySchizoBuddy的基础上进行的。它可能也不完全令人满意，但它有效。

我添加了一个脚本，简单地将动态创建器中的所有元素移动到目标div中。这样，动态创建元素就不会擦除先前创建的元素。

#Dynamically adding modules
library(shiny)

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

slider <- function(input, output, session) {
  output$textBins <- renderText({
    input$bins
  })
}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("originalSlider"),
      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(),
      tags$script(HTML('
        Shiny.addCustomMessageHandler("moveModule", function(message) {
          var source = document.getElementById("addModule").childNodes;
          var target = document.getElementById("target");
          for (var i = 0; i < source.length; i++) {
            target.appendChild(source[i]);
          }
        })
      ')),
      tags$div(id = "target"),
      uiOutput("addModule"))
    )
  )
)

server <- function(input, output, session) {
  #server code for the original module
  callModule(slider, "originalSlider")

  #Here we add the UI and callModule of the duplicate module
  observeEvent(input$addSliderModule, {

    session$sendCustomMessage(type = "moveModule", message = "Something")

    duplicateSliderid <- paste0("duplicateSlider", input$addSliderModule)

    output$addModule <- renderUI({
      sliderUI(duplicateSliderid)
    })
    callModule(slider, duplicateSliderid)
  })
}

shinyApp(ui, server)

- K. Rohde

Answer 3

我认为您会发现这个解决方案更通用。首先，它使用InsertUI而不是JavaScript（自上次回复以来引入了InsertUI）。然而，我还没有找到任何人在其他反应性代码中介绍如何使用callModule产生的相应对象。请注意，renderText内部的部分可能需要根据您的目标进行非常不同的处理（例如，可能使用for语句）。

# user interface module----
numberInput = function(id, label = "Numeric input"){
  ns = NS(id)

  numericInput(ns("term"), label, value = 0)
}

#Module server logic
number = function(input, output, session){
  #just returns the expression for a reactive containing whatever you want (the relevant numericInput in this case)
  num_out = reactive({input$term})
  return(num_out)
}

# User interface ----
ui = fluidPage(
  titlePanel("Inserting UI and Callable Reactive using Modules"),
  actionButton('insertBtn', 'Insert module'),
  textOutput("total")
)

# Server logic
server = function(input, output, session) {
  num_values = reactiveValues()# this is basically a list that can store reactive expressions
  observeEvent(ignoreNULL = FALSE, #simple way of running module initially by allowing to run when button is at 0
               input$insertBtn, {
    btn = as.character(input$insertBtn + 1)#so first module will be labeled #1
    insertUI(
      selector = "#insertBtn",
      where = "afterEnd",
      ui = numberInput(btn,paste0('term #', btn))
    )
    num_values[[btn]] = callModule(number, btn)#stores the reactive expression from the call of the module related to the input inserted in a corresponding element of num_Values
  })
  output$total = renderText({
    num_vector = sapply(num_values, function(num_out){num_out()}) #calls each reactive expression in num_values (defined in the module) to get each input$term
    sum(num_vector) #sums all the numericInputs
  })
}

# Run the app
shinyApp(ui, server)

- Grant Langdon

Answer 4

好的，我有一个部分解决方案，只复制模块一次。想法是将模块UI和CallModule代码添加到actionButton观察器事件中。

看起来你必须手动创建x uiOutput()占位符来多次复制模块。

我尝试在renderUI()中动态添加另一个uiOutput()，但那样不起作用。

这里是复制它一次的代码。

#Dynamically adding modules
library(shiny)

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

slider <- function(input, output, session) {
  output$textBins <- renderText({
    input$bins
  })
}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("originalSlider"),
      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(),
      uiOutput("addModule"))
    )
  )
)

server <- function(input, output, session) {
  #server code for the original module
  callModule(slider, "originalSlider")

  #Here we add the UI and callModule of the duplicate module
  observeEvent(input$addSliderModule, {
    duplicateSliderid <- paste0("duplicateSlider", input$addSliderModule)

    output$addModule <- renderUI({
      sliderUI(duplicateSliderid)
    })
    callModule(slider, duplicateSliderid)

  })
}

shinyApp(ui, server)

- MySchizoBuddy

---

Joe Cheng在gist中发布了对这个想法的改进，可以添加任意数量的滑块（通常的模块），但存在一个问题，即添加滑块将重置所有先前滑块的默认值。他提到Shiny开发人员正在研究appendUI函数以使此过程更容易。他的评论在此供参考https://groups.google.com/d/msg/shiny-discuss/BMZR3_MH0S4/ZZp5hdIGAwAJ - MySchizoBuddy

嗨，这是一个非常鼓舞人心的问题。我尝试扩展您自己给出的答案，以便它可以创建动态数量的模块。 - K. Rohde