2015-03-03 4 views
2

Edit: Спасибо за помощь, были многочисленные проблемы с моим кодом, но главный вопрос, что мне не хватает Наблюдайте заявление, следующее решить проблему:Shiny: SelectInput подмножество основано на входных

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

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

Я хочу, чтобы у моего приложения «Блестящее» было два раскрывающихся списка 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) 

}) 

Любые предложения приветствуются, спасибо.

+0

Что это такое, что у вас возникли проблемы? Каков ваш конкретный вопрос? –

+0

Функция 'updateSelectInput()' позволяет вам обновлять параметры на основе логики на сервере. См. Http://shiny.rstudio.com/gallery/update-input-demo.html для примера кода. – GregF

ответ

0

В вашем коде были некоторые проблемы, например, с использованием Fixtu, который не ссылался ни на что. Кроме того, я думаю, что levels(), вероятно, лучший выбор, чем attributes() для получения уникальных значений в факторной переменной.

Я нахожу, что полезно использовать renderUI в файле server.R, если вы хотите, чтобы вход в один виджет контролировал ввод в другой. Затем вы можете вводить операторы return, чтобы предотвратить появление виджета, прежде чем он узнает, какие варианты предложить. Я делаю это, добавляя параметр «выбрать один», который заставляет следующий виджет даже не отображаться. Было бы лучше, если бы вы сделали defaultInput default равным 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') 
) 
)) 
Смежные вопросы