Shiny：renderUI反応性の問題

Question

Shiny Appのリアクティブ関数では、小さくても扱いにくい問題があります。

企業は企業が選択されたときにlineChartを表示し、「すべて」を選択した場合はすべての企業の棒グラフを表示するように設計されています。たとえば、

フィルタをカテゴリ1 = 3、カテゴリ1：2でフィルタする場合、会社内に残っている会社は4社だけですが、会社のドロップで会社Aを選択することができます

問題は、会社Aを選択すると、会社Aのラインチャートを1秒間表示してから、「すべて」に戻るという問題です。

私は、問題は、次の行であると思う：私は要求し

output$firm <- renderUI({ 
    selectInput("firm", "Filter by Firm:", 
      choices = c("All",as.character(unique(subset_data()$FIRM)))) 
    }) 

選択肢は「すべて」と「しっかりX」です。最初に会社XのlineChartを作成し、「すべて」の下にグラフを作成します。私はこうして選択肢から「すべて」を削除しようとしましたが、それは機能しませんでした。

ご迷惑をおかけして申し訳ありません。

は、ここで再現可能な例です ありがとう：

最初のサンプルデータを作成します。

set.seed(1) 
df <- data.frame(FIRM=rep(LETTERS[1:7],each=10), CATEG_1=rbinom(70,4,0.9),CATEG_2=rbinom(70,1,0.2),date=as.Date("2014-01-01")+1:10,y1=sample(1:100,70)) 

ShinyApp：

library(shiny) 
library(rCharts) 
library(doBy) 
library(plyr) 

shinyApp(ui = 
shinyUI(pageWithSidebar(

# Application title 
headerPanel("Example"), 

      sidebarPanel(
     uiOutput("firm"), 
     # selectInput("firm", "Filter by firm:", 
     # choices = unique(as.character(df))), 
     selectInput("categ_1", "Filter by Category 1:", 
        choices = c("All",unique(as.character(df$CATEG_1)))), 
     selectInput("date", "Filter by Date:", 
        choices = c("All","Last 28 Days","Last Quarter")), 
     selectInput("categ_2", "Filter by Category 2:", 
        choices = c("All",unique(as.character(df$CATEG_2))))   
     ), #sidebarPanel 

     mainPanel(
     h4("Example plot",style = "color:grey"), 
     showOutput("plot", "nvd3") 
     ) # mainPanel 
    ) #sidebarLayout 
) #shinyU 
, 
server = shinyServer(function(input, output, session) { 

subset_data <- reactive({df <- filter_data(df,input$firm, 
             input$date, 
             input$categ_1, 
             input$categ_2) 
         shiny::validate(need(!is.null(df),"No data to display")) 
         return(df)}) 

    output$firm <- renderUI({ 
    selectInput("firm", "Filter by Firm:", 
      choices = c("All",as.character(unique(subset_data()$FIRM)))) 
    })   

    output$plot<-renderChart2({ build_plot(subset_data()) }) 

############## 
#below are the functions used in the code 
############## 

# function for date subsetting 

    filter_date<-function(df,dateRange="All"){ 
    filt <- df 
    td <- max(as.Date(filt$date)) 
    if (dateRange=='Last 28 Days'){filt <-filt[filt$date>=(td-28),]} 
    if (dateRange=='Last Quarter'){filt <-filt[filt$date>=(td-84),]} 
    return(filt) 
    } # filter by date 

# function for data subsetting 

    filter_data<-function(df,firm=NULL,dateRange="All",categ_1=NULL,categ_2=NULL) 
    { 
    filt<-filter_date(df,dateRange) 

    if (!is.null(firm)) { 
    if(firm!='All') {filt <- filt[filt$FIRM==firm,]} 
    } 
    if (!is.null(categ_1)){ 
    if (categ_1!='All') {filt <- filt[filt$CATEG_1==categ_1,]} 
    } 
    if (!is.null(categ_2)) { 
    if (categ_2!='All') {filt <- filt[filt$CATEG_2==categ_2,]} 
    } 

    if(nrow(filt)==0) {filt <- NULL} 
    return(filt) 
    } # prepare data to be plotted 

# function to create plot 

    build_plot <- function(df) { 
    plotData<-df 
    # If 1 partner selected, time series is shown 
    if (length(as.character(unique(plotData$FIRM)))==1) { 

    tabledta<-summaryBy(y1~FIRM+date,data=plotData,FUN=sum,keep.names=TRUE) 

    filler = expand.grid(FIRM=as.character(unique(df$FIRM)), 
        date=seq(min(tabledta$date),max(tabledta$date),by='1 day')) 
    df = merge(filler, 
      tabledta, 
      by=c('date','FIRM'), 
      all.x=T) 
    df[is.na(df)]=0 
    p <- nPlot(y1 ~ date, group = 'FIRM', data = df, type = 'lineChart') 
    p$chart(margin=list(left=150)) 
    p$yAxis(showMaxMin = FALSE) 
    p$xAxis(tickFormat ="#!function(d) {return d3.time.format('%Y-%m-%d')(new Date(d * 24 * 60 * 60 * 1000));}!#") 
    p 
    } 
    # If "All" partners are selected, barchart of Top 5 is shown 
    else{ 
    SummaryTab<-aggregate(y1~FIRM,data=plotData,FUN=sum) 
    SummaryTab$rank=rank(SummaryTab$y1) 
    SummaryTab$rank[SummaryTab$rank>5]<-6 

    if (length(SummaryTab$rank)>5) { 
    #Top 5 partners in terms of y1 are shown 
    top5<-SummaryTab[SummaryTab$rank<=5,] 
    # other partners are collapsed, shown as 1 entry 

    others<-aggregate(y1~rank,data=SummaryTab,FUN=sum) 
    others<-others[others$rank==6,] 
    others$FIRM<-"Others" 

    # Create the summarytable to be plotted 
    plotData=rbind(top5,others)} 

    tabledta<-summaryBy(y1~FIRM,data=plotData,FUN=sum,keep.names=TRUE) 
    tabledta<-arrange(tabledta,y1) 
    # if(is.null(tabledta)) {print("Input is an empty string")} 

    p <- nPlot(y1 ~ FIRM,data = tabledta, type = 'multiBarHorizontalChart')  
    p$chart(margin=list(left=150)) 
    p$yAxis(showMaxMin = FALSE) 
    p 
    } 

    } 
    }) #shinyServer 
) 

Answer 1

問題は、出力$会社があなたのコード内に自己反応性であるということですそれは入力$ firmに依存するからです。

出力$ firm式は、入力$ formに依存するすべての反応式の再評価を自動的にトリガする入力$ firmのユーザーインターフェイスを生成します。そのような反応式の1つは、$ firm自身が出力します（subset_data（）を介して入力$ firmに依存する）ので、出力$ firmを呼び出すたびにその再帰的な再評価が行われます。私は確信して出力することを確認するために、いくつかの入力$ ...行を挿入

output$firm <- renderUI({ 
input$date 
input$categ_1 
input$categ_2 
selectInput("firm", "Filter by Firm:", 
     choices = c("All",as.character(unique(isolate(subset_data()$FIRM))))) 
}) 

注：あなたが必要なもの

はsubset_data（subset_data（の変化にトリガを防止します）の発現を、）単離することです$ firmはこれらのインプットの変化を誘発するでしょう。