Read Reactive Elements from Shiny Module - r

Question

I'm trying to use some reactive elements from predefined function and call that data from a module to generate plots, but data is not getting updated upon selection. I've also tried to call the function inside reactive() and call that from the module, but still same result. My approach is below:
library(shiny)
library(shinyWidgets)
library(highcharter)
library(data.table)
library(dplyr)
employement_type_count <- function(
data,
category,
...
){
data[employee_category %in% category, .(count = .N), by = employee_category]
}
pie_chart_ui <- function(id) {
ns <- NS(id)
highchartOutput(ns("pie"))
}
pie_chart_server <- function(
id,
data,
var_x = names(data)[1],
var_y = names(data)[2],
lab_x = names(data)[1],
lab_y = names(data)[2],
tooltip_name = names(data)[2],
export_title = NA
) {
moduleServer(
id,
function(input, output, session) {
output$pie <- renderHighchart({
data %>%
hchart(
'pie',
hcaes_(x = var_x, y = var_y),
name = tooltip_name
) %>%
hc_xAxis(title = list(text = lab_x)) %>%
hc_yAxis(title = list(text = lab_y)) %>%
hc_plotOptions(
pie = list(
allowPointSelect = TRUE,
cursor = 'pointer',
dataLabels = list(
enabled = TRUE,
format = '<b>{point.name}</b>: {point.percentage:.1f}%',
style = list(
color = "(Highcharts.theme && Highcharts.theme.contrastTextColor) || 'black'"
)
)
)
) %>%
hc_exporting(
enabled = TRUE,
buttons = list(
contextButton = list(
align = 'right'
)
),
chartOptions = list(
title = list(
text = export_title
)
)
)
})
}
)
}
ui <- fluidPage(
sidebarPanel(
pickerInput(
"employee_type",
"Employee Type",
choices = c("Regular", "Project", "Service", "Part-Time"),
selected = c("Regular", "Project", "Service", "Part-Time"),
multiple = TRUE
)
),
mainPanel(
pie_chart_ui("employee_category")
)
)
server <- function(input, output, session){
# data_common <- fread("data_common.csv")
data_common <- data.table(
id = 1:26,
employee_name = LETTERS,
gender_type = rep(c("Male", "Female"), each = 13),
employee_category = c("Regular", "Project", rep(c("Regular", "Project", "Service", "Part-Time"), times = 6))
)
pie_chart_server(
"employee_category",
employement_type_count(
data_common,
input$employee_type
)
)
}
shinyApp(ui, server)
Note that, data should be imported from server, instead of global, as it is constantly getting updated.

Answer 1

One way to do it is shown below.
library(shiny)
library(shinyWidgets)
library(highcharter)
library(data.table)
library(dplyr)
df1 <- data.table(
id = 1:26,
employee_name = LETTERS,
gender_type = rep(c("Male", "Female"), each = 13),
employee_category = c("Regular", "Project", rep(c("Regular", "Project", "Service", "Part-Time"), times = 6))
)
employement_type_count <- function(
data,
category,
...
){
data <- data()
if (is.null(category())) {df <- data
}else df <- data[employee_category %in% category(), .(count = .N), by = employee_category]
return(df)
}
pie_chart_ui <- function(id) {
ns <- NS(id)
highchartOutput(ns("pie"))
}
pie_chart_server <- function(
id,
data,
var_x = names(data)[1],
var_y = names(data)[2],
lab_x = names(data)[1],
lab_y = names(data)[2],
tooltip_name = names(data)[2],
export_title = NA
) {
moduleServer(
id,
function(input, output, session) {
output$pie <- renderHighchart({
data %>%
hchart(
'pie',
hcaes_(x = var_x, y = var_y),
name = tooltip_name
) %>%
hc_xAxis(title = list(text = lab_x)) %>%
hc_yAxis(title = list(text = lab_y)) %>%
hc_plotOptions(
pie = list(
allowPointSelect = TRUE,
cursor = 'pointer',
dataLabels = list(
enabled = TRUE,
format = '<b>{point.name}</b>: {point.percentage:.1f}%',
style = list(
color = "(Highcharts.theme && Highcharts.theme.contrastTextColor) || 'black'"
)
)
)
) %>%
hc_exporting(
enabled = TRUE,
buttons = list(
contextButton = list(
align = 'right'
)
),
chartOptions = list(
title = list(
text = export_title
)
)
)
})
}
)
}
ui <- fluidPage(
sidebarPanel(
pickerInput(
"employee_type",
"Employee Type",
choices = c("Regular", "Project", "Service", "Part-Time"),
selected = c("Regular", "Project", "Service", "Part-Time"),
multiple = TRUE
)
),
mainPanel(
pie_chart_ui("employee_category")
)
)
server <- function(input, output, session){
# data_common <- fread("data_common.csv")
data_common <- reactive(df1)
employee <- reactive(input$employee_type)
observe({
mydata <- employement_type_count(
data_common,
employee
)
pie_chart_server(
"employee_category",
mydata
)
})
}
shinyApp(ui, server)