闪亮：基于输入的SelectInput子集

Question

编辑：感谢您的帮助，我的代码存在多个问题，但主要问题是我缺少一个Observe语句，以下内容解决了该问题：

 get_ddf <- reactive({
      filter(poskick, Name == input$player)
    })

  observe({
    updateSelectInput(session, 'fixture', choices   =levels(droplevels(get_ddf()$Event)) )
  })

我希望我的Shiny应用程序具有两个selectInput下拉菜单，第一个选择一个名称，第二个从一个人参与的事件中进行选择，基于第一个输入创建的子集。 样本数据：

 PLID   Name        x_coord y_coord x_coord_end y_coord_end action  Event
 7046   Sample Name1    35    37      34          25          4    23/07/11
 7046   Sample Name1    21    11       0           0          4    23/07/11
 7046   Sample Name1    49    60      56           8          4    23/07/11
 7046   Sample Name1    46    56      72          34          4    23/07/11
 7046   Sample Name1    58    49      24          58          4    23/07/11
 7046   Sample Name1    87    57      42          52          4    23/07/11
 7046   Sample Name1    14    58      18          37          4    23/07/11
 7140   Sample Name2    38    14      11          11          4    23/07/11
 7140   Sample Name2    11    11      11          11          4    23/07/11
 7140   Sample Name2    56    8       56           8          4    23/07/11

我的代码界面：

library(shiny)
library(ggplot2)


poskick<-read.csv('poskicks.csv')


shinyUI(pageWithSidebar(

  headerPanel("position map"),

  sidebarPanel(



selectInput('player', 'Player', choices= attributes(poskick$Name)),
selectInput('fixture', 'Match', choices= attributes(firstsub()$Fixtu))

),

mainPanel(
  plotOutput('plot')
)
  ))

服务器代码：

library(shiny)
library(ggplot2)

poskick<-read.csv('poskicks.csv')



shinyServer(function(input, output) {


  firstsub <- reactive({
     subset(poskick, poskick$Name %in% input$player)
     })

  secondsub <- reactive({
     subset(poskick, poskick$Fixtu %in% input$fixture & poskick$Name %in%    input$player )
    })


  output$plot <- renderPlot({
    p <- ggplot(data = secondsub()) + geom_segment(aes(x = x_coord, y =   y_coord, xend = x_coord_end, yend = y_coord_end))
    print(p)    }, height=700)

})

任何建议表示赞赏，谢谢。

Answer 1

您的代码中存在一些问题，例如使用Fixtu，但未涉及任何内容。 另外，我认为对于获得因子变量中的唯一值，对于属性唯一值，levels（）可能比attribute（）更好。

我发现，当您希望一个窗口小部件中的输入控制另一个窗口小部件的输入时，在server.R文件中使用renderUI会很有帮助。 然后，您可以放入return语句，以防止小部件在知道要提供的选项之前甚至无法显示。 为此，我添加了一个“选择一个”选项，该选项使下一个小部件甚至不显示。 如果可以将selectInput默认设置为NULL，那会更好，但这不是一个选择。

这是我所做的：

server.R：

library(shiny)
library(ggplot2)

poskick<-read.csv('poskicks.csv')

shinyServer(function(input, output) {

  output$Box1 = renderUI(selectInput('player', 
                                     'Player', 
                                     c(levels(poskick$Name),"pick one"),
                                     "pick one")
  )

  output$Box2 = renderUI(
    if (is.null(input$player) || input$player == "pick one"){return() 
    }else selectInput('fixture', 
                      'Match', 
                      c(levels(poskick$Event[which(poskick$Name == input$player)]),"pick one"),
                      "pick one")
    )

  subdata1 = reactive(poskick[which(poskick$Name == input$player),])
  subdata2 = reactive(subdata1()[which(subdata1()$Event == input$fixture),])

  output$plot <- renderPlot({
    if (is.null(input$player) || is.null(input$fixture)){return()
    } else if(input$player == "pick one" || input$fixture == "pick one") { return()
    } else p <- ggplot(data = subdata2()) + geom_segment(aes(x = x_coord, y =   y_coord, xend = x_coord_end, yend = y_coord_end))
    print(p)    })

})

ui.R：

library(shiny)
library(ggplot2)
shinyUI(pageWithSidebar(
  headerPanel("position map"),
  sidebarPanel(uiOutput("Box1"),uiOutput("Box2")),
  mainPanel(plotOutput('plot')
  )
))