I've put together a simple RShiny app related to finance and trading.
https://obrienciaran.shinyapps.io/cfd_new_value/
This is likely a very basic question, but right now in the side bar you can see text that says 'Current margin:' with a percent under it. Obtained via:
tags$b("Current margin:"),
h5(textOutput("current_margin"))
I just want these outputs side by side so it is displayed as
'Current margin: x%'
and not
'Current Margin:'
'x%'
Use the argument inline=TRUE and put the text "Current margin" and the output in the same div, here it is h5.
library(shiny)
ui <-
fluidPage(
h5(tags$b("Current margin:"),textOutput("current_margin", inline = TRUE))
)
server <- function(input, output, session) {
output$current_margin <- renderText({
"10%"
})
}
shinyApp(ui, server)
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)
There are numerous posts regarding changing titles of other pieces of Shiny apps, e.g.:
Change the title by pressing a shiny button Shiny R
Shiny page title and image
Shiny App: How to dynamically change box title in server.R?
My question is related, but not answered by any of these. I would like to make the <head><title>...</title></head> tag reactive, or at least controllable from within an observeEvent in server.R.
The following does not work, since ui can't find theTitle, but is the kind of approach I'd hope is possible:
library(shiny)
ui <- fluidPage(
title = theTitle(),
textInput("pageTitle", "Enter text:")
)
server <- function(input, output, session) {
theTitle <- reactiveVal()
observeEvent( input$pageTitle, {
if(is.null(input$pageTitle)) {
theTitle("No title yet.")
} else {
theTitle(input$pageTitle)
}
})
}
I've tried making output$theTitle <- renderText({...}) with the if..else logic in that observeEvent, and then setting title = textOutput("theTitle") in ui's fluidPage, but that generates <div ...> as the title text, or <span ...> if we pass inline=True to renderText.
In case this clarifies what I'm looking for, the answer would make something equivalent to the literal (replacing string variables with that string) ui generated by
ui <- fluidPage(
title = "No title yet.",
....
)
before the user has entered any text in the box; if they have entered "Shiny is great!" into input$pageTitle's box, then we would get the literal
ui <- fluidPage(
title = "Shiny is great!",
....
)
One way would be to write some javascript to take care of that. For example
ui <- fluidPage(
title = "No title yet.",
textInput("pageTitle", "Enter text:"),
tags$script(HTML('Shiny.addCustomMessageHandler("changetitle", function(x) {document.title=x});'))
)
server <- function(input, output, session) {
observeEvent( input$pageTitle, {
title <- if(!is.null(input$pageTitle) && nchar(input$pageTitle)>0) {
input$pageTitle
} else {
"No title yet."
}
session$sendCustomMessage("changetitle", title)
})
}
shinyApp(ui, server)
This was created following the How to send messages from the browser to the server and back using Shiny guide
As of June 2021, there is an R package called shinytitle that can update the window title from within Shiny's reactive context: https://cran.r-project.org/package=shinytitle
I want to build a multipage shiny application where I can control which page the user can see. Dean Attali does something similiar in this demonstration app, using shinyjs to hide and show each page.
I suppose there could also be ways to do this by using navbar(), navlist() or tabsetPanel(), if one can hide the navigation bar or the navigation list. Advantages would be to update pages simply via updateTabsetPanel(), updateNavbarPage() or updateNavlistPabel(), and that shinyjs is not neccesary any more.
So my question is: How can I hide the navigation bar of navbarPanel(), for example using CSS?
An example application can be found here: https://shiny.rstudio.com/gallery/navbar-example.html. I tried to include some CSS in this example to hide the navigation bar, but until now I only managed to hide everything (by setting .navbar to visibility:hidden) or everything but the navbar-title (by setting .navbar-nav to visibility:hidden). What is the correct element to hide - or the correct combination of elements to hide and of subelements to make visible again?
EDIT: As Chabo pointed out - the main problem seems to be that when the visibility for the navbar is set to hidden, or even display=none, the app does not set an active tab so nothing else shows up.
#https://shiny.rstudio.com/gallery/navbar-example.html
library(shiny)
ui<- navbarPage("Navbar!",
tags$head(
#here something is wrong.
# .navbar makes everything invisible
#.navbar-nav makes everything invisible but the navbar-title
tags$style(HTML("
.navbar-nav{
visibility: hidden;
}
")
)
),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
)
)
server<- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
shinyApp(ui, server)
I am trying to create a Shiny app with some text boxes. I like that the verbatimTextOutput has a box around the text, but with slightly longer text, the words get broken in meaningless places in order to wrap the text.
Is there some way that I can stop the words from being split? A very simple example is below.
ui <- fluidPage(
fluidRow(column(3, offset=0, verbatimTextOutput("TxtOut")))
)
server <- function(input, output, session) {
output$TxtOut <- renderText(
"a longish text that goes over multiple lines and breaks words"
)
}
shinyApp(ui = ui, server = server)
Because column width is set to 3, your text is wrapping in the output function. As explained in the comments above, following style will prevent wrapping, and add a scroll bar to navigate.
ui <- fluidPage(
tags$head(tags$style("#TxtOut {white-space: nowrap;}")),
fluidRow(column(3, offset=0, verbatimTextOutput("TxtOut")))
)
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.