I'm trying to use reactive selectizeInput by first time in shiny modules, but It's not working. I read the documentation of modules and reactive inputs, but I don't know how to work with it together. I made a simplify code to show my doubt. This is the code without modules, It's working well:
library(shiny)
library(shinydashboard)
library(highcharter)
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
ui<-dashboardPage(title= "Dashboard", skin= "green",
dashboardHeader(title="PROYECTO"),
dashboardSidebar(
sidebarMenu(id="sidebarID",
menuItem("OVERVIEW",tabName = "datos"
)
)
),
dashboardBody(
tabItems(tabItem(tabName = "datos",
fluidRow(
column(width = 6,
selectizeInput("select",
"Choose",
c("a"="1",
"b"="2")
)),
box(width=6, column( width=12,
column(width=12,highchartOutput("y"))
),
height = 400))
)
)))
server <- function(input, output,session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
}
shinyApp(ui, server)
Now, I was trying to adapt it into modules. I created a module:
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
yUI<-function(id) {tagList(highchartOutput(NS(id,"y")))
}
yServer<-function(id){
moduleServer(id, function(input, output, session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
})}
And shiny dashboard:
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
yUI<-function(id) {tagList(highchartOutput(NS(id,"y")))
}
yServer<-function(id){
moduleServer(id, function(input, output, session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
})}
But It's not working.
CodePudding user response：
The issue is that in the module server you are using input$select which however is created outside of the module. Doing so the server will look for a select in the module namespace. However, as there is no input with ID select in the module namespace you get an error.
To fix that you could pass the input$select to the module server as an argument:
``` r
library(shiny)
library(shinydashboard)
library(highcharter)
library(xts)
yUI <- function(id) {
tagList(
highchartOutput(NS(id, "y"))
)
}
yServer <- function(id, choice) {
moduleServer(id, function(input, output, session) {
y_react <- reactive(
highchart(type = "stock") %>%
hc_add_series(ts[, choice],
type = "line",
color = "red"
)
)
output$y <- renderHighchart(y_react())
})
}
ui <- dashboardPage(
title = "Dashboard", skin = "green",
dashboardHeader(title = "PROYECTO"),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("OVERVIEW", tabName = "datos")
)
),
dashboardBody(
tabItems(tabItem(
tabName = "datos",
fluidRow(
column(
width = 6,
selectizeInput(
"select",
"Choose",
c(
"a" = "1",
"b" = "2"
)
)
),
box(
width = 6, column(
width = 12,
column(width = 12, yUI("y"))
),
height = 400
)
)
))
)
)
server <- function(input, output, session) {
yServer("y", as.numeric(input$select))
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:3301
A second option and probably more in the spirt of what modules are meant for would be to include the selectizeInput in the module. Doing so the input with inputID select becomes part of the module namespace and can be accessed from within the module server using input$select. As you want to place the UI elements in different parts of your dashboard I decided for two module UI "functions" which adds the flexibility to place the UI elements individually:
yUI_plot <- function(id) {
tagList(
highchartOutput(NS(id, "y"))
)
}
yUI_select <- function(id) {
selectizeInput(
NS(id, "select"),
"Choose",
c(
"a" = "1",
"b" = "2"
)
)
}
yServer <- function(id) {
moduleServer(id, function(input, output, session) {
y_react <- reactive(
highchart(type = "stock") %>%
hc_add_series(ts[, as.numeric(input$select)],
type = "line",
color = "red"
)
)
output$y <- renderHighchart(y_react())
})
}
ui <- dashboardPage(
title = "Dashboard", skin = "green",
dashboardHeader(title = "PROYECTO"),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("OVERVIEW", tabName = "datos")
)
),
dashboardBody(
tabItems(tabItem(
tabName = "datos",
fluidRow(
column(
width = 6,
yUI_select("y")
),
box(
width = 6, column(
width = 12,
column(width = 12, yUI_plot("y"))
),
height = 400
)
)
))
)
)
server <- function(input, output, session) {
yServer("y")
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:7210
