R Shiny shinyjqui 不适用于动态服务器 UI答案

【问题标题】：R Shiny shinyjqui not working for dynamic server UIR Shiny shinyjqui 不适用于动态服务器 UI
【发布时间】：2018-11-26 02:35:26
【问题描述】：

我正在使用 shinyjqui 包，并相信以下代码应该创建可拖动的 UI/绘图。但是，在使用 Add UI 按钮添加 2+ 个以上的绘图后，返回的对象不可拖动。但是，当我使整个输出 main_output 可拖动时，我可以让它工作，但这不是我想要的。

有什么建议吗？

下面的小例子：

library(shinyjqui)

ui <- fluidPage(
    fluidRow(
        verticalLayout(
            uiOutput('main_output')
        )
    )
)
server <- function(input, output, session) {

    output$main_output <- renderUI({
        uiOutput('moduel_box')
    })

    render_moduels <- reactiveValues(input_types = NULL)

    observeEvent(input$add, {

        plot_type <- as.character(input$select)

        input_types <- render_moduels$input_types

        render_types <- unique(c(input_types, plot_type))

        render_moduels$input_types <- render_types

        output_types <<- c(render_moduels$input_types, 'moduel_box')

        output$main_output <- renderUI({

            lapply(output_types, uiOutput)

        })

        jqui_draggabled(paste0('#', output_types, sep=',', collapse = ''))

    })

    # jqui_draggable('#main_output') #This works though?

    output$moduel_box <- renderUI({
        box(width = '100%', 
            actionButton("add", "Add UI"),
            selectInput('select', 'please select', choices = c('histogram', 'line_plot'))
        )
    })
    output$histogram <- renderUI({

        box(
            renderPlot(hist(iris$Sepal.Length,30)),
            actionButton('rmv', 'remove')
        )
    })

    output$line_plot <- renderUI({

        box(
            renderPlot(plot(iris$Sepal.Length, type='l')),
            actionButton('rmv', 'remove')
        )
    })


}

shinyApp(ui, server)

【问题讨论】：

这是我在运行您的代码时得到的：Listening on http://127.0.0.1:5529 Warning: Error in box: plot.new has not been called yet [No stack trace available].
我刚刚自己运行了代码，它运行良好？

标签： jquery r shiny

【解决方案1】：

多个元素的选择器的格式应该是"#id1,#id2"而不是"#id1,#id2,"，所以jqui_draggabled的表达式应该改成jqui_draggabled(paste0('#', output_types, sep='', collapse = ','))。

为了让动态UI的逻辑更清晰，我建议在这里使用shiny::insertUI：

observeEvent(input$add, {    
  plot_type <- as.character(input$select)    
  input_types <- render_moduels$input_types    
  if (plot_type %in% input_types) return()
  render_moduels$input_types <- c(input_types, plot_type)
  insertUI(
    selector = "#moduel_box",
    where    = "beforeBegin",
    ui       = jqui_draggabled(uiOutput(plot_type))
  )
})

顺便说一句，box 函数来自shinydashboard 包，你应该在开始时加载它。

【讨论】：