caproki
Reputation: 410
How to access a variable from a reactive expression in Shiny in R
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!
Upvotes: 0
Views: 1616
Answers (1)
robert_mi
Reputation: 84
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
})
})
Upvotes: 1
Related Questions
- How to put a reactive value inside a reactiveVal() in a shiny app
- Extract a value from reactive data frame in shiny
- Creating variable based on reactive one in shiny
- R Shiny: Can't access reactive value outside of reactive consumer
- How to I use a variable from the shiny UI outside of a reactive environment?
- how to call variable defined in reactive function of shiny in other reactive function
- How can I use a previous reactive value in a reactive expression in shiny?
- Call Variable from reactive data() in R Shiny App
- Access data created from reactive function to define reactiveValues in Shiny
- Passing reactive expressions in Shiny