帶有「觀察」的交互式菜單

我正在測試需要被動SelectInput的Shinyapp，用戶選擇一個Transport並且我需要刷新狀態字段，我想只顯示具有所選傳輸的狀態。我有4種運輸方式，International_Long（8個國家），International_Short（2個國家），National_Short（9個國家）和National_Long（所有23個國家）。帶有「觀察」的交互式菜單

我的代碼正在爲DataTable工作，但它不適用於劇情！

問題是當您選擇「繪圖」選項卡時，菜單的反應性會停止並顯示所有運輸狀態。

在此先感謝！

我的應用程序：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) 
    }) 
})

來源

2014-09-13 Luis Otavio Fernandes

這將真正幫助，如果你做，並不需要下載一個重複的例子，（更不用說安裝幾個包）。你可以從代碼中刪除部分（模擬一個小數據集而不是使用你的，用簡單的數據代替圖），並確保問題依然存在。也就是說，這裏似乎確實存在一個好奇的問題 – 2014-09-13 03:43:42

改變你的反應通過隔離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 
    })

來源

2014-09-13 10:18:30 jdharrison

非常感謝。一個多月來我試圖解決這個問題！ – 2014-09-13 11:06:06

例如，當您將國家：巴伊亞州更改爲國際時，您仍然會遇到輕微問題，因爲選擇巴伊亞州作爲第一選擇並且不會更改傳播。 – jdharrison 2014-09-13 11:09:38

已通過驗證數據可用的更好解決方案進行更新。 – jdharrison 2014-09-13 11:51:10

帶有「觀察」的交互式菜單

回答

相關問題