Rendering of uiOutput in shinyWidget::dropdownButton - r

I have a uiOutput in a shinyWidget::dropdownButton. My problem is that outputs which depend on the control in uiOutput are not rendered before I click the dropdown button.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(uiOutput("placeholder"), icon = icon("cog")),
verbatimTextOutput("out")
)
server <- function(input, output) {
output$placeholder <- renderUI(selectInput("dat", "Select Data:",
choices = c("mtcars", "ChickWeight")))
output$out <- renderPrint(summary(get(req(input$dat))))
}
shinyApp(ui, server)
In this app you see that the summary table is only shown after I have clicked the dropdown button for the first time. From a reactive flow I guess it makes sense, but I would like to know how I force the uiOutput to render (such that the subsequent out verbatim can render)?

You can do like this:
server <- function(input, output) {
output$placeholder <- renderUI(selectInput("dat", "Select Data:",
choices = c("mtcars", "ChickWeight")))
outputOptions(output, "placeholder", suspendWhenHidden=FALSE)
output$out <- renderPrint(summary(get(req(input$dat))))
}

Related

Change the title by pressing a shiny button Shiny R

library(shiny)
ui <- fluidPage(
h1("Free",align = "center"),
actionButton("go", "Go")
)
server <- function(input, output) {
observeEvent(input$go,{
#change the h1 title for
code("Busy",align="center")
}
}
shinyApp(ui, server)
How to change the title when pressing a button? the idea is to change the word free to busy when the button is pressed.
Would make the h1 header using uiOutput in the ui. Then, you can dynamically change this text to whatever you want in server. Perhaps for your example, you can have a reactiveVal that contains the text you want in the header, which can be modified in your case when the actionButton is pressed.
library(shiny)
ui <- fluidPage(
uiOutput("text_header"),
actionButton("go", "Go")
)
server <- function(input, output) {
rv <- reactiveVal("Free")
observeEvent(input$go, {
rv("Busy")
})
output$text_header <- renderUI({
h1(rv(), align = "center")
})
}
shinyApp(ui, server)

In shiny, how to have a new actionButton when a different variable is selected?

I have a simple task of printing the output of a call to table() on a selected variable.
I want to display the output when the button "Print" is clicked.
In the following example, once the button is clicked, the output is always triggered when I change the selected variable.
If I clicked "Print", and then change the selected variable, I want the ouput to be gone, waited to be printed again when clicking "Print".
Thank you!
Here is a reproducible example:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab = reactive( table(data[[input$selectedvar]]) )
observeEvent(input$print, {
output$info = renderPrint( tab() )
})
}
shinyApp(ui, server)
That's because output$info is reactive to tab(), even while it is enclosed in an observeEvent. I think this app does what you want:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab <- reactiveVal()
observeEvent(input$selectedvar, {
tab(NULL)
})
observeEvent(input$print, {
tab(table(data[[input$selectedvar]]))
})
output$info <- renderPrint({
tab()
})
}
shinyApp(ui, server)

Shiny: Render Outputs when hidden

I am trying to render a few outputs in a shiny application that are contained within a shinyjs::hidden section upon the application running rather than once the section is visible.
EDIT: I had the app set up incorrectly in the original example so have changed it.
I want to be able to run the reactive statement before running the final observe to change the UI from the Alpha text to the Beta text and plot. Ideally this would mean in the console would see "Done plotting" before "Observe run".
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id = "before-content", h3("Aux Text Alpha")),
shinyjs::hidden(
div(
id = "after-content",
h1("Aux Text Beta"),
plotOutput("text")
)
)
)
server <- function( session,input, output) {
in_plot <- reactive({
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observe({
print("Observe run")
hide("before-content")
show("after-content")
})
}
shinyApp(ui, server)
An alternative would be to have a layer over what is classed as the hidden section but am not too sure on how that is accomplished.
You can hide it in the reactive, like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Click me"),
plotOutput("text")
)
server <- function( session,input, output) {
in_plot <- reactive({
hide("text")
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observeEvent(input$button, {
show("text")
})
}
shinyApp(ui, server)

Shiny: add button label to sidebar & update buttons after click

I'm a bit rusty to Shiny reactivity, but I want to do two things when a button is clicked:
add that button label to the sidebar (and add more labels to sidebar after more clicks)
update the button labels (i.e. more random integers)
I'm nervous about changing the label before recording it, so I want to get the timing right. Here's a skeleton of what I'm working with:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
output$clicks <- renderText({
paste()
})
## reactive values
inside <- reactive({
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)
Right now the sidebar is blank because I'm not sure how to add it, or what to add to make the button labels update after a click (whether to do it inside a reactive value or an observeEvent). Any help is much appreciated!
Here's a way to do it with reactiveValues:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
# Show history
output$clicks <- renderText({
history[['clicked']]
})
## reactive values
# store history as reactive values
history <- reactiveValues(clicked = c())
# update history when a button is clicked
observeEvent(input$course1,{
history[['clicked']] <- c(history[['clicked']],inside()[1])
})
observeEvent(input$course2,{
history[['clicked']] <- c(history[['clicked']],inside()[2])
})
#update inside when history updates
inside <- reactive({
history[['clicked']]
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)

widget example of actionbutton in shiny doesn't work

I'm playing around with shiny, and can't get the simplest action button example to work.
First example found here:http://shiny.rstudio.com/gallery/widgets-gallery.html
Below are the code, which is a copy paste from the website.
#ui.R
shinyUI(fluidPage(
# Copy the line below to make an action button
actionButton("action", label = "Action"),
hr(),
fluidRow(column(2, verbatimTextOutput("value")))
))
#server.R
shinyServer(function(input, output) {
# You can access the value of the widget with input$action, e.g.
output$value <- renderPrint({ input$action })
})
Mine looks like:
http://imgur.com/t0Vx6Wr
edit:
The issue is that it also prints out some class information
Thanks
Use renderText rather then renderPrint if you want it to look like it does on the shiny website:
require(shiny)
runApp(list(ui = fluidPage(
actionButton("action", label = "Action"),
hr(),
fluidRow(column(2, verbatimTextOutput("value")))
)
, server = function(input, output) {
output$value <- renderText({ input$action })
})
)

Resources