In my shiny app I would like to have a popup window with some text. To make the text more readable I would like to include some linebreaks, but so far I have failed. Any idea how would I do that? I am currently using modalDialog()
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "My text",
"This is the first line.
This should be the second."
))
})
}
I have tried: br(), \n and several variations of those. Nothing worked.
Help!!!
You can wrap it in HTML() and then use <br>, similar to your attempt mentioned above. So you could use instead: HTML("This is the first line.<br>
This should be the second.")
For the full app, see below:
ui = basicPage(
actionButton("show", "Show modal dialog")
)
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "My text",
HTML("This is the first line.<br>
This should be the second.")
))
})
}
shinyApp(ui, server)
Related
In order to make an app where panels are created dynamically, I would like to remove, hide and/or update panels from the package shinyWidgets.
I didn't find any function to do so nor way to add IDs to these panel.
If you have the solution or a way around, I would be more than happy. Thank you in advance !
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
panel(
heading = "Test panel",
actionButton("remove_panel", "Remove this panel")
)
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
print("remove panel")
})
}
shinyApp(ui = ui, server = server)
There is no official method you can use to change the panel states, but we can do it with custom expressions.
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
panel(
heading = "Test panel1",
id = "test_panel1",
actionButton("remove_panel", "Remove this panel")
),
panel(
heading = "Test panel2",
id = "test_panel2",
"some content"
),
actionButton("hide_panel", "Hide this panel")
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
removeUI('.panel:has([id="test_panel1"])', immediate = TRUE)
})
observeEvent(input$hide_panel,{
toggle(selector = '.panel:has([id="test_panel2"])')
if(input$hide_panel %% 2 == 1) return(updateActionButton(inputId = "hide_panel", label = "Show this panel"))
updateActionButton(inputId = "hide_panel", label = "Hide this panel")
})
}
shinyApp(ui = ui, server = server)
To remove:
add an ID argument to your panel, and use removeUI to remove it. Remember to change the ID in you own case.
To hide/show:
We can use toggle from shinyjs to show or hide some elements we choose.
Use updateActionButton to also change it text when hidden.
I've reviewed similar posts and haven´t found any that address this specific need. Below is very simple MWE of what I'm trying to do: shown in 2 images, and in runnable code. My "Hide" button (or remove UI) doesn't work. Help!! I'm sure it's a simple solution but I'm new to this.
What I'm trying to do: Click on the "Add" button and a file input prompt appears below. Click "Hide" button and the file input prompt goes away. Click "Add" again (after "Hide") and the file input prompt appears again. If you click "Add" now (and repeatedly), that single file input prompt remains. (Most other posts have the object appearing repeatedly, again and again in a growing column, with every additional click of the button - this isn't what I need). Just one click to make it appear (and clicking "Add" over and over just keeps it there in its original single manifestation), and "Hide" makes it go away. Simple as that.
Images:
library(shiny)
ui <- fluidPage(
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
"txt"
req(input$addBtn)
tagList(fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
), # close file input
)} # close tag list
)} # close render UI
observeEvent(input$hideBtn, {
removeUI(
selector = "div:has(> #txt)")
}) # close observe event
shinyApp(ui, server)
Perhaps you can use shinyjs package to get the desired result. Try this
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
"txt"
req(input$addBtn)
tagList(fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
) # close file input
) # close tag list
}) # close render UI
observeEvent(input$addBtn, {
shinyjs::show("FileInput")
})
observeEvent(input$hideBtn, {
shinyjs::hide("FileInput")
#removeUI(selector = "div:has(> #txt)")
})
}
shinyApp(ui, server)
If you do not want to use shinyjs package, you can use insertUI and removeUI as shown below.
library(shiny)
ui <- fluidPage(
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
req(input$addBtn)
tagList(tags$div(id = 'placeholder1')
) # close tag list
}) # close render UI
observeEvent(input$addBtn, {
if (input$addBtn==0){return(NULL)
}else {
insertUI(
selector = '#placeholder1' ,
## wrap element in a div with id for ease of removal
ui = tags$div(id="fi",
div(style="display: inline-block; width: 185px ;" ,
fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
) # close file input
))
)
}
})
observeEvent(input$hideBtn, {
if (input$hideBtn==0){return(NULL)
}else {
removeUI(selector = "div:has(> #fi)")
}
})
}
shinyApp(ui, server)
I successfully changed the text sizes in shiny dashboard interface by editing css file.
Or I use following structure:
div(DTOutput(outputId = "table"), style = "font-size:85%"))
However, I couldn't find the node name of shiny modals. Is it possible to change the text size in shiny modals through .css?
Are you looking for something like this?
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "Important message",
div("This is an important message!", style="font-size:160%")
))
})
}
)
ModalDialog takes as its first argument(s) UI elements. This appears to be the same kind of arguments accepted by other shiny elements. Compare for example: ?siderbarPanel and ?modalDialog. So if you can do it in the body of an app, you can probably do it in a modal.
For example, I stuck a sidebar layout inside a modal:
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
sidebarLayout(sidebarPanel("yeah"),mainPanel("cool"))
))
})
}
)
I would like to add a tooltip for navbarMenu in Shiny app. Similar question asked here but, there is no answer.Here is my reproducible code
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu("Tab1",bsTooltip(id="Tab1", title="Short description for the tab", trigger = "hover"),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
During my research I found this solution R Shiny: Use navbarPage with bsModal by shinyBS, but for bsModel.
Also, there is a procedure mentioned here which is based in java-script.I know both solutions are for tabpanel but I believe it's the same problem, which is navbarMenu and tabpanel don't have an id.
I'm statistician and I don't have background in HTML or java-script to rewrite the attribute for the tab title or navbarMenu.
I hope I phrase my question in a clear manner. Thanks in advance for your time and kind help.
you can use HTML wenn passing the Title of the Tabs. in this case I just pt the title in a span and added the attribute titlewhich is the attribute HTML uses default for mouse-overs. For me this is much sinpler the trying to add it over shinyBS.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu(span("Tab1",title="Short description for the tab" ),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
hope this helps!
I found another solution using javascript. Perhaps it may be more useful.
library(shiny)
shinyApp(
ui = navbarPage(
tags$script(HTML('
$( document ).on("shiny:sessioninitialized", function(event) {
$(\'span[data-toggle="tooltip"]\').tooltip({
html: true
});
});'
)),
navbarMenu(
"Menu"
,tabPanel(span("navbarTitle 1",title="XXX",`data-toggle`="tooltip"),
tabsetPanel(
tabPanel(span("Tab 1", title = "aaa",`data-toggle`="tooltip")),
tabPanel(span("Tab 2",title="bbb",`data-toggle`="tooltip")),
tabPanel(span("Tab 3",title="ccc",`data-toggle`="tooltip"))
)
)
,tabPanel( "navbarTitle 2")
)
),
server = function(input, output) {
}
)
My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!