updateSelectInput在Shiny上非常缓慢

时间:2017-11-30 19:26:41

标签: r highcharts deployment shiny

我有一个在系统上运行完美的Shiny应用程序,但是当我部署它时,渲染图表大约需要2分钟。我认为这个问题是由于我有updateSelectInput但是如何让shinyapps部署的程序变得快?以下是ui.R和server.R。

ui.R

library(shiny)
library(highcharter)

shinyUI(fluidPage(

titlePanel("Art and R"),

sidebarLayout(
    sidebarPanel(
        selectInput(
            "colspa", "Color space", choices = list("RGB" = "rgb", "HSV" = "hsv", "LAB" = "lab", "LCH" = "lch"), selected = 1
        ),

        conditionalPanel(
            condition = "", selectInput(
                "colchoice", "Sub-choice", choices = list("Red" = "r", "Green" = "g", "Blue" = "b"), selected = 1
            )
        ),

        actionButton("btn", "Graph!")
    ),

    mainPanel(
        highchartOutput("distPlot", height = "500px")
    )
)
))

server.R

library(shiny)
library(broom)
library(dplyr)
library(highcharter)

art.data <<- read.csv(file = "data.csv", stringsAsFactors = FALSE)

shinyServer(function(input, output, session) {

observeEvent(input$colspa, {
    if(input$colspa == "rgb") {
        myChoices <- c("Red" = "r", "Green" = "g", "Blue" = "b")
    }
    else if (input$colspa == "hsv") {
        myChoices <- c("Hue" = "h", "Saturation" = "s", "Value" = "v")
    }
    else if (input$colspa == "lab") {
        myChoices <- c("Luminance" = "l", "Red-Green" = "a", "Yellow-Blue" = "b")
    }
    else {
        myChoices <- c("Lightness" = "l", "Chroma" = "c", "Hue" = "h")
    }
    updateSelectInput(session, "colchoice", choices = myChoices)
})

calculate <- eventReactive(input$btn, {
    str1 <<- paste0(input$colspa, ".", input$colchoice, ".median")
    modlss <- loess(art.data[[str1]] ~ year, data = art.data)
    fit <- augment(modlss) %>% arrange(year)

    hc <- highchart() %>% 
        hc_add_series(art.data, "scatter", hcaes(x = year, y = art.data[[str1]])) %>% 
        hc_add_theme(hc_theme_elementary()) %>%
        hc_add_series(fit, type = "spline", hcaes(x = year, y = .fitted), name = "Fit",
                      id = "fit")

    hc
})

output$distPlot <- renderHighchart({
    calculate()
})
})

以下是art.data数据框的一部分。

art.data snap

0 个答案:

没有答案