r - Shiny :renderUI react 性问题

Question

我在 Shiny App 中遇到了一个看似很小但很棘手的响应式(Reactive)函数问题。

该应用程序旨在在选择公司时显示折线图，并在选择“全部”时显示所有公司的条形图。例如在选择时:

按类别 1 过滤 = 3 并按类别 1 过滤:用户界面中的 2，公司下拉列表中只剩下 4 家公司，然后我希望能够在公司下拉列表中选择公司 A 以获得公司 A 的折线图.

问题是，当我选择公司 A 时，它会显示公司 A 的折线图 1 秒，然后跳回“全部”。

我认为问题在于以下几行:

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

我要求的选择是“全部”和“公司 X”。它首先为 X 公司创建折线图，然后在“全部”下创建图表。因此，我试图从选择中删除“全部”，但这不起作用。

非常感谢任何帮助!
谢谢

这是一个可重现的示例:

首先创建示例数据:

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))

Shiny 应用:

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

问题是 output$firm 在您的代码中是自 react 的，因为它取决于 input$firm。

output$firm 表达式为 input$firm 生成一个用户界面，它会自动触发对所有依赖于 input$form 的响应式(Reactive)表达式的重新评估。其中一种响应式(Reactive)表达式是 output$firm 本身(它通过 subset_data() 依赖 input$firm)，因此每次调用 output$firm 都会导致其递归重新评估。

您需要隔离subset_data() 表达式，这将防止触发subset_data() 中的更改:

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)))))
})

请注意，我插入了几行 input$... 以确保 output$firm 会在这些输入发生任何变化时触发。