r - shinyapp.io 应用程序的性能不如本地闪亮应用程序

Question

下面是我的实际应用程序的简化版本，但它捕获了我遇到的问题。当我在本地运行应用程序时，我没有任何问题：绘图在应用程序启动时加载并且仅在按下操作按钮时更新。日期范围输入也如我所料动态更新。

问题：当我运行部署的应用程序https://notsospecial.shinyapps.io/shinyTest/时，它没有按预期工作：

Chrome：启动时不加载绘图。单击“提交”后，所有图都“变灰”

Firefox：情节在启动时加载。单击“提交”后，所有图都“变灰”

我该如何解决？谢谢！

library(shiny); library(tidyverse); library(tidyquant); library(formattable); library(lubridate);

#create data
shinyData <- expand.grid(date = seq.Date(as.Date("2019-03-01"),Sys.Date(),by="days"),SITEID = LETTERS[1:2]) %>%
    mutate( 
        mon.day = format(date,"%B-%d"),
        month = month(date,label = T,abbr=T),
        year = as.factor(year(date))) 
set.seed(1)
shinyData$Customers[shinyData$year==2019&shinyData$SITEID=="A"] = rnorm(nrow(shinyData[shinyData$year==2019&shinyData$SITEID=="A",]),50,7)
shinyData$Customers[shinyData$year==2019&shinyData$SITEID=="B"] = rnorm(nrow(shinyData[shinyData$year==2019&shinyData$SITEID=="B",]),200,17)
shinyData$Customers[shinyData$year==2020&shinyData$SITEID=="A"] = rnorm(nrow(shinyData[shinyData$year==2020&shinyData$SITEID=="A",]),35,10)
shinyData$Customers[shinyData$year==2020&shinyData$SITEID=="B"] = rnorm(nrow(shinyData[shinyData$year==2020&shinyData$SITEID=="B",]),100,12)
shinyData$Charges = shinyData$Customers*rnorm(nrow(shinyData),50,10)

#date range start and end
dateRangMax <- max(shinyData$date,na.rm=T)-1
dateRangMin <-dateRangMax-15
altEndDate= as.Date("2020-04-30")

ui = fluidPage(

               titlePanel("Shiny Test App"),

               fluidRow(
                   column(3,
                          wellPanel(
                              selectInput(inputId = "chartType",
                                          label = "Choose a Chart:",
                                          selected="Customers",
                                          choices = c("Customers","Charges")
                              ),
                              selectInput(inputId = "siteid",
                                          label = "Choose a Site:",
                                          selected = "A",
                                          choices = unique(shinyData$SITEID)),
                              dateRangeInput('dateRangeCal', "Input Date Range:",start = dateRangMin,end=dateRangMax, format = "mm/dd"),
                              checkboxGroupInput(
                                  inputId = "stats",
                                  label = "Display Stats",
                                  selected = c("Mean","Standard Error"),
                                  inline = T,
                                  choices = c("Mean","Standard Error","3-Day Moving Avg")
                              ),
                              actionButton("redraw","Submit")
                          )
                   ),
                   column(9,
                          tabsetPanel(
                              tabPanel("Plot",plotOutput(outputId = "CustomersPlot"))
                          )
                   )
               ),
               conditionalPanel(condition = "input.tabs == 'Plot",
                                fluidRow(
                                    column(3,
                                           plotOutput(outputId = "PieChart")
                                    ),
                                    column(9,
                                           plotOutput(outputId = "pctDrop")
                                    )
                                )  
               ),
)

server = function(input, output,session) {

    charts <- tribble(
        ~chartName, ~var, ~y_label, ~sig.fig,
        "Customers", "Customers", "Customers", 0,
        "Charges", "Charges", "Charges", 0
    )

    chartVar =eventReactive(input$chartType,{charts$var[charts$chartName==input$chartType]})

    y_label = eventReactive(chartVar(),{charts$y_label[charts$var==chartVar()]})

    observeEvent(input$chartType, {
        endDate = if_else(input$chartType %in% c("RVU","Charges","Charges/Staffed Hrs","RVU/Staffed Hrs","Acuity"),altEndDate, dateRangMax)
        startDate = endDate-days(14)
        updateDateRangeInput(session = session, inputId = 'dateRangeCal',
                             label = 'Date range input:',
                             start = startDate,
                             end = endDate
        )
    })

    displayData <- eventReactive(input$redraw|input$redraw==0, {

        shinyData %>%
            dplyr::filter(SITEID==input$siteid) %>%
            select(-SITEID) %>%
            dplyr::filter(date>=input$dateRangeCal[1]&date<=input$dateRangeCal[2]|date>=input$dateRangeCal[1]-years(1)&date<=input$dateRangeCal[2]-years(1)) %>%
            ungroup() 
    })

    CustomersPlotRct <- eventReactive(input$redraw|input$redraw==0,{
        means = displayData() %>%
            group_by(year) %>%
            summarise_all(mean)

        p = ggplot(displayData(),aes(x=mon.day,y=!!sym(chartVar()),group=year,color=year))+
            geom_point(size=3)+
            geom_line(alpha=0.3,size=1.5)+
            theme(axis.text.x = element_text(angle = 45,hjust=1.1))+
            scale_y_continuous(labels = scales::number_format(accuracy = 1))+
            labs(title= paste0("YoY ",y_label()," - ",input$siteid),x="Date",y=y_label())+
            guides(size=F)

        if (any(input$stats=="Mean")) {
            p=p+stat_smooth(method="lm", formula=y~1, se=(any(input$stats=="Standard Error")))+
                geom_text(aes(x = 3, y = !!sym(chartVar()), label = paste0("Mean = ",comma(!!sym(chartVar()), 0)), color = year,size=5,vjust=-3), data = means)
        }
        if (any(input$stats=="3-Day Moving Avg")) {
            p=p+geom_ma(ma_fun = SMA,n=3,linetype=5,size=1.5,alpha=0.7)
        }
        p
    })

    output$CustomersPlot <- renderPlot({
        CustomersPlotRct()
    })

    PieChartRct <- eventReactive(input$redraw|input$redraw==0,{
        pieData = displayData() %>%
            ungroup() %>%
            select(year,Customers,Charges) %>%
            group_by(year) %>%
            summarise_all(funs(sum))

        pieCol = pieData %>% pull(!!sym(chartVar()))

        ggplot(pieData,aes(x="",fill=year,group=factor(year),y=!!sym(chartVar())))+
            geom_col(width = 1)+
            coord_polar("y")+
            geom_text(aes(label = paste0(comma(!!sym(chartVar()),digits = 0) , " (", round(!!sym(chartVar())/sum(pieCol)*100,0),"%)")),
                      position = position_stack(vjust = 0.5)) +
            theme_classic() +
            theme(axis.text = element_blank(),
                  axis.ticks = element_blank(),
                  line = element_blank(),
                  panel.grid  = element_blank())+
            labs(fill = "Year",
                 x = NULL,
                 y = NULL,
                 title = "Cumulative Over Date Range:")
    })

    output$PieChart = renderPlot({
        PieChartRct()
    })

    pctDropRct <- eventReactive(input$redraw|input$redraw==0,{
        pctDropData = displayData() %>%
            rename( "vr" = chartVar() ) %>%
            group_by(mon.day) %>%
            dplyr::filter(length(vr)==2) %>%
            summarise(
                pct.chg = round((vr[year==2020]-vr[year==2019])/vr[year==2019]*100,1)
            )

        p = ggplot(pctDropData,aes(x=mon.day,y=pct.chg,group=1))+
            geom_point(stat='summary', fun.y=sum,size=3,color="green4") +
            stat_summary(fun.y=sum, geom="line",alpha=0.3,size=1.5,color="green4")+
            theme(axis.text.x = element_text(angle = 45,hjust=1.1))+
            labs(title= paste0("YoY ",y_label()," % Change - ",input$siteid),x="Date",y="% Change")
        if (any(input$stats=="Mean")) {
            p=p+stat_smooth(method="lm", formula=y~1, se=(any(input$stats=="Standard Error")),color="green4")+
                annotate("text",x = 4, y = mean(pctDropData$pct.chg) , label = paste0("Mean = ",round(mean(pctDropData$pct.chg),0),"%"),size=5,vjust=-3)
        }
        if (any(input$stats=="3-Day Moving Avg")) {
            p=p+geom_ma(ma_fun = SMA,n=3,linetype=5,size=1.5,alpha=0.7,color="green4")
        }
        p
    })

    output$pctDrop = renderPlot({
        pctDropRct()
    })
}    

shinyApp(ui,server)

标签： rshinyshinyapps

Answer 1

上面代码的问题是在条件面板中检查时没有广播 tabsetPanel id。更改此代码段为我修复了它：

 column(9,
                          tabsetPanel(id="tabs",
                              tabPanel("plot","Plot",plotOutput(outputId = "CustomersPlot"))
                          )
                   )
               ),
               conditionalPanel(condition = "input.tabs == 'plot",