交互式菜单"观察"

时间:2014-09-13 03:22:48

标签: r shiny rcharts

我正在测试一个需要反应性SelectInput的Shinyapp,用户选择一个Transport,我需要刷新State字段,我希望它只显示具有所选Transport的状态。我有4种运输方式,International_Long(8个国家),International_Short(2个国家),National_Short(9个国家)和National_Long(所有23个国家)。

我的代码适用于DataTable,但它不适用于Plot !!

问题是当您选择“Plot”选项卡时,菜单的反应性会停止并显示任何传输的所有状态。

提前致谢!!

我的应用:https://luisotavio.shinyapps.io/rcharts2/

我的数据在这里:https://drive.google.com/file/d/0B1jMuJ4_u7e-elB4QV9WRkRKdEU/edit?usp=sharing

阅读数据

mydata<-read.delim("mydata.txt",sep="\t",dec=",",header=TRUE)

ui.R

require(rCharts)
options(RCHART_LIB = 'polycharts')

shinyUI(
  navbarPage("TEST",

                       tabPanel("Transport Survey",
                                pageWithSidebar(
                                  headerPanel('Transport Survey'),
                                  sidebarPanel(

                                    selectInput('Transport2', 'Select a Transport:',levels(droplevels(mydata$Transport)),selected=levels(droplevels(mydata$Transport))[1]
                                    ),
                                    selectInput('State2', 'Select a State:', levels(droplevels(mydata$State)),selected=levels(droplevels(mydata$State))[1]
                                    ),

                                    width = 3

                                  ),
                                  mainPanel(
                                    tabsetPanel(tabPanel("Table",dataTableOutput("mytable")),
                                    tabPanel("Plot",showOutput('myplot', 'polycharts')))
                                  )
                                )         
                       ))     

)   

server.R

library(shiny)
library(rjson)
library(rCharts)



options(RCHART_WIDTH = 800)

shinyServer(function(input, output,session) {

  observe({
    TRANSPORT = input$Transport2
    updateSelectInput(session, "State2", choices = levels(droplevels(mydata$State[mydata$Transport %in% TRANSPORT])),selected = levels(droplevels(mydata$State[mydata$Transport %in% TRANSPORT]))[1]
    )
  })



  selectedData <- reactive({
    TRANSPORT = input$Transport2
    STATE = input$State2
    mydata[mydata$Transport %in% TRANSPORT  & mydata$State %in% STATE,]

  })

  output$mytable = renderDataTable({
    selectedData()
  })

  output$myplot<- renderChart2({
    mydata2<-selectedData()

    p1<-rPlot(Value ~ Company, color = 'Company', data = mydata2, type = 'bar')
    p1$guides(
      color = list(
        numticks = length(levels(droplevels(mydata2$Company)))
      ),
      y = list(
        min = 0,
        max = 10
      )
    )
    return(p1)
  })
})

1 个答案:

答案 0 :(得分:1)

通过隔离input$Transport2

来更改您的被动反应
  selectedData <- reactive({
    TRANSPORT = isolate(input$Transport2)
    STATE = input$State2
    mydata[mydata$Transport %in% TRANSPORT  & mydata$State %in% STATE,]

  })

您的观察者已经在input$Transport2上引入了所需的依赖关系:

  observe({
    TRANSPORT = input$Transport2
    updateSelectInput(session, "State2", choices = levels(droplevels(mydata$State[mydata$Transport %in% TRANSPORT])),selected = levels(droplevels(mydata$State[mydata$Transport %in% TRANSPORT]))[1]
    )
  })

问题是reactive被懒惰地评估,并且observer被热切评估。

更好的解决方案是验证可用的数据:

  selectedData <- reactive({
    TRANSPORT = input$Transport2
    STATE = input$State2
    out <- mydata[mydata$Transport %in% TRANSPORT  & mydata$State %in% STATE,]
    validate(
      need(nrow(out) > 0, 'no data')
    )
    out
  })