Shiny 闪亮应用程序：如何使用服务器变量创建新的输入小部件

我使用server.R中的函数session$sendCustomMessage成功地将变量从服务器返回到客户端

现在我想在ui.R客户端中使用这个leftChoices变量来创建一个小部件ChooseInput来创建一个[custom input control][1]，但这不起作用[1]：

我曾尝试使用Shiny.ChooseInput，但没有成功。脚本无法识别ChooseInput，我不知道如何使其工作。一些帮助。谢谢

这里是ui.R

source("chooser.R")
library(shiny)
shinyUI(fluidPage(sidebarLayout(sidebarPanel(
                            fileInput("file1", "Choose file to upload",
                                      accept = c('text/csv','.csv')
                                     )
                              ),
                  mainPanel(
                            tabPanel("Data",shiny::dataTableOutput("contents")),
                            tags$script(src = "initcsv.js"),
                            chooserInput("mychoice", "Available", "Selected ",
                    colnames(message.leftChoices) , c(), size = 10, multiple = TRUE
                                                 )
                            )
                 )
  )
)

这是ny服务器

library(shiny)
source("chooser.R")
shinyServer(function(input, output, session) {
  data <- reactive ({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.csv(inFile$datapath)

  })
  observe({
    session$sendCustomMessage(type = "MyDatasetUpdated", 
                              message = list(
                                leftChoices=colnames(data())
                                            )
                              )
  })
  output$contents <- renderDataTable(
    data(), options = list(iDisplayLength = 5)
  )
})

---

好的，代码不返回消息的主要原因是您在server.R文件中分配给leftChoices。假设您的工作目录中有chooser.R文件，下面将在侧栏中提供小部件，并提供一个带有当前“左选项”的弹出窗口。请注意，由于没有加载数据集时没有选择，我将

chooseInput

调用放在

renderUI

中。这样，就可以避免由于未加载数据集而产生的任何潜在错误。我已在守则内作出评论以澄清

用户界面

服务器.R

require(shiny)
shinyServer(function(input, output, session) {  
  data <- reactive ({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.csv(inFile$datapath)

  })

  # The renderUI call of chooserInput thereby making it dependent 
  # on a dataset existing
  output$choices <- renderUI({
    if (is.null(data())){
      return(NULL)
    }else{
      chooserInput("mychooser", "Available", "Selected",
                   colnames(data()), c(), size = 10, multiple = TRUE
      )
    }
  })

  # note the leftChoices assignment.  You must refer to 
  # mychooser$left for the left choices.  This identifier is
  # defined in the chooser.R file
  observe({
    session$sendCustomMessage(type = "MyDatasetUpdated", 
                              message = list(
                                leftChoices=input$mychooser$left
                              )
    )
  })

  output$contents <- renderDataTable(
    data(), options = list(iDisplayLength = 5)
  )
}
)

---

关于您提供的链接，我假设您正在尝试使用完全相同的选择器函数？如果是这样，您提供的内容不会显示

源代码（chooser.R）

。除非定义了该函数，否则程序将无法识别该函数。如果您可以使用

runApp

功能或同时提供ui.R和server.R提供一个完整的可复制示例，那么您可能会更容易获得帮助？谢谢Charles，我用代码更新了我的主菜。我在ui.R中有source（chooser.R）很多@charles我感谢你的帮助

require(shiny)
source("chooser.R")
shinyUI(fluidPage(
  sidebarLayout(sidebarPanel(
    fileInput("file1", "choose file to upload",
              accept = c('text/csv', '.csv')
    )

    # here is where the widget currently sits
    ,uiOutput("choices")
  ),

  mainPanel(
    tabPanel("Data", dataTableOutput("contents")),
    tags$script(src = "initcsv.js")
  )
  )
)
)

require(shiny)
shinyServer(function(input, output, session) {  
  data <- reactive ({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.csv(inFile$datapath)

  })

  # The renderUI call of chooserInput thereby making it dependent 
  # on a dataset existing
  output$choices <- renderUI({
    if (is.null(data())){
      return(NULL)
    }else{
      chooserInput("mychooser", "Available", "Selected",
                   colnames(data()), c(), size = 10, multiple = TRUE
      )
    }
  })

  # note the leftChoices assignment.  You must refer to 
  # mychooser$left for the left choices.  This identifier is
  # defined in the chooser.R file
  observe({
    session$sendCustomMessage(type = "MyDatasetUpdated", 
                              message = list(
                                leftChoices=input$mychooser$left
                              )
    )
  })

  output$contents <- renderDataTable(
    data(), options = list(iDisplayLength = 5)
  )
}
)

Shiny.addCustomMessageHandler("MyDatasetUpdated",
                              function(message) {
                                if  (message.leftChoices != null)
                                  //chooserInput("mychoice", "Available", "Selected ",
                                                 //c() , c(), size = 10, multiple = TRUE
                                                 //       ),
                                alert("Left Choices: " + JSON.stringify(message.leftChoices));
                              })