R | ECharts | Shiny | modules and data selection

shiny.module.echarty.R

#  original code by https://github.com/Camil88
library(shiny)
library(dplyr)
library(nycflights13)
library(shinyWidgets)
library(echarty)
library(scales)

toggle <- FALSE

moduleServer <- function(id, module) {
	callModule(module, id)
}

# UI #
mod_btn_UI <- function(id) {
	ns <- NS(id)
	tagList(
		uiOutput(ns("list")),
		ecs.output(ns("plot")),
		actionButton(ns("replace.btn"), "Replace"),
		ecs.output(ns("plot2"))
	)
}

# Server #
mod_btn_server <- function(id){
	moduleServer(id, function(input, output, session) {
		
		ns <- NS(id)
		
		df <- nycflights13::weather[c(1:10,9000:9010,18000:18010),]
		df <- df %>% mutate(size = scales::rescale(humid, to=c(6, 20)))  # add custom size for dots
		
		data <- reactive({
			df %>% 
				dplyr::select(origin) %>% 
				unique()
		})
		
		airports <- reactive({
			subset(df, df$origin %in% input$picker)
		}) 
		
		output$list <- renderUI({
			ns <- session$ns
			
			shinyWidgets::pickerInput(
				inputId = ns('picker'),
				label = NULL,
				multiple = TRUE,
				options = list(`actions-box` = TRUE, title = "Choose Airport"),
				choices = data()$origin,
				selected = data()$origin
			)
		})
		
		output$plot <- ecs.render({
			p <- airports() %>% group_by(origin) %>% ec.init()
			# update series, which are preset already
			p$x$opts$series <- lapply(p$x$opts$series, function(s) { 
				s$encode <- list(x='temp', y='dewp');
				s$symbolSize <- ec.clmn(16);   # 16 = column index of 'size'
				s })
			p$x$opts$color <- c('blue','green','magenta')   # custom series colors
			p$x$opts$tooltip <- list(trigger = "item",
				formatter = ec.clmn('<strong> %d </strong><br />
                				temp: %d <br />dewp: %d <br />humid: %d', 1,6,7,8) )
 			#	formatter = htmlwidgets::JS("function(params){
			#		return('<strong>' + params.seriesName +
			#			'</strong><br />temp: ' + params.value[5] +
			#			'<br />dewp: ' + params.value[6] +
			#			'<br />humid: ' + params.value[7])
			#		}"))
			p
		})
		
		observeEvent(input$replace.btn, {
			p <- ecs.proxy(ns('plot2'))
			tmp <- mtcars %>% ec.init()	# presets
			p$x$opts <- tmp$x$opts		# use them in the proxy
			p$x$opts$legend <- list(ii='')	# invoke legend
			if (toggle) {
				p$x$opts$series <- list(list(type='line', encode=list(x='qsec', y='mpg'), name='mpg'))
			} else {
				p$x$opts$series <- list(list(type='line', encode=list(x='qsec', y='drat'), name='drat', color='red'))
			}
			p %>% ecs.exec('p_replace')
			toggle <<- !toggle
		})
		
		output$plot2 <- ecs.render({
			p <- mtcars %>% ec.init()
			p$x$opts$series <- list(list(type='line', encode=list(x='qsec', y='mpg'), name='mpg'))
			p$x$opts$legend <- list(ii='')
			p
		})
	})
}

# App #
ui <- fluidPage(
	mod_btn_UI("test-btn")
)
server <- function(input, output, session) {
	mod_btn_server("test-btn")
}
shinyApp(ui = ui, server = server)

added Replace functionality, idea by @Camil88