function won't run interactively in shinydashboard app - r

Question

In the following shiny app, I have embedded the annual and monthly functions on line 7-15 into the selectizeInput placeholder on line 22.
library(shiny)
library(shinydashboard)
library(tidyquant)
library(tidyverse)
library(plotly)
annual <- function(x){
(x/lag(x, 12) - 1)*100
}
monthly <- function(x){
(x/lag(x) - 1)*100
}
ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(selectizeInput('select_calculation', 'Calculation',
choices = c('Monthly' = monthly, 'Annual' = annual)
), height=80,width=4,
)
),
fluidRow(
box(plotlyOutput("chart"))
)
)
)
server <- function(input, output) {
output$chart <- renderPlotly({
chart <- tidyquant::tq_get('PCE',
from = '2019-01-01',
to = '2022-10-01',
get = 'economic.data') %>%
select(-symbol) %>%
mutate_if(is.numeric, ~input$select_calculation(.)) %>%
drop_na() %>% {
ggplot(., aes(x = date, y = price)) +
geom_line()
} %>%
ggplotly()
})
}
shinyApp(ui, server)
When I call one of the formulas in the code for my chart (e.g ~annual(.) on line 44, my app works fine.
However when I try to run this interactively using the selectizeInput option by amending line 44 as follows
mutate_if(is.numeric, ~input$select_calculation(.)) %>%
I get the following error. Is there any way to call a function interactively successfully?

Answer 1

I already wondered where you want to go with this. The issue is that input$select_calculation is a character not a function, i.e. to make your code work you have to parse the input using e.g.
output$chart <- renderPlotly({
calc_method <- eval(parse(text = input$select_calculation))
chart <- tidyquant::tq_get("PCE",
from = "2019-01-01",
to = "2022-10-01",
get = "economic.data"
) %>%
select(-symbol) %>%
mutate_if(is.numeric, ~ calc_method(.)) %>%
drop_na() %>%
{
ggplot(., aes(x = date, y = price)) +
geom_line()
} %>%
ggplotly()
})
But IMHO the easier approach would be to use e.g. switch inside the server to switch the function used for the calculations instead of trying to pass the function via choices:
library(shiny)
library(shinydashboard)
library(tidyquant)
library(tidyverse)
library(plotly)
annual <- function(x) {
(x / lag(x, 12) - 1) * 100
}
monthly <- function(x) {
(x / lag(x) - 1) * 100
}
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(selectizeInput("select_calculation", "Calculation",
choices = c("Monthly" = "monthly", "Annual" = "annual")
), height = 80, width = 4, )
),
fluidRow(
box(plotlyOutput("chart"))
)
)
)
server <- function(input, output) {
output$chart <- renderPlotly({
calc_method <- switch(input$select_calculation,
"monthly" = monthly,
"annual" = annual
)
chart <- tidyquant::tq_get("PCE",
from = "2019-01-01",
to = "2022-10-01",
get = "economic.data"
) %>%
select(-symbol) %>%
mutate_if(is.numeric, ~ calc_method(.)) %>%
drop_na() %>%
{
ggplot(., aes(x = date, y = price)) +
geom_line()
} %>%
ggplotly()
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:6727