我正在测试一个需要反应性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)
})
})
答案 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
})