Confused with Shiny Modules and renderUI - r

Question

I am trying to plot a dygraph in my Shiny App but I can't seem to get the output working. I would like to do it using modules.
Comprar = purchase and Alquiler = Rental.
I randomly create some price data and some dates
Generate some summary statistics for the average price and number of observations in the data comprar_stats and alquiler_stats
I store some metrics in a list that I would like to call throughout the App.
Then in ui_dygraph I try to generate the dropdown module for each option on my data comprar_main, alquiler_main and price_to_rent. I am able to generate a dropdown but not an output of the dygraph...
How I can I obtain the output of the dygraph? - This code is a mix of some Shiny code I took from the Appsilon "Enterprice Shiny" App - I would like to try and modularise my Apps.
Expected Output: Obtain the dygraph outputs depending on the dropdown.
Shiny App:
library(bslib)
library(shiny)
library(tidyverse)
library(dygraphs)
library(zoo)
################################################################################
startDate <- as.Date("2023-01-01")
endDate <- as.Date("2023-06-01")
dates <- rep(dates, each = 10)
propertyPrices <- round(rnorm(length(dates), mean = 100000, sd = 20000), 2)
comprar_main <- data.frame(collectionDate = dates, price = propertyPrices)
propertyRentals <- round(rnorm(length(dates), mean = 1000, sd = 200), 2)
alquiler_main <- data.frame(collectionDate = dates, price = propertyRentals)
################################################################################
################################################################################
comprar_stats = comprar_main %>%
filter(collectionDate > as.Date("2022-09-27")) %>% # accidently have rental data before this date
filter(price < 1000000) %>%
filter(price > 100000) %>%
group_by(collectionDate) %>%
summarise(
mean_price = mean(price),
mean_price = round(mean_price, 0),
propertiesListed = n()
) %>%
ungroup() %>%
mutate(
rolling_average = rollapply(mean_price, fill=NA, width = 14, mean, align = "right"),
rolling_average = round(rolling_average, 0)
) %>%
add_column(
type = "comprar_main"
)
alquiler_stats = alquiler_main %>%
filter(collectionDate > as.Date("2022-09-27")) %>%
filter(price < 2500) %>%
filter(price > 200) %>%
group_by(collectionDate) %>%
summarise(
mean_price = mean(price),
mean_price = round(mean_price, 0),
propertiesListed = n()
) %>%
ungroup() %>%
mutate(
rolling_average = rollapply(mean_price, fill=NA, width = 14, mean, align = "right"),
rolling_average = round(rolling_average, 0)
) %>%
add_column(
type = "alquiler_main"
)
stats = bind_rows(comprar_stats, alquiler_stats)
stats_price_to_rent = full_join(comprar_stats, alquiler_stats, by = "collectionDate") %>%
mutate(
mean_price = mean_price.x / (mean_price.y * 12), # annualise the rent
mean_price = round(mean_price),
rolling_average = rollapply(mean_price, fill=NA, width = 14, mean, align = "right"),
rolling_average = round(rolling_average, 0),
propertiesListed = propertiesListed.y / propertiesListed.x,
propertiesListed = round(propertiesListed, 2)
) %>%
add_column(type = "price_to_rent_main") %>%
select(c(collectionDate, mean_price, propertiesListed, rolling_average, type))
################################################################################
metrics_list <- list(
comprar_main = list(
id = "comprar_main",
title = "Comprar (All Spain)",
currency = "€",
category = "comprar",
legend = "Purchase Spain",
legend2 = "# of properties"
),
alquiler_main = list(
id = "alquiler_main",
title = "Alquiler (All Spain)",
currency = "€",
category = "alquiler",
legend = "Rental Spain",
legend2 = "# of properties"
),
price_to_rent_main = list(
id = "price_to_rent_main",
title = "Price to Rent (All Spain)",
currency = "€",
category = "misc",
legend = "Price To Rent",
legend2 = "# of rentals / # of purchases",
caption = "Some info here"
)
)
################################################################################
################################################################################
########################### User interfaces ####################################
ui_dygraph <- function(id) {
ns <- NS(id)
# Add all available metrics to dygraph chart
choices <- names(metrics_list)
tagList(
tags$div(
class = "panel-header",
selectInput(
ns("metric"), "Select metric for the time chart",
choices,
width = NULL,
selectize = TRUE,
selected = choices[[1]]
)
),
tags$div(
class = "chart-time-container",
dygraphOutput(ns("dygraph"), height = "240px")
)
)
}
################################################################################
ui <- navbarPage(
fluidPage(
theme = bs_theme(bootswatch = "minty"),
title = "hi",
ui_dygraph("dygraph"),
renderUI(output$dygraph)
)
)
server <- function(input, output, session, df) {
metric <- reactive({ metrics_list[[input$metric]] })
output$dygraph <- renderDygraph({
data = df
metric_suffix <- ifelse(!is.null(metric()$currency), glue::glue(" ({metric()$currency})"), "")
metric_legend <- paste0(metric()$legend, metric_suffix)
metric_legend2 <- paste0(metric()$legend2)
if(metric()$id == "comprar_main") {
dyAxisValueRange = c(220000, 310000)
dy2AxisValueRange = c(0, 15000)
} else if (metric()$id == "alquiler_main") {
dyAxisValueRange = c(0, 2700)
dy2AxisValueRange = c(0, 4000)
} else { # price_to_rent_main axis
dyAxisValueRange = c(15, 35)
dy2AxisValueRange = c(0, 3.5)
}
if (metric()$id == "comprar_main") {
data = stats
} else if (metric()$id == "alquiler_main") {
data = stats
} else {
data = stats_price_to_rent
}
data %>%
filter(type == metric()$id) %>%
select(-c(type)) %>%
column_to_rownames("collectionDate") %>%
as.xts() %>%
# as.xts(order.by = .$collectionDate)
dygraph(main = glue::glue("{metric()$title}")) %>%
dySeries("mean_price", label = metric_legend, drawPoints = FALSE, color = "#0099F9") %>%
dySeries("rolling_average", label = "Rolling Average (14 days)", drawPoints = FALSE, color = "#15354A") %>%
dyAxis("y", label = "Price", valueRange = dyAxisValueRange, independentTicks = TRUE,
valueFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}',
axisLabelFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}'
) %>%
dyAxis("y2", label = metric_legend2, valueRange = dy2AxisValueRange, independentTicks = TRUE,
valueFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}',
axisLabelFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}'
) %>%
dySeries("propertiesListed", label = metric_legend2, stepPlot = TRUE, fillGraph = TRUE, color = "#bdc2c6", axis=('y2')) %>%
dyOptions(
includeZero = FALSE,
axisLineColor = "#585858",
gridLineColor = "#bdc2c6",
axisLabelFontSize = 12,
axisLabelColor = "#585858",
disableZoom = TRUE
)
})
}
shinyApp(ui = ui, server = server)

Answer 1

As mentioned by #YBS in the comments the issue is that your digraph module misses a moduleServer. Moving you code from the main server to a module server will fix your issue:
library(xts)
library(bslib)
library(shiny)
library(tidyverse)
library(dygraphs)
ui_dygraph <- function(id) {
ns <- NS(id)
choices <- names(metrics_list)
tagList(
tags$div(
class = "panel-header",
selectInput(
ns("metric"), "Select metric for the time chart",
choices,
width = NULL,
selectize = TRUE,
selected = choices[[1]]
)
),
tags$div(
class = "chart-time-container",
dygraphOutput(ns("dygraph"), height = "240px")
)
)
}
server_dygraph <- function(id) {
moduleServer(id, function(input, output, session) {
metric <- reactive({
metrics_list[[input$metric]]
})
output$dygraph <- renderDygraph({
data <- df
metric_suffix <- ifelse(!is.null(metric()$currency), glue::glue(" ({metric()$currency})"), "")
metric_legend <- paste0(metric()$legend, metric_suffix)
metric_legend2 <- paste0(metric()$legend2)
if (metric()$id == "comprar_main") {
dyAxisValueRange <- c(220000, 310000)
dy2AxisValueRange <- c(0, 15000)
} else if (metric()$id == "alquiler_main") {
dyAxisValueRange <- c(0, 2700)
dy2AxisValueRange <- c(0, 4000)
} else {
dyAxisValueRange <- c(15, 35)
dy2AxisValueRange <- c(0, 3.5)
}
if (metric()$id == "comprar_main") {
data <- stats
} else if (metric()$id == "alquiler_main") {
data <- stats
} else {
data <- stats_price_to_rent
}
data %>%
filter(type == metric()$id) %>%
select(-c(type)) %>%
column_to_rownames("collectionDate") %>%
as.xts() %>%
dygraph(main = glue::glue("{metric()$title}")) %>%
dySeries("mean_price", label = metric_legend, drawPoints = FALSE, color = "#0099F9") %>%
dySeries("rolling_average", label = "Rolling Average (14 days)", drawPoints = FALSE, color = "#15354A") %>%
dyAxis("y",
label = "Price", valueRange = dyAxisValueRange, independentTicks = TRUE,
valueFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}',
axisLabelFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}'
) %>%
dyAxis("y2",
label = metric_legend2, valueRange = dy2AxisValueRange, independentTicks = TRUE,
valueFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}',
axisLabelFormatter = 'function(d){return d.toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ",");}'
) %>%
dySeries("propertiesListed", label = metric_legend2, stepPlot = TRUE, fillGraph = TRUE, color = "#bdc2c6", axis = ("y2")) %>%
dyOptions(
includeZero = FALSE,
axisLineColor = "#585858",
gridLineColor = "#bdc2c6",
axisLabelFontSize = 12,
axisLabelColor = "#585858",
disableZoom = TRUE
)
})
})
}
ui <- navbarPage(
fluidPage(
theme = bs_theme(bootswatch = "minty"),
title = "hi",
ui_dygraph("dygraph")
)
)
server <- function(input, output, session, df) {
server_dygraph("dygraph")
}
shinyApp(ui = ui, server = server)