I have taken a sample code of one of the Shiny Flexdashboard.
In the sample code there is a drop down menu to select one region at a time.
I just want to know is there a way to select all the values in the drop down menu?
Kindly find the code in below link,
beta.rstudioconnect.com/jjallaire/shiny-embedding
for code, click "Source Code" on the top extreme right.
Regards,
Mohan
You can do
library(shiny)
ui = fluidPage(
selectInput("sel", NULL, letters[1:2], multiple = T),
actionButton("but", "all")
)
server <- function(input, output, session) {
observeEvent(input$but, {
updateSelectInput(session, "sel", selected = letters[1:2])
})
}
shinyApp(ui, server)
Use ?updateSelectInput to access the documentation on that function.
Related
In Shiny, one can use the following line to force displaying/refreshing an output even if not displayed within the ui:
outputOptions(output, "my_output", suspendWhenHidden = FALSE)
Is there a similar way to "force" input widget creation?
My context: I do have a button that pre-populate a textinput on another tab. Potentially, this textinput may not been generated yet if user didn't go to this specific tab. In such a case, the pre-population legitimely fails.
Good practice would probably be to use a reactiveValues, to feed it with the "pre-populate value" when clicking the button, and then to use this rv within the input widget creation. But I was wondering if a similar option as the above was available in Shiny.
Here’s a simple, working example of the situation I think you are describing.
That is, you don’t need to do anything special.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", textInput("b_text", "Add some B text"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
}
shinyApp(ui, server)
If the input you want to update is generated with uiOutput() then you can
use outputOptions() to force evaluation, like you already mentioned:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", uiOutput("b_panel"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
output$b_panel <- renderUI({
textInput("b_text", "Add some B text")
})
outputOptions(output, "b_panel", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
I am building a dashboard page where the user uploads a file and on clicking the actionbutton it should run the server code and show the output and also allow to download the output as file. Below is the code that shows the basic UI.
I would need help with the server function to render the output from the command in server function to the "Table" output in the NavBar page where first 5 rows could be shown in the UI and download the complete output file on clicking the "Download List" button. I am novice with rshiny. Any help would be helpful.
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Documentation", tabName = "documentation",selected=FALSE),
menuItem("Dataset", tabName = "dataset", badgeColor = "green"),
menuItem("Result", tabName = "results", badgeColor = "green")
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "documentation",h3("Tool Documentation")),
tabItem(tabName = "dataset",menuItem(icon = NULL, fileInput("PE", "Upload input file:")),
menuSubItem(icon = icon("refresh"),actionButton("Start","Analyze"))),
tabItem(tabName = "results",navbarPage(tabPanel("summary","Summary",icon = icon("list-alt")),
tabPanel("Table",tableOutput("table"),icon = icon("table")),
downloadButton("downList", "Download List")))))
# Put them together into a dashboardPage
ui <- dashboardPage(dashboardHeader(title = "FanDB"),
sidebar,
body)
# Define server logic
server <- function(input, output, session) {
##run this command on input$PE file on the click of actionButton
output$Table <- renderTable({
input$Start
req(input$PE)
a<-read.delim(input$PE,sep="\t",header=T)
b<-a[a[,6]==2,1]
{
return(b)
}
#Show the results from the actionButton in the Table panel in the navbar page and download the results using downloadButton
})
}
shinyApp(ui, server)
Or displaying the "results" menu (navbarPage) which is currently in the sidebarMenu to the dashboardBody on the completion of actionButton would be ideal.
There's a typo: output$Table should be output$table to refer to the table, not the tab holding it. Also, to load a file from fileInput, you need to access input$PE$datapath
The way I'd structure this is to use an eventReactive, which is triggered by the actionButton, to load the data and make it available as a reactive expression which is used by renderTable
server <- function(input, output, session) {
# When button is pressed, load data and make available as reactive expression
table_content <- eventReactive(input$Start, {
req(input$PE$datapath)
a <- read.delim(input$PE$datapath,sep="\t",header=T)
b <- a[a[,6]==2,1]
return(b)
})
# Render data as table
# Since table_content is reactive, the table will update when table_content changes
output$table <- renderTable({
table_content()
})
}
To download the table, you can just set up a downloadHandler function with this same table_content() expression as the content. There are a bunch of other questions on downloadHandler, so I won't go into detail on that.
If you want the input$Start button to change to the results tab when clicked, you need to do 2 things:
First, add an id to your sidebarMenu:
sidebar <- dashboardSidebar(
sidebarMenu(id = 'tabs',
...
Second, set up updateTabItems to change the selected tab to results. Since you're using shinydashboard, you want to use shinydashboard::updateTabItems, not shiny:: updateTabsetPanel as in this question. Since you want to change tabs when the table content is loaded, I'd make the table_content() reactive the trigger by adding this:
observeEvent(table_content(),{
updateTabItems(session, "tabs", 'results')
})
Now, when table_content() is changed, the tab will be switched to results. If something goes wrong in your eventReactive and the file cannot be read or processed properly, then the tab won't switch.
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)
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.
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)