How to access a variable from a reactive expression in Shiny in R

Question

I'm relatively new to using reactive expressions with Shiny. My problem is: I find myself having to create lots of reactive expressions with almost the exact same code but with different additional lines just to output something different (i.e., when I call the reactive expression).

For example, in the following code, I create 3 reactive expressions: p(), which outputs a plot, best() which, from a given list of selected models, indicates the one with the lowest error in the test set, and finally results(), which outputs the RMSE and MAPE error metrics in the test set for each of the selected models.

As you can see below, the code is almost identical except for the last lines in each reactive expression. So, my question is, how can I access variables I created within a reactive expression? For example, how do I access holt_forecast_11, ets_forecast_11, arima_forecast_11, and tbats_forecast_11 after I create the p() reactive expressions? How do I call those variables within another reactive expression?

If you need any more details I will gladly provide them.

Here's my code from the server.R file. Below this code, I provide ui.R just in case, although my question is only related with server.R:

library(shiny)
library(rsconnect)
library(tidyverse)
library(tidymodels)
library(lubridate)
library(forecast)
library(fpp3)
library(pwt10)
options(scipen=999)
Sys.setenv(LANG = "en")


shinyServer(function(input, output) {
    
    countries_isocode <- c("ARG", "BRA", "CHL", "COL", "MEX", "VEN")
    countries <- c("Argentina", "Brazil", "Chile", "Colombia", "Mexico", "Venezuela")
    
    p <- reactive({
        
        df <- pwt10.0 %>% 
            as_tibble() %>%
            filter(isocode %in% countries_isocode) %>% 
            dplyr::select(year, country, rgdpo) %>% 
            spread(key =
                       country, value = rgdpo) %>% 
            rename(Venezuela = `Venezuela (Bolivarian Republic of)`) %>% 
            dplyr::select(year, input$country)
        
        ts <- ts(df[,2], freq = 1, start = c(1950), end = c(2019))
        
        if(input$country == "Chile") {
            ts <- na.interp(ts)
        }
        
        train <- window(ts, end = c(2014))
        h <- length(ts) - length(train)
        
        if("holt" %in% input$model) {
            holt_model <- holt(train, h = 11)
            holt_forecast <- forecast(holt_model, h = h)
            holt_forecast_11 <- forecast(holt_model, h = 11) 
        }
        
        if("ets" %in% input$model) {
            ets_model <- ets(train)
            ets_forecast <- forecast(ets_model, h = h)
            ets_forecast_11 <- forecast(ets_model, h = 11)
        }

        if("arima" %in% input$model) {
            arima_model <- auto.arima(train)
            arima_forecast <- forecast(arima_model, h = h)
            arima_forecast_11 <- forecast(arima_model, h = 11)
        }
        
        if("tbats" %in% input$model) {
            tbats_model <- tbats(train)
            tbats_forecast <- forecast(tbats_model, h = h)
            tbats_forecast_11 <- forecast(tbats_model, h = 11)
        }
        
        p <- autoplot(ts)
        
            if("holt" %in% input$model) {
                p <- p + autolayer(holt_forecast_11, series = "HOLT", PI = FALSE)
            }
        
            if("ets" %in% input$model) {
                p <- p + autolayer(ets_forecast_11, series = "ETS", PI = FALSE)
            }
        
            if("arima" %in% input$model) {
                p <- p + autolayer(arima_forecast_11, series = "ARIMA", PI = FALSE)
            }
        
            if("tbats" %in% input$model) {
                p <- p + autolayer(tbats_forecast_11, series = "TBATS", PI = FALSE) 
            }
        
        p
    })
    
    
    best <- reactive({
        
        df <- pwt10.0 %>% 
            as_tibble() %>%
            filter(isocode %in% countries_isocode) %>% 
            dplyr::select(year, country, rgdpo) %>% 
            spread(key =
                       country, value = rgdpo) %>% 
            rename(Venezuela = `Venezuela (Bolivarian Republic of)`) %>% 
            dplyr::select(year, input$country)
        
        ts <- ts(df[,2], freq = 1, start = c(1950), end = c(2019))
        
        if(input$country == "Chile") {
            ts <- na.interp(ts)
        }
        
        train <- window(ts, end = c(2014))
        h <- length(ts) - length(train)
        
        if("holt" %in% input$model) {
            holt_model <- holt(train, h = 11)
            holt_forecast <- forecast(holt_model, h = h)
            holt_forecast_11 <- forecast(holt_model, h = 11) 
        }
        
        if("ets" %in% input$model) {
            ets_model <- ets(train)
            ets_forecast <- forecast(ets_model, h = h)
            ets_forecast_11 <- forecast(ets_model, h = 11)
        }
        
        if("arima" %in% input$model) {
            arima_model <- auto.arima(train)
            arima_forecast <- forecast(arima_model, h = h)
            arima_forecast_11 <- forecast(arima_model, h = 11)
        }
        
        if("tbats" %in% input$model) {
            tbats_model <- tbats(train)
            tbats_forecast <- forecast(tbats_model, h = h)
            tbats_forecast_11 <- forecast(tbats_model, h = 11)
        }
        
        ### RMSE
        
        RMSE <- vector("numeric")
        
        if("holt" %in% input$model) {
            RMSE <- append(RMSE, c(HOLT = accuracy(holt_forecast, ts)["Test set","RMSE"]))
        }
        if("ets" %in% input$model) {
            RMSE <- append(RMSE, c(ETS = accuracy(ets_forecast, ts)["Test set","RMSE"]))
        }
        if("arima" %in% input$model) {
            RMSE <- append(RMSE, c(ARIMA = accuracy(arima_forecast, ts)["Test set","RMSE"]))
        }
        if("tbats" %in% input$model) {
            RMSE <- append(RMSE, c(TBATS = accuracy(tbats_forecast, ts)["Test set","RMSE"]))
        }
        
        ### MAPE
        
        MAPE <- vector("numeric")
        
        if("holt" %in% input$model) {
            MAPE <- append(MAPE, c(HOLT = accuracy(holt_forecast, ts)["Test set","MAPE"]))
        }
        if("ets" %in% input$model) {
            MAPE <- append(MAPE, c(ETS = accuracy(ets_forecast, ts)["Test set","MAPE"]))
        }
        if("arima" %in% input$model) {
            MAPE <- append(MAPE, c(ARIMA = accuracy(arima_forecast, ts)["Test set","MAPE"]))
        }
        if("tbats" %in% input$model) {
            MAPE <- append(MAPE, c(TBATS = accuracy(tbats_forecast, ts)["Test set","MAPE"]))
        }
        
        df <- as.data.frame(rbind(RMSE, MAPE))
        
        names(df)[order(df[2,])[1]]
    })

    
    results <- reactive({
        
        df <- pwt10.0 %>% 
            as_tibble() %>%
            filter(isocode %in% countries_isocode) %>% 
            dplyr::select(year, country, rgdpo) %>% 
            spread(key =
                       country, value = rgdpo) %>% 
            rename(Venezuela = `Venezuela (Bolivarian Republic of)`) %>% 
            dplyr::select(year, input$country)
        
        ts <- ts(df[,2], freq = 1, start = c(1950), end = c(2019))
        
        if(input$country == "Chile") {
            ts <- na.interp(ts)
        }
        
        train <- window(ts, end = c(2014))
        h <- length(ts) - length(train)
        
        if("holt" %in% input$model) {
            holt_model <- holt(train, h = 11)
            holt_forecast <- forecast(holt_model, h = h)
            holt_forecast_11 <- forecast(holt_model, h = 11) 
        }
        
        if("ets" %in% input$model) {
            ets_model <- ets(train)
            ets_forecast <- forecast(ets_model, h = h)
            ets_forecast_11 <- forecast(ets_model, h = 11)
        }
        
        if("arima" %in% input$model) {
            arima_model <- auto.arima(train)
            arima_forecast <- forecast(arima_model, h = h)
            arima_forecast_11 <- forecast(arima_model, h = 11)
        }
        
        if("tbats" %in% input$model) {
            tbats_model <- tbats(train)
            tbats_forecast <- forecast(tbats_model, h = h)
            tbats_forecast_11 <- forecast(tbats_model, h = 11)
        }
        
        ### RMSE
        
        RMSE <- vector("numeric")
        
        if("holt" %in% input$model) {
            RMSE <- append(RMSE, c(HOLT = accuracy(holt_forecast, ts)["Test set","RMSE"]))
        }
        if("ets" %in% input$model) {
            RMSE <- append(RMSE, c(ETS = accuracy(ets_forecast, ts)["Test set","RMSE"]))
        }
        if("arima" %in% input$model) {
            RMSE <- append(RMSE, c(ARIMA = accuracy(arima_forecast, ts)["Test set","RMSE"]))
        }
        if("tbats" %in% input$model) {
            RMSE <- append(RMSE, c(TBATS = accuracy(tbats_forecast, ts)["Test set","RMSE"]))
        }
        
        ### MAPE
        
        MAPE <- vector("numeric")
        
        if("holt" %in% input$model) {
            MAPE <- append(MAPE, c(HOLT = accuracy(holt_forecast, ts)["Test set","MAPE"]))
        }
        if("ets" %in% input$model) {
            MAPE <- append(MAPE, c(ETS = accuracy(ets_forecast, ts)["Test set","MAPE"]))
        }
        if("arima" %in% input$model) {
            MAPE <- append(MAPE, c(ARIMA = accuracy(arima_forecast, ts)["Test set","MAPE"]))
        }
        if("tbats" %in% input$model) {
            MAPE <- append(MAPE, c(TBATS = accuracy(tbats_forecast, ts)["Test set","MAPE"]))
        }
        
        df <- as.data.frame(rbind(RMSE, MAPE))
        
        df
    })
    
    
    output$plot <- renderPlot({
        p()
    })

    output$results <- renderPrint({
        print(paste("According to the MAPE, the best model is:", best()))
        print("The final results are:")
        results()
    })
    
})

Now, here's ui.R:

library(shiny)
library(rsconnect)
library(tidyverse)
library(tidymodels)
library(lubridate)
library(forecast)
library(fpp3)
library(pwt10)
options(scipen=999)
Sys.setenv(LANG = "en")


countries_isocode <- c("ARG", "BRA", "CHL", "COL", "MEX", "VEN")
countries <- c("Argentina", "Brazil", "Chile", "Colombia", "Mexico", "Venezuela")

# pwt10.0 %>% 
#     as_tibble() %>% 
#     filter(isocode %in% countries) %>%
#     ggplot(aes(year, rgdpo, color = isocode)) + 
#     geom_line() +
#     labs(x = "Year", y = "Output-side real GDP at chained PPPs (in million 2017 USD)", color = "Country")


shinyUI(fluidPage(
    titlePanel("Time Series Prediction Application"),
    sidebarLayout(
        sidebarPanel(
            selectInput("country", "Select a country:", countries, "Brazil"),
            checkboxGroupInput("model", "Select time series models to evaluate:",
                               choiceNames = list("Holt's Trend Method", "ETS", "ARIMA", "TBATS"),
                               choiceValues = list("holt", "ets", "arima", "tbats"),
                               selected = c("ets", "arima"))
        ),
        mainPanel(
            plotOutput("plot"),
            verbatimTextOutput("results")
        )
    )
))

Thank you!

Put the common code into a reactive of its own and then refer to that reactive in each of the existing reactives. — Limey, Mar 02 '21 at 00:42
It usually a good practice to code the business logic outside in non reactive functions, that accept datasets and inputs as parameters. That way you can test it and debug it out of shiny. — HubertL, Mar 02 '21 at 00:55
@HubertL absolutely not ideal if you need to filter data based on a selection the user makes out of a dropdown menu. Workarounds? — Zizzipupp, Nov 19 '21 at 11:50

score 1 · Accepted Answer · edited Mar 02 '21 at 02:21

One way of refactoring this code would be to write functions to retrieve the data for the input country (get_data in the code below) and to make the forecasts for the selected models (get_forecasts, which uses the output list from get_data as one of its inputs).

Using these functions, the logic of the shinyServer function is simple: get the data for the selected country, make the predictions using the selected models, and display the plot and results.


library(shiny)
library(rsconnect)
library(tidyverse)
library(tidymodels)
library(lubridate)
library(forecast)
library(fpp3)
library(pwt10)
options(scipen=999)
Sys.setenv(LANG = "en")

countries_isocode <- c("ARG", "BRA", "CHL", "COL", "MEX", "VEN")
countries <- c("Argentina", "Brazil", "Chile", "Colombia", "Mexico", "Venezuela")

# function to retrieve data for a country
# input: country name
# output: list with components df, ts, train, h
get_data <- function(country) {
    df <- pwt10.0 %>% 
        as_tibble() %>%
        filter(isocode %in% countries_isocode) %>% 
        dplyr::select(year, country, rgdpo) %>% 
        spread(key =
                   country, value = rgdpo) %>% 
        rename(Venezuela = `Venezuela (Bolivarian Republic of)`) %>% 
        dplyr::select(year, country)
    ts <- ts(df[,2], freq = 1, start = c(1950), end = c(2019))
    if(country == "Chile") {
        ts <- na.interp(ts)
    }
    train <- window(ts, end = c(2014))
    h <- length(ts) - length(train)
    return(list(df = df,
                ts = ts,
                train = train,
                h = h))
}

# function to turn a model name into a forecasting function and a series name
# input: model name ('holt', 'ets', 'arima', tbats')
# output: list with components fn (a forecasting function) and seriesname (a series name)
get_forecast_seriesname <- function(model) {
    L <- list()
    if (model == "holt") L <- list(fn = holt, seriesname = "HOLT")
    if (model == "ets") L <- list(fn = ets, seriesname = "ETS")
    if (model == "arima") L <- list(fn = auto.arima, seriesname = "ARIMA")
    if (model == "tbats") L <- list(fn = tbats, seriesname = "TBATS")
    return(L)
}

# function to get forecasts
# inputs: g (output from get_data above), models = vector of model names
# output: list containing p (plot), results (results), best (name of best model)
get_forecasts <- function(g, models) {
    p <- autoplot(g$ts)
    RMSE <- MAPE <- vector("numeric")
    for (model in models) {
        tmplist <- get_forecast_seriesname(model)
        func <- tmplist$fn
        if (model == "holt") {
            this_model <- func(g$train, h = 11)
        } else {
            this_model <- func(g$train)
        }
        this_forecast <- forecast(this_model, h = g$h)
        RMSE <- append(RMSE, c(tmp = accuracy(this_forecast, g$ts)["Test set","RMSE"]))
        names(RMSE)[which(names(RMSE) == "tmp")] <- tmplist$seriesname
        MAPE <- append(MAPE, c(tmp = accuracy(this_forecast, g$ts)["Test set","MAPE"]))
        names(MAPE)[which(names(MAPE) == "tmp")] <- tmplist$seriesname
        this_forecast_11 <- forecast(this_model, h = 11)
        p <- p + autolayer(this_forecast_11,
                            series = tmplist$seriesname,
                            PI = FALSE)
    }
    results <- as.data.frame(rbind(RMSE, MAPE))
    best <- names(result_df)[order(result_df[2,])[1]]
    return(list(p = p, results = results, best = best))
}


shinyServer(function(input, output) {

    data_selected_country <- reactive({
        get_data(input$country)
    })

    forecasts <- reactive({
        g <- data_selected_country()
        get_forecasts(g, input$model)
    })

    output$plot <- renderPlot({
        forecasts()$p
    })
    
    output$results <- renderPrint({
        print(paste("According to the MAPE, the best model is:", forecasts()$best))
        print("The final results are:")
        forecasts()$results
    })
    
})

How to access a variable from a reactive expression in Shiny in R

1 Answers1