I am trying to use the combination of Action Button and InsertUI to help the user input excel Files. Once the user clicks on the button, the FileInput box should appear (I will then handle the fileinput$datapath later to create a dataframe.)
In the code below, I try to:
generate a button using actionButton in the UI code
Use the actionButton via ObserveEvent to trigger the InsertUI code which should ideally insert the fileInput part of the code once the button in 1. is clicked. I want the file input to be in the server part of the code rather than UI part of the code.
I tried the below code where i can generate a button, but unable to
trigger the observeEvent. Any help here is highly appreciated please.
library(shiny)
Import.Excel.Data.UI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns("AddExcelDataButton"), label = "Click Here to Add Excel Data"),
)
}
Import.Excel.Data.Server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(eventExpr = input$AddExcelDataButton,
insertUI(selector="#AddExcelDataButton",
where = "afterEnd",
ui = fileInput(inputId = paste0("File",input$AddExcelDataButton),
label = paste0("Path for File",input$AddExcelDataButton),
multiple = FALSE)))
})
}
Import.Excel.Data.App <- function(){
ui <- fluidPage(
Import.Excel.Data.UI("File1")
)
server <- function(input, output, session){
Import.Excel.Data.Server("File1")
}
shinyApp(ui, server)
}
Import.Excel.Data.App()
You need to use the namespace:
insertUI(selector=paste0("#", ns("AddExcelDataButton")), ......
Related
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)
}
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)
I'm using modules within my shiny app to display the content of different tabPanels. I would like to be able to travel to the second tab by clicking one button. I have the following code:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")
)
}
module <- function(input, output, session, openTab){
observeEvent(input$action1, {
openTab("two")
})
return(openTab)
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
openTab("one")
openTab <- callModule(module,"first", openTab)
openTab <- callModule(module,"second", openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)
However this only works once. The problem I think, is that the module does not know when a tab is changed in the app. Therefore I'm looking for a way to make sure the module knows which tab is opened so that the actionButton works more that once.
I have considered using input$tabsPanel but I don't know how to implement it.
Help would be greatly appreciated.
The problem is that once the user manually switches back to tab 1, the openTab() does not get updated. So therefore, when you click the actionButton a second time, openTab changes from "two" to "two" (i.e. it stays the same), and therefore your observeEvent is not triggered.
You could add:
observeEvent(input$tabsPanel,{
openTab(input$tabsPanel)
})
So the openTab reactiveVal is updated also when a user manually changes back to tab1 (or any other tab).
You don't need modules to do what you want by the way, but I assume you have a specific reason to use them. For anyone else who wants to achieve the same but does not need modules:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")),
navlistPanel(id = "tabsPanel",
tabPanel("one"),
tabPanel("two")
))
server <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
shinyApp(ui = ui, server = server)
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.