Я создаю панель управления 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) {}
, но это не работает. Я также думаю, что этот метод будет работать только один раз и не будет работать снова после нажатия кнопки.
Любая помощь / подсказка будет принята с благодарностью.
Большое спасибо.