2014-12-31 22 views
5

Tôi có vấn đề dường như nhỏ nhưng phức tạp với chức năng phản ứng trong Ứng dụng sáng bóng.Sáng bóng: các vấn đề với phản ứng renderUI

Ứng dụng được thiết kế để hiển thị lineChart khi một công ty được chọn và hiển thị biểu đồ thanh của tất cả các công ty khi "Tất cả" được chọn. Ví dụ khi chọn:

Lọc theo danh mục 1 = 3 và lọc theo danh mục 1: 2 trong ui, chỉ 4 công ty còn lại trong các công ty thả xuống và tôi muốn có thể chọn công ty A trong các công ty thả xuống để có biểu đồ đường cho công ty A.

Vấn đề là khi tôi chọn công ty A, nó sẽ hiển thị lineChart cho công ty A trong 1 giây và sau đó nhảy trở lại "Tất cả".

Tôi nghĩ vấn đề nằm với dòng sau:

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

Các lựa chọn tôi yêu cầu là "Tất cả" và "công ty X". Đầu tiên nó tạo ra lineChart cho công ty X và sau đó tạo biểu đồ dưới "All". Do đó, tôi đã cố gắng loại bỏ "Tất cả" khỏi các lựa chọn, nhưng điều đó không hiệu quả.

Bất kỳ trợ giúp nào được đánh giá cao! Cảm ơn

Dưới đây là một ví dụ tái sản xuất:

Tạo dữ liệu mẫu đầu tiên:

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 
) 

Trả lời

5

Vấn đề là đầu ra $ công ty là tự phản ứng trong mã của bạn , bởi vì nó phụ thuộc vào công ty đầu vào $.

Biểu thức $ output đầu ra tạo giao diện người dùng cho công ty $ đầu vào, tự động kích hoạt đánh giá lại tất cả các biểu thức phản ứng phụ thuộc vào biểu mẫu $ đầu vào. Một trong những biểu thức phản ứng như vậy là đầu ra $ công ty chính nó (nó phụ thuộc vào đầu vào $ công ty thông qua subset_data()), do đó, mọi cuộc gọi đến đầu ra $ công ty sẽ gây ra đệ quy của nó đánh giá lại.

gì bạn cần là để cô lập các biểu subset_data(), mà sẽ ngăn chặn kích hoạt vào những thay đổi trong 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))))) 
}) 

Lưu ý rằng tôi chèn nhiều đầu vào $ ... dòng để đảm bảo rằng sản lượng $ firm sẽ kích hoạt khi có bất kỳ thay đổi nào trong các đầu vào này.

+0

Cảm ơn bạn, hoạt động như một sự quyến rũ! – TinaW

Các vấn đề liên quan