动态添加闪亮的模块

Question

这不是关于使用renderUI创建模块。 随着我了解它的renderUI，你把一个占位符里面的UI功能，然后你写你的控制/小部件内的服务器功能。

模块分为两部分。一部分你必须添加到UI功能和另一部分使用callModule（）服务器功能。我有一个滑块模组。我想在点击“添加”动作按钮时将其添加到井上。如果有帮助，您可以考虑在点击按钮时多次重复模块。重复的模块应该都是独立的。

视觉

我想知道如何能动作按钮添加服务器功能里面的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) 

横贴在shiny-group

Answer 1

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

基本上，如果你想从无（无渲染功能）添加一个模块，它必须通过JavaScript。这有三种措施：

• 创建HTML元素
• 与ionrangeslider.js库
• 注册为滑块创建闪亮回调

如果从闪亮调用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)) 

Answer 2

OK我有复制的模块只一次的部分解决方案。这个想法是在actionButton观察者事件中添加模块UI和CallModule代码。

看起来您必须手动创建x uiOutput（）占位符来将模块复制x次。

我试着动态地添加另一个uiOutput（）insside renderUI（），但不起作用。

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

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

Answer 3

扩展另一个答案，什么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)