I'm new to R and Shiny, and I'm writing a Shiny app that allows the user to create/read/update/delete records in a MariaDB database. When the user adds a record, I want the UI to display the updated contents of the table.
It works if all the code is in a single app.R, but when I break it into Shiny modules (saveNew and displaytbl), I can't get the datatable to automatically update, probably because I haven't figured out the correct reactive 'plumbing' that I need to pass data between modules.
app.R:
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
fluidRow(
saveNewUI("saveNew")),
fluidRow(
displaytblUI("displaytbl")
)
)
server <- function(input, output, session) {
# Load initial contents from database
tibl <- reactiveVal(loadSites())
# Display table
observeEvent(tibl(), { # without observe(), can't access tibl outside reactive context
displaytblServer("displaytbl", tibl())
})
# Save a new record to the table, and update the tibl reactiveVal
tibl(saveNewServer("saveNew"))
}
shinyApp(ui, server)
displaytbl.R:
library(shiny)
library(DT)
displaytblUI <- function(id) {
ns <- NS(id)
tagList(
DT::dataTableOutput(ns("datatable"))
)
}
displaytblServer <- function(id, datatable) {
moduleServer(id, function(input, output, session) {
observeEvent(datatable, {
output$datatable <- renderDataTable(datatable())
})
})
}
saveNew.R:
library(shiny)
saveNewUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("siteName"), "Add a site"),
actionButton(ns("btnSave"), "Save"),
)
}
saveNewServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$btnSave, {
saveSite(input$siteName)
})
# Return the updated database table
reactive(loadSites())
})
}
database.R (helper functions):
loadSites <- function() {
query <- "SELECT * FROM names"
res <- as_tibble(dbGetQuery(pool, query))
}
saveSite <- function(siteName) {
query <- paste0("INSERT INTO names (name) VALUES (?)")
params <- list(siteName)
dbExecute(pool, query, params)
}
Expecting the datatable to update when the user clicks the Save button. The database gets updated, but the datatable in the UI does not (until I reload/refresh the app).
After incorporating suggestions from #remko-duursma, I was able to get rid of my error by removing the observeEvent() from my app server(), and also passing the tibl reactiveVal as an argument to saveNewServer(), where it's used to update the database. My working code is below.
app server function:
server <- function(input, output, session) {
# Load initial contents from database
tibl <- reactiveVal(loadSites())
# Display table
displaytblServer("displaytbl", tibl)
saveNewServer("saveNew", tibl)
}
saveNewServer function:
saveNewServer <- function(id, tibl) {
moduleServer(id, function(input, output, session) {
observeEvent(input$btnSave, {
saveSite(input$siteName)
tibl(loadSites())
})
})
}
displaytblServer function:
displaytblServer <- function(id, datatable) {
moduleServer(id, function(input, output, session) {
output$datatable <- renderDataTable(datatable())
})
}
Related
I am stuck about how to know whether a button inside a Shiny module is pressed. In this simplified example below, I created a module (buttonUI, buttonServer): there is a button inside this module, and my goal is to "know" (detect) this button is pressed from outside of the module.
buttonUI <- function(id) {
ns <- NS(id)
tagList(actionButton(ns("btn"), "a button label")
)}
buttonServer <- function(id, parent) {
moduleServer(id,
## Below is the module function
function(input, output, session) {
ns <- session$ns
ret <- reactiveVal(0)
observeEvent(input$btn,{
message("inner", ret())
ret(ret()+1)
})
list(n = reactive(ret))
})
}
ui <- fluidPage(
buttonUI("mod")
)
server <- function(input, output, session) {
v = buttonServer("mod")
observeEvent(v$n, {
message("outer")
})
}
shinyApp(ui, server)
I expected to see many outputs of "outer" when I clicked the button, but I do not see any.
PS: I have tried to return a single reactive value (return(ret)) instead of a list (e.g., list(n = reactive(ret))). I found return(ret) will work, but do not know why it works. However, I need the module to return a list instead of a single value.
There is a trick to pass values from outside to inside shiny module and from inside to outside. It consists in using reactiveValues : you initialise a reactiveValues in your server, you pass it as an argument in you server module, and it is changed inside the module AND outside the module.
You can check this page for more examples.
PS: reactiveValues is a list, so you can pass as much variables as you want inside/ outstide your module(s)
buttonUI <- function(id) {
ns <- NS(id)
tagList(actionButton(ns("btn"), "a button label")
)}
buttonServer <- function(id, parent, rv) { #rv is an argument
moduleServer(id,
## Below is the module function
function(input, output, session) {
ns <- session$ns
ret <- reactiveVal(0)
observeEvent(input$btn,{
rv$btn <- input$btn #increment rv
message("rv_inner", rv$btn)
message("inner", ret())
ret(ret()+1)
})
list(n = reactive(ret)) # no need to return rv
})
}
ui <- fluidPage(
buttonUI("mod")
)
server <- function(input, output, session) {
rv <- reactiveValues(btn = NULL) # initialise reactiveValues
v = buttonServer("mod", rv = rv) # pass reactiveValues as argument
observeEvent(v$n, {
message("outer")
})
observeEvent(rv$btn, { #check rv$btn value
message("rv_outer", rv$btn)
})
}
shinyApp(ui, server)
Here I used a simple trick.
As stated before, you can return a reactive value from a moduleServer and use that value to determine if the button was pressed
In my case, I used an eventReactive() so you can tie a reactive value directly to the actions related to the button
library(shiny)
buttonUI <- function(id) {
ns <- NS(id)
actionButton(ns("btn"), "a button label")
}
buttonServer <- function(id) {
moduleServer(id, function(input, output, session) {
isPressed <- eventReactive(input$btn, {
if(input$btn){
"The button was pressed"
} else {
"The button was NOT pressed"
}
}, ignoreNULL = FALSE)
return(isPressed())
})
}
ui <- fluidPage(
buttonUI("mod"),
textOutput("text")
)
server <- function(input, output, session) {
output$text <- renderText({
buttonServer("mod")
})
}
shinyApp(ui, server)
What I want to achieve is to get access to the reactive value passed to a parent module from a child module. The reproducible example below shows the idea. When i click the button in mod_server_btn then its value should be printed out in the console (from within parent module):
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
cond <- reactive({ input$confirm})
return(cond)
}
ui =fluidPage(
mod_ui_btn("test"),
uiOutput("example")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
print(value)
#print(value$cond) # these 3 don't work either
#print(value()$cond)
#print(value())
})
shinyApp(ui=ui,server=server)
However, it doesn't work. When I click the button then I got a text: reactive({input$confirm}) in the console and it's not what I want, I need to access button value. General question is - is it possible at all to get access to reactive value in a parent module?
EDIT: #rbasa, #YBS thanks for your answers. In fact in my real app I need to return more than one reactive value to parent module. Below is slightly changed code - I added second button in mod_ui_btn - now I need to return values from both buttons to the server module. I made a list of reactives but can't get access to them using observe or output$example <-:
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
return(
list(
cond = reactive({ input$confirm}),
cond2 = reactive({ input$confirm2})
)
)
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
output$example <- renderPrint(value$cond)
output$example2 <- renderPrint(value$cond2)
observe({
print(value$cond) #this is how I usually catch reactives - by their name
print(value$cond2)
})
})
shinyApp(ui=ui,server=server)
I usually use return(list(..some reactive values)) to return more than one ractive value to other module and catch then using their names in parent module. Here it doesn't work even if I use observe. No value is returned.
You can access with value(). I would recommend to change your mod_server_btn to the one shown below, and notice the call in server. EDIT: updated for multiple variables. Try this
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(id) {
moduleServer(id, function(input, output, session) {
return(
list(
cond = reactive(input$confirm),
cond2 = reactive(input$confirm2)
)
)
})
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
# value <- callModule(mod_server_btn,"test")
value <- mod_server_btn("test")
output$example <- renderPrint(value$cond())
output$example2 <- renderPrint(value$cond2())
observe({
print(value$cond()) #this is how I usually catch reactives - by their name
print(value$cond2())
})
})
shinyApp(ui=ui,server=server)
I'm trying to modularize a shiny app. So far it worked out smoothly, but I'm having trouble designing a system with two modules A and B, where A needs data from B and B needs data from A.
To start off, following this tutorial (Shiny version 1.5) I got this very basic self-contained example to work.
library(shiny)
#######################
# FILE MODULE #
# Load and save value #
#######################
fileModuleUI <- function(id) {
ns <- NS(id)
tagList(
fileInput(ns("fileInput"), "Input"),
downloadButton(ns("fileOutput"), "Save problem")
)
}
fileModuleServer <- function(id, textFieldData) {
moduleServer(
id,
function(input, output, session) {
# Write observer
output$fileOutput <- downloadHandler(
filename = function() { "myfile.dcf" },
content = function(file) { dput(textFieldData(), file) }
)
# Read observers
userFile <- reactive({
validate(need(input$fileInput, message = FALSE))
input$fileInput
})
fileContent <- reactive({
dget(userFile()$datapath)
})
return(fileContent)
}
)
}
###############
# MAIN UI #
###############
ui <- fluidPage(
sidebarLayout(
sidebarPanel(fileModuleUI("dataHandler")),
mainPanel(textInput("mainData", label = "Type your data in here"))
)
)
server <- function(input, output, session) {
fileContent <- fileModuleServer("dataHandler", reactive(input$mainData))
observe({
updateTextInput(session, "mainData", value = fileContent())
})
}
shinyApp(ui = ui, server = server)
With this nifty tool I can load and save one line of text from a textInput in a file.
Now I would like to also modularize the content inside my mainPanel. Let's call it mainModule.
While it's simple enough to build the mainModuleUI, the mainModuleServer introduces some cross-dependency issue:
fileModuleServer needs to know of the textfield of mainModuleServer so it can save its value in a file
mainModuleServer needs to know of the file content from fileModuleServer so it can update its text input field when a file has been loaded
The servers thus may look a little like this:
fileModuleServer <- function(id, textFieldData) { ... }
mainModuleServer <- function(id, fileContent) { ... }
server <- function(input, output, session) {
# what to pass as second parameter?
fileContent <- fileModuleServer("dataHandler", ???)
# would passing fileContent even work?
mainModuleServer("mainPanel", fileContent)
}
What's a good way to work around that?
I got it to work by introducing a reactiveValue in my main app. Then I pass that value to my servers and either change its value by writing value('this is some new value') or read its value by calling value().
This may look something like this:
# Module A
moduleAServer <- function(id, someData) {
moduleServer(
id,
function(input, output, session) {
# when clicking on load-button, just pretend to load some data
observeEvent(input$load, {
someData('This is the new data!')
})
observeEvent(input$save, {
print(paste('Saving the following:', someData()))
})
}
)
}
# Module B
moduleBServer <- function(id, someData) {
moduleServer(
id,
function(input, output, session) {
# observe will be called when Module A changes the data inside someData
observe({
# not sure if I need this req
req(someData)
print(paste('some Data changed to', someData()))
})
}
)
}
mainServer <- function(input, output, session) {
someData <- reactiveVal('oh')
chosenFile <- moduleAServer('filePanel', someData)
inputServer <- moduleBServer('mainPanel', someData)
}
Getting started with shiny, I try to learn how to use the Shiny Module design pattern. As the most simple example, I want to display a dataset without any further interaction.
I wish to organise the UI in tabPanels of a navbarPage. Each panel is independent from each other, (except that all panels use a global database connection objects, but this does not bother me now).
Here is the code for the DT GUI element:
library(shiny)
library(DT)
tabTable <- function(id) {
ns <- shiny::NS(id)
tabPanel(
"Table",
shiny::dataTableOutput(ns("table"))
)
}
This is the server logic. I want it to draw the data table.
srvTable <- function(id, dat) shiny::moduleServer(id,
function(input, output, session) {
output$table <- shiny::renderDataTable({DT::datatable(dat)})
}
)
Now here is the definition of the ui and the server:
ui <- shiny::navbarPage(title="Test",
tabTable(id="iris"),
shiny::tabPanel(title="Scatter")
)
server <- function(input, output, session) {
srvTable(id="iris", dat=iris)
session$onSessionEnded(stopApp)
}
shiny::shinyApp(ui, server)
This app starts, it displays the navigation bar, but it does not show the dataset. Any hint where I put the command for that? The problem for me is that there is no obvious condition that the server module needs to react to. What is to do in this case?
Try this
library(shiny)
library(DT)
tabTable <- function(id) {
ns <- shiny::NS(id)
tabPanel(
"Table",
DTOutput(ns("table"))
)
}
srvTable <- function(id, dat) { shiny::moduleServer(id,
function(input, output, session) {
output$table <- renderDT({DT::datatable(dat)})
}
)}
ui <- shiny::navbarPage(title="Test",
tabTable(id="iris"),
shiny::tabPanel(title="Scatter")
)
server <- function(input, output, session) {
srvTable(id="iris", dat=iris)
session$onSessionEnded(stopApp)
}
shiny::shinyApp(ui, server)
I have a largish shiny app, where multiple elements change reactiveVals. Now I want to port the app to use shiny modules to be able to test it more appropriately. But I am not able to access the reactive values that are defined inside the server function.
MWE
A simple app that highlights my thought process so far is this counter app.
The app consists two modules: counter and display
counter increases the reactive counter value on the click of a button
display watches the counter and displays its output to a text-field
The main part of the app is a "central" reactive value called counter_reactive, which holds the current count.
This value is set by the counter and read by the display module elements.
library(shiny)
######################
# Counter Module
counter_UI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("button"), "Increase Count")
)
}
counter <- function(input, output, session) {
observeEvent(input$button, {
counter_reactive(counter_reactive() + 1)
cat("Increase Counter by 1 to", counter_reactive(), "\n")
})
}
######################
# Display Module
display_UI <- function(id) {
ns <- NS(id)
tagList(
verbatimTextOutput(ns("text_output"))
)
}
display <- function(input, output, session) {
observe({
cat("Print Value of Counter\n")
output$text_output <- renderText(sprintf("Counter is now %i", counter_reactive()))
})
}
######################
# Rest of the Shiny App
ui <- fluidPage(
counter_UI("counter1"),
display_UI("display1")
)
server <- function(input, output, session) {
# Note that counter_reactive is defined inside the "global" server function,
# as multiple modules should read and write to it.
counter_reactive <- reactiveVal(0)
callModule(counter, "counter1")
callModule(display, "display1")
}
shinyApp(ui, server)
However, this app throws the error Warning: Error in counter_reactive: could not find function "counter_reactive".
Any ideas how to get/change the reactive value inside the module?
Rubber-Ducky-Debugging (aka SO-Question Writing Debugging) to the rescue, this works:
Simply passing the reactive value to the functions like so
counter <- function(input, output, session, counter_reactive) {
observeEvent(input$button, {
counter_reactive(counter_reactive() + 1)
cat("Increase Counter by 1 to", counter_reactive(), "\n")
})
}
display <- function(input, output, session, counter_reactive) {
observe({
cat("Print Value of Counter\n")
output$text_output <- renderText(sprintf("Counter is now %i", counter_reactive()))
})
}
server <- function(input, output, session) {
counter_reactive <- reactiveVal(0)
callModule(counter, "counter1", counter_reactive)
callModule(display, "display1", counter_reactive)
}