Startup warning with reactive input in shiny module - r

I am currently modularizing a Shiny app in different modules following the {golem} framework. For simplicity, let's say I have 3 main shiny modules:
mod_faith_plot: generates a scatterplot of a given dataset (I'll use faitfhul).
mod_points_select: decouples a dropdown menu to select how many points will be plotted. UI inputs have this dedicated module as I wanted to place the selector in the sidebarPanel instead of mainPanel (alongside the plot).
mod_data: provides a reactive dataframe depending on the n_points argument.
This modules talk to each other in the server function.
Now, when I start my app with a simple head(., n_points()) in mod_data I get the following warning:
Warning: Error in checkHT: invalid 'n' - must contain at least one non-missing element, got none.
The input in mod_points_select is clearly NULL before the selected_points argument gets assigned, is there a less hacky and more elegant way to avoid the warning at startup than my if condition?
library(shiny)
library(dplyr)
library(ggplot2)
# [Module] Plot faithful data -------------------------------------------------------
mod_faith_plot_ui <- function(id){
ns <- NS(id)
tagList(
plotOutput(ns("faith_plot"))
)
}
mod_faith_plot_server <- function(input, output, session, data){
ns <- session$ns
output$faith_plot <- renderPlot({
data() %>%
ggplot(aes(eruptions, waiting)) +
geom_point()
})
}
# [Module] Module for n_points dropdown ---------------------------------------------
mod_points_select_ui <- function(id){
ns <- NS(id)
uiOutput(ns("select_points"))
}
mod_points_select_server <- function(input, output, session){
ns <- session$ns
output$select_points <- renderUI({
selectInput(
ns("n_points"),
label = "Select how many points",
choices = seq(0, 200, by = 10),
selected = 50
)
})
reactive({input$n_points})
}
# [Module] Get filtered data -----------------------------------------------------------------
mod_data_server <- function(input, output, session, n_points){
ns <- session$ns
data <- reactive({
faithful %>%
# If condition used to avoid warnings at startup - switch lines to get warning
# head(., n_points())
head(., if(is.null(n_points())) { TRUE } else {n_points()})
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
mod_points_select_ui(id = "selected_points")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("plot", mod_faith_plot_ui(id = "faith_plot"))
)
)
)
)
server <- function(input, output, session) {
data <- callModule(mod_data_server, id = "data", n_points = selected_points)
selected_points <- callModule(mod_points_select_server, id = "selected_points")
callModule(mod_faith_plot_server, id = "faith_plot", data = data)
}
shinyApp(ui, server)

You can use req() to ensure values are available:
data <- reactive({
req(n_points())
faithful %>%
head(., n_points())
})
When values are not available the call is silently canceled

Related

Problem in creating a test file for unit testing of Shiny modules using usethis::use_test()

My R shiny app has two modules. The "dataselect" module and the "plot" module. I want to write unit tests for the two modules using testthat package. I am following the instruction in the mastering Shiny book. It has been mentioned in this book that first, we should create a test file using usethis::use_test() in the R console.
But when I run this code, I get the following error:
Error: Open file must be in the 'R' directory of the active package. Actual path: 'app.R'
It might not be needed, but for more information, I put a minimal example of my Shiny app that I want to write the unit tests for its modules:
library(shiny)
library(plotly)
library(reshape2)
#----------------------------------------------------------------------------------------
# Dataselect module
dataselect_ui<- function(id) {
ns<-NS(id)
tagList(
selectInput(ns("Nametype"),"Select a name type",
choices=c("Name1","Name2","choose"),selected = "choose"),
selectInput(ns("Name"),"Select a name",
choices="",selected = "",selectize=TRUE),
DT::DTOutput(ns("tab"))
)
}
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
# Data preparation
df<-data.frame(Name1<-c("Aix galericulata","Grus grus"," Alces alces"),
Name2<-c("Mandarin Duck","Common Crane" ,"Elk"),
eventDate<-c("2015-03-11","2015-03-10","2015-03-10"),
individualCount<-c(1, 10, 1)
)
colnames(df)<-c("Name1","Name2","eventDate","individualCount")
# Putting columns Name1 and Nam2 of df in one column called nameType using melt()function
# This format of data is needed for the choices argument of updateSelectizeInput()
df2<-reshape2::melt(df,id=c("eventDate","individualCount"))
colnames(df2)<-c("eventDate","individualCount","nameType","Name")
observeEvent(
input$Nametype,
updateSelectizeInput(session, "Name", "Select a name",
choices = unique(df2$Name[df2$nameType==input$Nametype]),selected = ""))
# finalDf() is the data used to plot the table and plot
finalDf<-reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
# if the first selectInput is set to Name1, from df select rows their Name1 column are
# equal to the second selectInput value
else if(input$Nametype=="Name1"){
finalDf<-df[which(df$Name1==input$Name) ,]
}
# if the first selectInput is set to Name2, from df select rows their Name2 column are
# equal to the second selectInput value
else if(input$Nametype=="Name2"){
finalDf<-df[which(df$Name2==input$Name) ,]
}
return(finalDf)
})
output$tab<-DT::renderDT({
req(input$Name)
datatable(finalDf(), filter = 'top',
options = list(pageLength = 5, autoWidth = TRUE),
rownames= FALSE)
})
return(
list("finalDf" = finalDf, "input_Name" = reactive(input$Name))
)
})
}
#--------------------------------------------------------------------------------------
# Plot module
plot_ui <- function(id) {
ns<-NS(id)
tagList(
plotlyOutput(ns("plot"))
)
}
plot_server <- function(id,input_Name ,finalDf) {
moduleServer(id, function(input, output, session) {
output$plot <- renderPlotly({
req(input_Name())
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
})
}
#--------------------------------------------------------------------------------------
# application
ui <- fluidPage(
dataselect_ui("dataselect"),
plot_ui("plot1")
)
server <- function(session,input, output) {
dataselect_outputs <- dataselect_server("dataselect")
plot_server("plot1",input_Name = dataselect_outputs$input_Name
,finalDf= dataselect_outputs$finalDf)
}
shinyApp(ui = ui, server = server)
I appreciate any help everybody can provide.

How can I import 2 datasets, have them persist in my environment, and pass one of the column names as a parameter in my modular plot function?

The Questions
I have revised my code to one file as opposed to being organized in multiple files. I believe that by calling my dataframes I am unable to call them again in another module for some reason, I am unsure why. In addition I am trying to get an already known before importing column name hardcoded as a parameter when calling my plotFactorOfValue_server module.
I have revised the ggplot inside of this module
to work with the mtcars dataframe (using weight factor as the y variable)
1. My mod_plotFactorOfValue_server function does not recognize my
dataset and does not see my parameter (which is a column name in
the dataset)
2. Are my datasetComparables <- mod_import_server("import_1") and
datasetWholeHood <- mod_import_server("import_2") reactive objects
when called like this? Or will they only exist while being called?
3. Is there just a better way to do this? I don't want to have the user selecting the x
variable (that would mean many selectors for each plot(calling plot module 7 times for
different column names). I want to keep this modular, I have tried this without modules,
and the code is way too long and cumbersome.
The Code - Modules - UI - Server
Modules in order for importing data, exporting data table,
and plotting with ggplot (which is where I am having trouble).
mod_import_ui <- function(id){
ns <- NS(id)
tagList(
fileInput(ns("file1"), label = "Choose CSV File", accept = ".csv")
#, checkboxInput(ns("header"), label = "Header", TRUE)
)
}
mod_import_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
dtreact <- reactive({
file <- input$file1
if(is.null(file))
return(NULL)
read.csv(file$datapath,
# header = input$header
)
})
# Return the reactive that yields the data frame
return(dtreact)
})
}
```
Module for displaying imported data as a table, this used the dataframe datasetComparables or datasetWholeHood when called.
```
mod_importedDataTable_ui <- function(id){
ns <- NS(id)
tagList(
DTOutput(ns("contents"))
)
}
#' importedDataTable Server Functions----
#'
#' #noRd
mod_importedDataTable_server <- function(id, dataset){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$contents <- renderDT({
req(dataset())
df1 <- dataset()
return(datatable(df1))
})
})
}
```
A shiny Module that uses ggplot to plot a parameter(factorOfValue) from an imported
dataset.The user should NOT be selecting the factor to be plotted.
```
mod_plotFactorOfValue_ui <- function(id){
ns <- NS(id)
tagList(
plotOutput(ns("plotFactorOfValue"))
)
}
NEED HELP HERE CREATE THE FACTOROFVALUE VARIABLE TO PASS THROUGH AS PARAMETER IN THIS
FUNCTION
mod_plotFactorOfValue_server <- function(id, dataset, factorOfValue){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$plotFactorOfValue <- renderPlot({
req(dataset())
mtdf <- dataset()
x <- mtdf[[factorOfValue]]
df2 <- dataset() %>%
ggplot(aes(x, mpg))+
geom_point(aes(color = mpg, size = 1,))+
geom_smooth(method = lm, se = F)+
theme( axis.line = element_line(colour = "darkblue",
size = 1, linetype = "solid"))
return(plot(df2))
})
})
}
```
UI and Server Sections of App
==============
```
ui <- fluidPage(theme = shinytheme("darkly"),
navbarPage(
theme = "cerulean",
"Market Analysis Tool",
# Import Tab----
tabPanel("Import",
sidebarPanel(
tags$h3("Input Comparables Data:"),
mod_import_ui("import_1"),
tags$h3("Input Whole Hood Data:"),
mod_import_ui("import_2")
),
mainPanel(
mod_importedDataTable_ui("importedDataTable_1"),
mod_importedDataTable_ui("importedDataTable_2")
), #main panel Import
), #tab panel import
# Comparables Graphs Tab----
tabPanel("Comparables Graphs",
sidebarPanel(
tags$h3("Check out these trends!"),
),
mainPanel(
mod_plotFactorOfValue_ui("plotFactorOfValue_1")
), #main panel Comparables Graphs
)
) #navbar page
) #fluid page
server <- function(input, output, session) {
####Import the Data----
datasetComparables <- mod_import_server("import_1")
datasetWholeHood <- mod_import_server("import_2")
#### Output the Data Tables----
mod_importedDataTable_server("importedDataTable_1", dataset = dtreact)
mod_importedDataTable_server("importedDataTable_2", dataset = datasetWholeHood)
######## STARTING THE PLOTS HERE----
```
#I am unable to get the dataframe to be recognized, I am also unable to get the
xvariable(factorOfValue) hardcoded as a parameter in my call function.
# Can you please help with this? THis is still part of the server section.
```
mod_plotFactorOfValue_server("plotFactorOfValue_1", dataset = datasetComparables,
factorOfValue = "SqFtTotal")
}
shinyApp(ui = ui, server = server)
```
You don't need to plot a ggplot object. Try this
library(shinythemes)
library(DT)
mod_import_ui <- function(id){
ns <- NS(id)
tagList(
fileInput(ns("file1"), label = "Choose CSV File", accept = ".csv")
#, checkboxInput(ns("header"), label = "Header", TRUE)
)
}
mod_import_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
dtreact <- reactive({
file <- input$file1
if(is.null(file))
return(NULL)
read.csv(file$datapath
# header = input$header
)
})
# Return the reactive that yields the data frame
return(dtreact)
})
}
### Module for displaying imported data as a table, this used the dataframe datasetComparables or datasetWholeHood when called.
mod_importedDataTable_ui <- function(id){
ns <- NS(id)
tagList(
DTOutput(ns("contents"))
)
}
mod_importedDataTable_server <- function(id, dataset){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$contents <- renderDT({
req(dataset())
df1 <- dataset()
return(datatable(df1))
})
})
}
# A shiny Module that uses ggplot to plot a parameter(factorOfValue) from an imported
# dataset.The user should NOT be selecting the factor to be plotted.
mod_plotFactorOfValue_ui <- function(id){
ns <- NS(id)
tagList(
plotOutput(ns("plotFactorOfValue"))
)
}
### NEED HELP HERE CREATE THE FACTOROFVALUE VARIABLE TO PASS THROUGH AS PARAMETER IN THIS FUNCTION
mod_plotFactorOfValue_server <- function(id, dataset, factorOfValue){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$plotFactorOfValue <- renderPlot({
req(dataset())
mtdf <- dataset()
x <- mtdf[[factorOfValue]]
df2 <- dataset() %>%
ggplot(aes(x, mpg)) +
geom_point(aes(color = mpg, size = 1))+
geom_smooth(method = lm, se = F)+
theme( axis.line = element_line(colour = "darkblue", size = 1, linetype = "solid"))
return(df2)
})
})
}
# UI and Server Sections of App
ui <- fluidPage(theme = shinytheme("darkly"),
navbarPage(
theme = "cerulean",
"Market Analysis Tool",
# Import Tab----
tabPanel("Import",
sidebarPanel(
tags$h3("Input Comparables Data:"),
mod_import_ui("import_1"),
tags$h3("Input Whole Hood Data:"),
mod_import_ui("import_2")
),
mainPanel(
mod_importedDataTable_ui("importedDataTable_1"),
mod_importedDataTable_ui("importedDataTable_2")
), #main panel Import
), #tab panel import
# Comparables Graphs Tab----
tabPanel("Comparables Graphs",
sidebarPanel(
tags$h3("Check out these trends!")
),
mainPanel(
mod_plotFactorOfValue_ui("plotFactorOfValue_1")
), #main panel Comparables Graphs
)
) #navbar page
) #fluid page
server <- function(input, output, session) {
####Import the Data----
datasetComparables <- mod_import_server("import_1")
datasetWholeHood <- mod_import_server("import_2")
#### Output the Data Tables----
mod_importedDataTable_server("importedDataTable_1", dataset = datasetComparables)
mod_importedDataTable_server("importedDataTable_2", dataset = datasetWholeHood)
######## STARTING THE PLOTS HERE----
# I am unable to get the dataframe to be recognized, I am also unable to get the
# xvariable(factorOfValue) hardcoded as a parameter in my call function.
# Can you please help with this? THis is still part of the server section.
mod_plotFactorOfValue_server("plotFactorOfValue_1", dataset = datasetComparables,
factorOfValue = "cyl" ) ## "SqFtTotal"
}
shinyApp(ui = ui, server = server)

Looping Shiny callModule only exports last value

I am trying to build an app which; 1) calculates the number of boxes, based on a data.frame, 2) For each box, creates a UI and a corresponding module that will trigger events when the action buttons are clicked, using a subset of that data.frame.
If I am not being explicit enough; the app has n UI's and in each UI, x buttons. I want to loop callModule to create n server functions so when I click on action button in any given UI, I trigger an event specific to that UI.
The problem I am having is that the callModule function apparently does not duplicate itself in a for loop. Instead, I always get only the last id and dataframe (as if the callModule overwrites itself).
I hope I was explicit enough. Here is a MWE:
server.R
library(shinydashboardPlus)
library(shiny)
library(shinydashboard)
source('modules.R')
shinyServer(function(input, output, session) {
# dataframe filtered / updated
dtst <- reactive({
iris[1:input$filter_d, ]
})
# number of items rendered
output$ui <- renderUI({
r <- tagList()
for(k in 1:input$n){
r[[k]] <- u_SimpleTaskView(id = k, d = dtst()[k, ]) # <- grab a subset or column of df
}
r
})
for(y in 1:isolate({input$n})){
callModule(m_UpdateTask, id = y, d = dtst()[, y])
}
})
ui.R
dheader <- dashboardHeaderPlus(title = "s")
dsidebar <- dashboardSidebar(
sidebarMenu(
menuItem("tst", tabName = "tst", icon = icon("bolt"))
)
)
dbody <- dashboardBody(
tabItems(
tabItem(tabName = "tst",
numericInput("n", "number of ui and module pairs", value = 10),
numericInput("filter_d", "RANDOM FILTER", value = 100),
uiOutput("ui")
)
) )
dashboardPagePlus(
title = "s",
header = dheader,
sidebar = dsidebar,
body = dbody
)
modules.R
u_SimpleTaskView <- function(id, d){
ns <- NS(id)
if(length(d) < 5){
# nothing
}else{
renderUI({
tagList(
br(),
HTML(paste0("<strong>Rows: </strong>", "xxxx")),
numericInput("divider", label = "number of rows", value = 2),
br(),
actionButton("go", "go")
)
})
}
}
m_UpdateTask <- function(input, output, session, d){
observeEvent(input$go, {
showModal(
modalDialog(
HTML(paste0("unique: ", length(unique(d))/input$divider ) )
)
)
})
}
Besides not being really minimal (no need for libraries shinydashboardPlus or shinydashboard) there are a couple of issues with your code.
renderUI is a server function not a UI function
If you create controls in the module UI you have to use the namespace function, otherwise you cannot use them in your module server function.
As it is a bit too complicated for me to debug your code directly, let me give you an example from which you can see how to use modules in the way you wanted:
library(shiny)
library(glue)
mod_ui <- function(id, base_df) { ## 3
ns <- NS(id) ## 1
tagList(
helpText(glue("The input parameter 'base_df' has {NROW(base_df)} rows.")),
numericInput(ns("n"), "n:", 2),
textOutput(ns("out"))
)
}
mod <- function(input, output, session) {
get_nr <- reactive(input$n) ## 2
output$out <- renderText(glue("Number selected: {get_nr()}"))
return(list(get_nr = get_nr)) ## 4
}
ui <- fluidPage(
numericInput("n", "number of uis:", 2),
uiOutput("uis"),
textOutput("sum")
)
server <- function(input, output, session) {
handlers <- list()
output$uis <- renderUI({
ret <- lapply(seq.int(input$n),
function(i) mod_ui(glue("mod_{i}"),
data.frame(x = seq.int(i)))) ## 5
tagList(ret)
})
observe(
handlers <<- lapply(seq.int(input$n),
function(i) callModule(mod, glue("mod_{i}"))) ## 6
)
output$sum <- renderText({ ## 7
req(length(handlers) > 0)
m_sum <- sum(sapply(handlers, function(h) h$get_nr()))
glue("Sum of all n: {m_sum}")
})
}
shinyApp(ui, server)
Explanation
In mod_ui we define all the elements one module should have. note the use of ns() for the controls' ids to make use of the namespacing.
In mod (the module server function) we can access controls as we would in the main server function ( i.e. directly liek in input$n.
We can pass arguments to any of the module's functions (like base_df).
If we want to use some of the reactives in the main app, we shoudl return them from the modules server function.
In our main app we use a loop to create the desired number of modules.
We use an observer to store the handlers from the modules in a list
We can access the modules reactives via the handler which we defined earlier.
Update 2021
shiny 1.5.0 introduced an easier interface for modules. The code below uses this "new" interface:
library(shiny)
library(glue)
mod_ui <- function(id, base_df) {
ns <- NS(id)
tagList(
helpText(glue("The input parameter 'base_df' has {NROW(base_df)} rows.")),
numericInput(ns("n"), "n:", 2),
textOutput(ns("out"))
)
}
mod <- function(id) {
moduleServer(id,
function(input, output, session) {
get_nr <- reactive(input$n)
output$out <- renderText(glue("Number selected: {get_nr()}"))
return(list(get_nr = get_nr))
}
)
}
ui <- fluidPage(
numericInput("n", "number of uis:", 2),
uiOutput("uis"),
textOutput("sum")
)
server <- function(input, output, session) {
handlers <- list()
output$uis <- renderUI({
ret <- lapply(seq.int(input$n),
function(i) mod_ui(glue("mod_{i}"),
data.frame(x = seq.int(i))))
tagList(ret)
})
observe({
handlers <<- lapply(seq.int(input$n),
function(i) mod(glue("mod_{i}")))
})
output$sum <- renderText({
req(length(handlers) > 0)
m_sum <- sum(sapply(handlers, function(h) {
res <- h$get_nr()
if(is.null(res)) {
0
} else {
res
}
}))
glue("Sum of all n: {m_sum}")
})
}
shinyApp(ui, server)

renderHighchart inside module using reactive dataset

I am trying to create a Shiny App based on modules and I need to add a highchart inside a module where the graph updates when the user selects a value from a selectInput dropdown. The idea is that when the user select a value from a selectInput box in the UI, this filters a dataset and then the highchart is updated. The problem is that I am not able to pass the filtered dataset to the myModuleServer (see below). How can I do this?
This is the dataset:
df <- data.frame(label = c('A','B'), value = c(10,25))
These are the modules UI and Server:
myModuleUI <- function(id) {
ns <- NS(id)
tagList(
textOutput(ns("title")),
textOutput(ns("text")),
highchartOutput(ns("graph")))}
myModuleServer <- function(input, output, session, action, dataset) {
output$title <- renderText({paste0("You selected letter: ",action())})
output$text <- renderText({paste0("In the dataset the letter selected corresponds to number: ", dataset()$value)})
output$graph <- renderHighchart({hchart(dataset(), 'bar', hcaes(x=dataset()$label, y=dataset()$value))})
}
Below both the UI and Server components of a Shiny App:
ui <- fluidPage(
fluidRow(
column(width = 3, wellPanel(selectInput('dummy', 'Select a letter', choices = c('A', 'B')))),
column(width = 6, myModuleUI("module1")))
)
server <- function(input, output, session) {
reactiveData <- reactive({input$dummy})
reactiveDataSet <- reactive({df %>% filter(label == input$dummy)})
callModule(myModuleServer, 'module1', action = reactiveData, dataset = reactiveDataSet)
}
shinyApp(ui, server)

Using results/output from one shiny module to updateSelectInput within another

In figuring out how to use the new shiny modules, I would like to emulate the following app. When the rows of the datatable are clicked and unclicked, it updates the entries in the selectInput box, using updateSelectInput.
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('car_input', 'Select car:', df$model, multiple = TRUE)
),
mainPanel(
DT::dataTableOutput('table')
)
)
)
server <- function(input, output, session, ...) {
output$table <- DT::renderDataTable(df)
car_rows_selected <- reactive(car_names[input$table_rows_selected, ])
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
shinyApp(ui = ui, server = server)
I have got most of the way there, but am having difficulty with updating the input box. I wonder if it has something to do with the way the namespaces work, and perhaps requires a nested call to the DFTable module within the Car module, but I'm not sure. I am able to add a textOutput element that prints the expected information from the selected table rows. My code for a single file app is below:
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## select module ---------------------------------------------------------------
CarInput <- function(id){
ns <- NS(id)
selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}
Car <- function(input, output, session, ...) {
# I was thinking perhaps I needed to call the DFTable module as a nested module within this Car module
car_rows_selected <- callModule(DFTable, 'id_inner')
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('table'))
}
DFTable <- function(input, output, session, ...){
output$table <- DT::renderDataTable(df)
return(reactive(car_names[input$table_rows_selected, ]))
}
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
CarInput('id_car'),
textOutput('selected') # NB. this outputs expected values
),
mainPanel(
DFTableOutput('id_table')
)
)
)
server <- function(input, output, session, ...) {
callModule(Car, 'id_car')
callModule(DFTable, 'id_table')
output$selected <- callModule(DFTable, 'id_table') # NB this works as expected (see textOutput in ui section above)
car_rows_selected <- callModule(DFTable, 'id_table')
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
shinyApp(ui = ui, server = server)
Any help would be greatly appreciated
OK, a little more trial and error got me to the right answer - the car_rows_selected item needed to be given the double arrow <<- operator in the app server function in order for it to be useable in the Car module: look for the car_rows_selected <<- callModule(DFTable, 'id_table') in the server function
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## select module ---------------------------------------------------------------
CarInput <- function(id){
ns <- NS(id)
selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}
Car <- function(input, output, session, ...) {
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('table'))
}
DFTable <- function(input, output, session, ...){
output$table <- DT::renderDataTable(df)
reactive(car_names[input$table_rows_selected, ])
}
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
CarInput('id_car')
),
mainPanel(
DFTableOutput('id_table')
)
)
)
server <- function(input, output, session, ...) {
callModule(Car, 'id_car')
car_rows_selected <<- callModule(DFTable, 'id_table')
}
shinyApp(ui = ui, server = server)
I'm still getting my head around the way module namespaces work - perhaps this isn't the most "correct" approach but at least it works - happy to accept a more appropriate answer if someone posts one later

Resources