如何在Shiny

时间:2018-11-13 14:26:17

标签: r shiny

我正在使用ShinyDND软件包制作具有拖放功能的应用程序。我想将输入中的列表作为dragSetUI的参数传递,该函数需要在ui.R中运行。我尝试了renderUI和uiOutput,它几乎可以正常工作,但是拖动的元素无法放在放置区域中。在下面的示例中可以看到,非反应性选择就像魅力一样起作用。我尝试创建一个反应性对象以及文本输出,但是找不到关于如何在ui.R中引用这些对象的文档。通常,在Output中,将output $ x称为“ x”,但是在这里,如果我在引号之间添加任何内容,它将读取为字符串。我真的很坚持。

library(shiny)
library(shinyDND)

nonreactive_choices<-as.list(c("a","b","c"))

ui <- shinyUI(
  mainPanel(
    textInput("choices","Put here a,b,c:"),
  dragSetUI("drag", textval = "reactive_choices"),
  dragSetUI("drag", textval = "choice_rv"),
  textOutput("reactive_choices"),
  dragSetUI("drag", textval = nonreactive_choices),
  dropUI("drop")
  )
)

server = shinyServer(function(input, output,session) {

   output$reactive_choices<-reactive({
     strsplit(input$choices,",")
     })

   observe({
     chlist<-strsplit(input$choices,",")
     choice_rv<-reactiveVal(chlist)
   })

})

# Run the application 
shinyApp(ui = ui, server = server)

2 个答案:

答案 0 :(得分:0)

@ismirsehregal的评论帮助我找到了解决方案:shinyjqui可以用于我的目的,它似乎可以在renderUI中使用。这是经过编辑的代码,完全可以满足我的需求。

library(shiny)
library(shinyjqui)


ui <- fluidPage(
  textInput("choices","Put here a,b,c:"),
  uiOutput("reactiveselect"),
  orderInput(inputId = 'drop', label = 'Reactive drop', items = NULL,placeholder = "drop here..."),
  verbatimTextOutput("droppedorder")
)


server <- function(input, output) {



  output$reactiveselect <- renderUI({
    req(input$choices)
    reactiveitems<- unlist(strsplit(input$choices,","))
    orderInput("groupstochoose", "groups to choose from:", connect='drop',items=reactiveitems)

  })

  output$droppedorder<-
    renderPrint({input$drop_order})

}



shinyApp(ui, server)

答案 1 :(得分:0)

让我们看看为什么renderUI方法不适用于shinyDND。使用shinyDND的应用程序已链接到dragndrop.js文件夹中的shinyDND文件。在此文件中,您可以看到:

$(document).ready(function(){
  ......
  $(".dragelement").on("dragstart",function(e){
    e.originalEvent.dataTransfer.setData("Text",e.target.id);
  });
  ......
});

这定义了开始拖动时对具有类dragelement的元素执行的操作,并且定义了在文档准备就绪时执行的操作。 dragSetUI创建此类元素。

dragSetUI中使用renderUI时,这将创建类dragelement的新元素。但是在$(document).ready中对此类元素定义的操作对这些新元素无效,因为此操作是在文档准备好之后,在renderUI生效之前定义的。

一种解决方案是在dragstart内定义事件renderUI的操作。这有效:

library(shiny)
library(shinyDND)

nonreactive_choices<-as.list(c("a","b","c"))

ui <- shinyUI(
  mainPanel(
    textInput("choices","Put here d,e,f:"),
    dragSetUI("drag", textval = nonreactive_choices),
    uiOutput("dragset"),
    dropUI("drop")
  )
)

server = shinyServer(function(input, output,session) {

  reactive_choices <- reactive({
    strsplit(input$choices,",")[[1]]
  })

  output$dragset <- renderUI({
    tagList(
      dragSetUI("drag2", textval = as.list(reactive_choices())),
      tags$script('$(".dragelement").on("dragstart",function(e){
        e.originalEvent.dataTransfer.setData("Text",e.target.id);
      });'
      )
    )
  }) 
})

# Run the application 
shinyApp(ui = ui, server = server)