動態添加閃亮的模塊

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)