时间戳

首页 > 解决方案 > R Shiny shinyjqui 不适用于动态服务器 UI

jquery - R Shiny shinyjqui 不适用于动态服务器 UI

问题描述

我正在使用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)

标签： jqueryrshiny

解决方案

多个元素的选择器的格式应该是"#id1,#id2"but 不是"#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包，您应该在开始时加载它。

推荐阅读