Set an Output Component to Empty in R/Shiny - r

I have uiOutput and plotOutput components in my main Shiny panel.
plotOutput("plot_data"),
uiOutput("summary_data")
I have the typical code in the server function to react and populate each component, for example:
output$plot_data <- renderPlot({
hist(data_vars())
})
output$summary_data <- renderPrint({
summary(data_vars())
})
I'd like to add functionality to each that sets the output component of the other to NULL or an empty string, etc. so that these two outputs share the same space. When one has data, the other is empty. I don't think it would work this way, but it could look like this:
output$plot_data <- renderPlot({
# Code to "flatten" uiOutput
# Then populate the component
hist(data_vars())
})
output$summary_data <- renderPrint({
# Code to "flatten" plotOutput
# Then populate the component
summary(data_vars())
})
I think this might be done using observeEvent, but I haven't found a way to completely remove content from one so that the other could take up the same space on the page. Please help. Thank you.

Rather than having a separate plotOutput and printOutput, you can have just one uiOutput and then you can add code in the server to show which output you would like in that slot. Here's a working example where I added a button to swap between views.
library(shiny)
ui <- fluidPage(
actionButton("swap","Swap"),
uiOutput("showPart")
)
server <- function(input, output, session) {
showState <- reactiveVal(TRUE)
observeEvent(input$swap, {showState(!showState())})
output$plot_data <- renderPlot({
hist(mtcars$mpg)
})
output$summary_data <- renderPrint({
summary(mtcars)
})
output$showPart <- renderUI({
if (showState()) {
plotOutput("plot_data")
} else {
verbatimTextOutput("summary_data")
}
})
}
shinyApp(ui, server)
Using this method only one of the two output will be rendered in the uiOutput slot.

Related

R Shiny: Calling modules from inside another Shiny app confines them to only half my screen

I've encapsulated several small Shiny apps into modules. When calling these modules individually from the command line they display as expected, filling the entire page. I want to create an app where a user can select different modules from a menu. I've been trying to do this with navbarPage and tabPanel, but the modules always display at half the height of my screen.
I've tried wrapping various elements in divs/boxes and changing their height, but it only changes the height of the container around my modules, not the modules themselves. I'm pretty new to Shiny, and I think I must be misunderstanding something about the relationship between modules and the apps that call them.
Reproducible example:
WGStableUI <- function(id){ fluidPage(
dataTableOutput(NS(id,"dynamic"))
)
}
WGStableServer <- function(id){
moduleServer(id, function(input, output, session) {
#WGS_tbl <- tbl(connection,"WGS") %>% as_tibble()
#output$dynamic <- renderDataTable(WGS_tbl, options = list(pageLength = 5))
output$dynamic <- renderDataTable(mtcars, options = list(pageLength = 100))
})}
WGStableApp <- function() {
ui <- fluidPage(
WGStableUI("displayWGStable")
)
server <- function(input, output, session) {
WGStableServer("displayWGStable")
}
shinyApp(ui, server)
}
library(shiny)
source("./WGS_table_module.R")
ui <- navbarPage("title",
tabPanel("page1"),
tabPanel("page2",WGStableApp())
)
server <- function(input, output){}
shinyApp(ui,server)
Edit: still trying to figure this one out, I have realized that just calling a module from inside another app is causing an issue, the tabPanels have no effect. There are scroll bars, but I can't change the size of the display window. Same thing happens just doing:
library(shiny)
ui <- WGStableApp()
server <- function(input, output, session) {
}
shinyApp(ui, server)
I never figured out why this was happening, but I did find a solution. Instead of calling the UI and server modules together as I did above, I created another module, which called each UI and server element separately, and then I called that new module from an app.
Example:
menu_ui <- function(id) {
navbarPage("Menu",
tabPanel("WGS Epi Table",WGStableUI(NS(id, "infotable")))
)
}
menu_server <- function(id) {
moduleServer(id, function(input, output, session) {
WGStableServer("infotable")
})
}
demo_menu <- function() {
ui <- fluidPage(menu_ui("demomenu"))
server <- function(input, output, session) {
menu_server("demomenu")
}
shinyApp(ui, server)
}

Use readlines(prompt = ) in Shiny

I have a code that takes inputs using the readlines(prompt = ) function. Could you tell me which input function in Shiny will be adequate to adapt this code to a Shiny app?
I need an interactive function, I can't use a simple input with selectInput() because I have a lot of readlines(prompt = ) statements.
Something similar to this question:
Include interactive function in shiny to highlight "readlines" and "print"
Florian's answer is nice and easy to use, I would definitely recommend that! But in case you are keen on using prompts for inputs I am adding another solution, using javaScript:
This one shows a prompt when the user presses an actionButton and stores it in an input variable. (it doesn't necessarily have to be after a button press)
library(shiny)
ui <- fluidPage(
tags$head(tags$script("
$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'go') {
var text = prompt('Write me something nice:');
Shiny.onInputChange('mytext', text);
}
});"
)),
actionButton("go", "Click for prompt"),
textOutput("txt")
)
server <- function(input, output, session) {
output$txt <- renderText( {
input$mytext
})
}
shinyApp(ui, server)
Maybe you could use textArea for this purpose. Working example below, hope this helps!
library(shiny)
ui <- fluidPage(
tags$textarea(id="text", rows=4, cols=40),
htmlOutput('val')
)
server <- function(input,output)
{
output$val <- renderText({
text = gsub('\n','<br>',input$text)
text
})
}
shinyApp(ui,server)

Disabling buttons in Shiny

I am writing some Shiny code where the user will enter some inputs to the app and then click a an action button. The action button triggers a bunch of simulations to run that take a long time so I want once the action button is clicked for it to be disabled so that the user can't keep clicking it until the simulations are run. I came across the shinyjs::enable and shinyjs::disable functions but have been having a hard time utilizing them. Here is my server code:
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
shinyjs::enable("Button1")}
})
However, when I use this code, and click the action button nothing happens. I.e., teh action button doesn't grey out nor does the table get generated. However, when I take away the shinyjs::enable() command, i.e.,
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
}
})
The table gets generated first, and then the button goes grey, however I would have expected the button to go grey and then the table to generate itself.
What am I doing wrong here?
Here is my updated code based on Geovany's suggestion yet it still doesn't work for me
Button1Ready <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
RunButton1Ready$ok <- FALSE
RunButton1Ready$ok <- TRUE
})
output$SumUI1= renderUI({
if(Button1Ready$ok){
tableOutput("table")
shinyjs::enable("Button1")
}
})
where for clarification I have also:
output$table <- renderTable({
#My code....
)}
I think that you are using shinyjs::disable and shinyjs::enable in the same reactive function. You will only see the last effect. I will recommend you to split in different reactive functions the disable/enable and use an extra reactive variable to control the reactivation of the button.
I don't know how exactly your code is, but in the code below the main idea is illustrated.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("Button1", "Run"),
shinyjs::hidden(p(id = "text1", "Processing..."))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plotReady <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
shinyjs::show("text1")
plotReady$ok <- FALSE
# do some cool and complex stuff
Sys.sleep(2)
plotReady$ok <- TRUE
})
output$plot <-renderPlot({
if (plotReady$ok) {
shinyjs::enable("Button1")
shinyjs::hide("text1")
hist(rnorm(100, 4, 1),breaks = 50)
}
})
}
shinyApp(ui, server)

Multiple action buttons with one event handler in Shiny?

I'd like to have a variable number of identical actionButton()s on a page all handled by one observeEvent() function.
For example, in a variable-length table of tables, I'd like each interior table to have a button that links to more information on that table.
In standard HTML, you do this with a simple form, where you use a hidden input to designate the interior table number, like this:
<form ...>
<input id="table_number" type="hidden" value="1"/>
<input type="submit" value="Examine"/>
</form>
When a button is pressed, you can examine the hidden input to see which one it was.
Is there a way to do this in Shiny? The only solution I've come up with is to give each actionButton() it's own inputId. This requires a separate observeEvent() for each button. Those have to be created ahead of time, imposing a maximum number of buttons.
It only took me a couple of years, but I now have a much better answer to this question. You can use a JavaScript/jQuery function to put an on-click event handler on every button in a document, then use the Shiny.onInputChange() function to pass the ID of a button (<button id="xxx"...) that has been clicked to a single observer in your Shiny code.
There's a full description with code examples at One observer for all buttons in Shiny using JavaScript/jQuery
You could use shiny modules for this: you can have variable number of actionButton that are identical. These are defined in the ab_moduleUI part. They are handled by their own observeEvent but it has to be defined only once in the ab_module part.
With lapply any number of actionButton can be created.
Edit: You don't have to specify the number of buttons beforehand: use renderUI to generate UI elements at server side.
For demonstration purposes I added a numericInput to increase/decrease the number of modules to render.
# UI part of the module
ab_moduleUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("btn"), paste("ActionButton", id, sep="-")),
textOutput(ns("txt"))
)
)
}
# Server part of the module
ab_module <- function(input, output, session){
observeEvent(input$btn,{
output$txt <- renderText("More information shown")
})
}
# UI
ui <- fluidPage(
# lapply(paste0("mod", 1:no_btn), ab_moduleUI)
numericInput("num", "Number of buttons to show" ,value = 5, min = 3, max = 10),
uiOutput("ui")
)
# Server side
server <- function(input, output, session){
observeEvent(input$num, {
output$ui <- renderUI({
lapply(paste0("mod", 1:input$num), ab_moduleUI)
})
lapply(paste0("mod", 1:input$num), function(x) callModule(ab_module, x))
})
}
shinyApp(ui, server)
Read more about shiny modules here
Regarding the use of Shiny modules to answer my original question...
What I'd like to have is a way to have multiple buttons on a page that can be handled by a single observeEvent(), which is easy to do with traditional HTML forms, as shown in the original question.
GyD's demonstration code using Shiny modules almost solves the problem, but it doesn't actually return which button was pressed to the main server. It took me a long time, but I finally figured out how to write a module that does let the main server know which button was pressed:
actionInput <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("text"), label=NULL, value=id),
actionButton(ns("button"), "OK")
)
}
action <- function(input, output, session) {
eventReactive(input$button, {
return(input$text)
})
}
ui <- fluidPage(fluidRow(column(4, actionInput("b1")),
column(4, actionInput("b2")),
column(4, uiOutput("result"))))
server <-function(input, output, session) {
b1 <- callModule(action, "b1")
observeEvent(b1(), {
output$result = renderText(b1())
})
b2 <- callModule(action, "b2")
observeEvent(b2(), {
output$result = renderText(b2())
})
}
shinyApp(ui = ui, server = server)
(In a real application, I would make the textInputs invisible, as they're only there to provide an id for which button was pressed.)
This solution still requires an observeEvent() in the main server for each button. It may be possible to use modules in some other way to solve the problem, but I haven't been able to figure it out.
My original alternative, using a separate observeEvent() in the main server for each button, is actually quite a bit simpler than an expansion of this demo code would be for a hundred or more buttons.

Clickable links in Shiny Datatable

I created a table containing some HTML links using Shiny's renderDataTable. The links are not clickable, though, instead they render literally:
https://samizdat.shinyapps.io/zakazky/
Do you have any idea what could be wrong? It worked fine before upgrading Shiny to the version 0.11... Thanks!
I had the same problem. The escape = FALSE option for renderDataTable solved it, as you mentioned in the comments.
Here is complete code for an app with a table that has links.
If you are doing this, you will want each link to be unique based on a value in the table. I move this code into a function so its cleaner.
#app.R#
library(shiny)
createLink <- function(val) {
sprintf('Info',val)
}
ui <- fluidPage(
titlePanel("Table with Links!"),
sidebarLayout(
sidebarPanel(
h4("Click the link in the table to see
a google search for the car.")
),
mainPanel(
dataTableOutput('table1')
)
)
)
server <- function(input, output) {
output$table1 <- renderDataTable({
my_table <- cbind(rownames(mtcars), mtcars)
colnames(my_table)[1] <- 'car'
my_table$link <- createLink(my_table$car)
return(my_table)
}, escape = FALSE)
}
shinyApp(ui, server)

Resources