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

我的代码 UI：

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（）可能比使用因子变量获取唯一值的attributes（）更好。

我发现当你想要输入到一个小部件来控制输入到另一个小部件时，在server.R文件中使用renderUI是有帮助的。然后，您可以输入return语句，以防止窗口小部件在知道要提供的选项之前显示。我这样做是通过添加一个＆＃34;选择一个＆＃34;导致下一个小部件甚至不显示的选项。如果你可以将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')
  )
))

闪亮：基于输入的SelectInput子集

1 个答案: