Произведите выходные данные 1 автоматически, если кнопка действия не нажата, или иначе произведите выходные данные 2 R Сияющий - PullRequest
0 голосов
/ 19 апреля 2020

Я создаю панель управления Shiny, которая имеет два входа (input $ data и input $ year) с двумя выходами (verbatimTextOutput и dygraphOutput) вместе с кнопкой действия (input $ subset), которая позволяет пользователю подмножество input $ data с помощью input $ year (checkboxGroupInput). В настоящее время я использую эту кнопку подмножества для создания выходных данных, но в то же время я хотел бы создавать выходные данные без поднабора данных, т.е. игнорируя входные $ year и input $ subset и только используя input $ data.

Минимальный пример моего сценария R,

UI.R

ui <- dashboardPage(
  shinyjs::useShinyjs(), 
  header = dashboardHeader( ),
  body = dashboardBody(
    div(style = "class:shiny-html-output shiny-bound-output", uiOutput(outputId = "logoutbtn")),
    tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "style.css")),
    uiOutput("body")
  )
)

SERVER.R

server <- function(input, output, session){
  output$sidebar <- renderUI({
    if(USER$login == TRUE ){ 
      shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
      dashboardSidebar(
        conditionalPanel(condition="input.tabs==3",
                         # input$data
                         uiOutput(outputId = "DATA3"),

                         # click on link to show input$year and input$subset
                         div(tags$a(id = "toggleAdvanced", "Show/hide advanced info", href = "#"), 
                                  style="color:blue"),

                        # hide input$year and input$subset 
                         shinyjs::hidden(
                           div(id = "advanced",
                              uiOutput(outputId = "YEAR3"),         # input$year
                              uiOutput(outputId = "SUBSET")       # input$subset
                          )
                        )
        )
    }else{
      shinyjs::addClass(selector = "body", class = "sidebar-collapse")
    }
  })

output$body <- renderUI({
    if(USER$login == TRUE ){
      tabsetPanel(
        id = "tabs",
        tabPanel("ARIMA",
                 value = 3, 
                 h3(textOutput(outputId = "TEXT", container = span)),
                 verbatimTextOutput(outputId = "ARIMA"),
                 br(),
                 dygraphOutput(outputId = "PLOT3", width = "125%")
        )
    }else{
      loginpage
    }
  })

## INPUTS##

output$DATA3 <- renderUI({
    selectInput(inputId = "data3",
                  label = "Please choose a Track",
                   choices = list(), selected = "Track1")
 })

  solid <- reactive({
    if(is.null(input$data3)){return()}
    solid <- get(req(input$data3))
  })

  output$YEAR3 <- renderUI({
    sub <- solid()
   sub$year <- factor(sub$year)
   checkboxGroupInput(inputId = "year3",
                      label = "please choose a few years",
                       choices = unique(sub$year))
  })


  shinyjs::onclick("toggleAdvanced",
                   shinyjs::toggle(id = "advanced", anim = TRUE)) 

  tsdata <- reactive({
    x <- solid()
    dorito <- subset(x, year %in% input$year3)
    tsdata <- ts(dorito$FixedCounts, frequency = 12, 
                 start = c(min(dorito$year), min(dorito[dorito$year == min(dorito$year), "month"])), 
                 end = c(max(dorito$year), max(dorito[dorito$year == max(dorito$year), "month"])))
    tsdata
  })

  # subset button
  output$SUBSET <- renderUI(
    actionButton(inputId = "subset", label = "Subset")
)

  observeEvent(input$subset, {
    output$TEXT <- renderText({
      paste("ARIMA model for", isolate(input$data3))
    })
  })

  fit <- eventReactive(input$subset, {
    tsdata <- req(tsdata())
      if(length(tsdata) < 37){
        fit <- auto.arima(tsdata, stepwise = FALSE, approximation = FALSE)
    }else{
         train <- window(tsdata, 
                        start = c(start(time(tsdata))[1], match(month.abb[cycle(tsdata)][1], month.abb)), 
                        end = c(floor(time(tsdata)[floor(length(tsdata)*0.8)]),
                                match(month.abb[cycle(tsdata)][floor(length(tsdata)*0.8)], month.abb)))
        fit <- auto.arima(train, stepwise = FALSE, approximation = FALSE, lambda = NULL)
      }
    }
    fit
  })

## OUTPUTS ##

  output$ARIMA <- renderPrint({
    fit <- suppressWarnings(fit())
    fit
  })

  output$PLOT3 <- renderDygraph({
    graphic <- eventReactive(input$subset,{
      fit <- req(fit())
      if(fit$series == "tsdata"){
        ARIMA.mean <- fit %>% forecast(h = length(tsdata()), level = c(30,50,70))
      }else{
        ARIMA.mean <- fit %>% forecast(h = 36, level = c(30,50,70))
      }
      graph <- cbind(actuals = tsdata(), pointfc_mean = ARIMA.mean$mean,
                     lower_70 = ARIMA.mean$lower[,"70%"], upper_70 = ARIMA.mean$upper[,"70%"],
                     lower_50 = ARIMA.mean$lower[,"50%"], upper_50 = ARIMA.mean$upper[,"50%"],
                     lower_30 = ARIMA.mean$lower[,"30%"], upper_30 = ARIMA.mean$upper[,"30%"])
    })
    dygraph(graphic())
  })
}

Есть ли способ обойти это Я бы попробовал if(input$subset == 0) {}, но это не работает. Я также думаю, что этот метод будет работать только один раз и не будет работать снова после нажатия кнопки.

Любая помощь / подсказка будет принята с благодарностью.

Большое спасибо.

...