I've just started using R-Shiny. But I have some of troubles using js and html code in Shiny.
In my app I have two bsButton which when hover show some text with bsPopover. One of these popover contains an image which is larger than the standard box of the popover and I'd like to set the width of this popover that fully contains the figure.
Here I found how to set the width and height of all popovers, but how can I set the width/height of only a specific popover?
This is my code so far and I'd like to change the width of bsPopover(id="q2", ...) but not the width of bsPopover(id="q1", ...):
library(shiny)
library(shinyBS)
ui <- fluidPage(
tags$head(
# this changes the size of the popovers
tags$style(".popover{width:200px;height:250px;}")
),
fluidRow(
fileInput("file", label=h4("Upload Data",
tags$style(type = "text/css", "#q1 {vertical-align: top;}"),
bsButton("q1", label="", icon=icon("question"), style="info", size="extra-small")),
accept=".txt"
),
bsPopover(id="q1", title="Title help text1",
content=paste("help text"),
placement = "right",
trigger = "hover",
options = list(container = "body")
),
numericInput("numIn", label = h4("Choose a value",
tags$style(type="text/css", "#q2 {vertical-align: top;}"),
bsButton("q2", label="", icon=icon("question"), style="info", size="extra-small")),
value = 2.5, step=0.5),
bsPopover(id="q2", title="Title help text 2",
content=paste0("The figure below shows",
img(src='scenarios.png', align = "center", height="320px", width="800px", style="display:block;margin-top:20px;margin-left:auto;margin-right:auto;")
),
placement = "right",
trigger = "hover",
options = list(container = "body")
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
I've been trying to solve the same issue, although using tipify() and popify() from the same shinyBS package. I found it really hard as it seems that dimensions of a tooltip or a pop-up are defined by the outer <div> container that tooltip or pop-up belongs to. Hence requires manipulation with CSS to resolve.
I found tippy::tippy() helpful here, where one could define the desired width of a tooltip inside a function, e.g.:
library(tippy)
tippy(
text = "Show tooltip over this text",
tooltip = "My tooltip text",
width = "200px"
)
The text argument requires character string as an input. That could be your button title/text.
I used tippy to show a tooltip over an information icon, that required minor CSS tweaking:
text = "<i class='fas fa-info-circle'></i>"
Just replace
tags$style(".popover{width:200px;height:250px;}")
with
tags$style("#q2{width:200px;height:250px;}")
Related
I am displaying widgets within a DT datatables in an R Shiny app.
Following a similar approach to here, widgets are inserted as text into the data table. Then using the option escape = FALSE, the text of the widgets is interpretated as HTML and the widget is displayed.
This approach has worked very well, until I came to redraw the datatable. On redraw the widgets within the table no longer appear. You can test with the following example. When "Redraw" is clicked, the UI output showing the text "here" disappears.
# UI
ui = fluidPage(
actionButton("draw", "Redraw"),
# uiOutput("ui"),
DT::dataTableOutput("classify_table")
)
# server
server = function(input, output, session) {
output$ui = renderUI({ p("here") })
output$classify_table <- DT::renderDataTable({
df = data.frame(
rows = input$draw,
UI = as.character(uiOutput("ui")),
stringsAsFactors = FALSE
)
DT::datatable(
df,
escape = FALSE,
options = list(
dom = "t",
preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})
}
# run
shinyApp(ui, server)
My best hypothesis is that Shiny ends up with two uiOutput("ui") bound. This would mean it does not display at the uiOutput("ui") in the redrawn table.
Supporting this hypothesis: if we uncomment uiOutput("ui") from line four, then the text "here" never appears in the data table, just like after redrawing.
Contrary evidence: the whole point of the callbacks is to unregister the previous uiOutput("ui") and to reregister the new uiOutput("ui") which should prevent this cause.
Any idea what is causing this behavior and how to fix it? Even suggestions for how to better debug this behavior would be helpful.
Another possible solution is to bind the UI component to shiny directly, instead of in the callback. But I don't know how to determine the JavaScript for this.
Based on the comment from #Stéphane Laurent, I found this answer by them (search term user:1100107 [dt] unbind).
I inserted this code into the UI
tags$script(HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})"
))
and this code at the start of the DT::renderDataTable({:
session$sendCustomMessage("unbindDT", "classify_table")
Note that if working in a module, we need to wrap with ns as so:
session$sendCustomMessage("unbindDT", ns("classify_table"))
Trying to finish my shiny app, I couldn't find a way to remove the scroll bar (the scroll bar isn't intended and I didn't actively choose it via code)
When I'm running the files individually I don't have the problem with the scroll bars. They only appear in the whole app.
Code for the whole app:
library(shiny)
library(shinythemes)
ui = navbarPage("Cohen's D",
theme = shinytheme("cerulean"),
tabPanel("What's Cohen's D?",
withMathJax(includeMarkdown("about.Rmd"))),
tabPanel("Calculate with statistics",
source("CohenDplusVisual.r")[1]
),
tabPanel("Upload your data frame",
source("CohenD_OwnDATA.r")[1]
),
)
server = function(input, output) {
}
shinyApp(ui, server)enter image description here
Again, if somebody could help me out, I would be extremely thankfulenter image description here
You can hide scrollbars for any div with the CSS overflow property. Here is a reproducible example for your navbarPage situation. Here we place it in an extra tagList so we can put the CSS somewhere (navbarPage does not have a style argument or another way to add extra CSS).
library(shiny)
ui <- tagList(
tags$head(tags$style("body{overflow:hidden;}")),
navbarPage(title = "Test page",
tabPanel("Tab1",
tags$div(style = "height: 2000px; background-color:grey;"))
)
)
server <- function(input, output, session){}
shinyApp(ui,server)
I am building a shiny app and I am using two sidebarLayouts. I’m looking for a way to minimize them. I have try put each sidebarLayout into a box.
Example code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
headerPanel("Here goes the heder"),
box(sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs"))),
width = 12,
title = "BB",
collapsible = T,
collapsed = F
)
)
server <- function(input, output) {
output$someinputs <- renderText({
"Here will go the inputs"
})
output$someoutputs <- renderText({
"Here will go the outputs"
})
}
shinyApp(ui, server)
Output:
When I press the collapsible button the Layout does not collapse. Why is this happening? What should I do? Is there other way to do this?
Because you didn't use shinydashboard. The box comes from shinydashboard package. You need to use shinydashboard::dashboardPage instead of fluidPage.
dashboardPage Loads required javascripts and CSS files to toggle the button.
library(shiny)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)
)
)
If you don't want to use dashboardPage, you can write your own scripts to control the button:
library(magrittr)
library(shiny)
ui <- fluidPage(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)%>% {.$attribs[['id']] <- 'example-box'; .},
tags$head(tags$script(
"$(document).ready(function(){
$('#example-box button').attr({
'data-toggle':'collapse',
'data-target':'#example-box .box-body',
'aria-expanded':false
})
})"
))
)
I used a hack to assign an ID to the box %>% {.$attribs[['id']] <- 'example-box'; .}, and use some jquery to control the button. Be sure the ID in the script matches the ID you assign in UI, example-box in this case. In javascript, you add # for ID searching, so #example-box.
I wouldn't recommend you to use the second way. You can see in your UI, it's not really a box. It has no border and the button is not at the right place. If you use dashboardPage, you can see the difference.
what I need to do is to combine these two subtitles together. in Html file, it shows all the subtitle content is under a tag. I tried HTML and paste but not working.
output$id <- renderInfoBox({
infoBox(
title = "title",
value = value,
icon = icon(),
subtitle = tags$a(icon("question-circle"),id="id"),
subtitle = "description"
)
})
The following is a simple application where that use a InfoBox.
I tried to use the same parameters as your example, except I used value = 20.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Info boxes"),
dashboardSidebar(),
dashboardBody(
#Show infobox in ui
infoBoxOutput("id")
)
)
server <- function(input, output) {
output$id <- renderInfoBox({
infoBox(
#We only have 3 parameters to show information
title = "title",
value = 20,
subtitle = "description",
icon = icon("question-circle")
)
})
}
shinyApp(ui, server)
As already mentioned we only have 3 parameters to write or display information: title, value and subtitle.
You were trying to put an icon in the subtitle parameter, and this should go in the icon parameter.
Then you can use the subtitle parameter to write several lines if you wish.
subtitle = tags$a(icon("question-circle"),"This ia a descrpcion"))
If you are looking to make a more complex design you should check the Box function.
I am trying to make an app that allow user to input data and then let shiny server to calculate some results, for example, I could make shiny generate a plot or a data table.
However, due to the space of the UI, I kind of "run out of" space. The input box, and documentation of the app take a whole screen. And when the shiny generate the results it will show at the very bottom of the screen.
Is there a way that I can make shiny pop-up a message box to show the result?
My sudo-code would be:
ui <- fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
actionButton("demo", "Fill in fields with demo"))
server <- function(input, output, session) {
observeEvent(input$demo, {
****************************
OpenNewPage/MoveScreenDown()
****************************
updateTextInput(session, "text", value = H)
updateNumericInput(session, "age", value = "30")
})}
When clicking the "demo", a message box popup or I can make the screen move to the result part and allow the text to be at the top of the screen.
There are options to show your results in a separated window. But maybe will be easier to have everything on the same window.
You can use the shinyBS library to create a modal window to show the plot. Another option is to use JavaScript to move the scroll to the bottom of the page. I put the two options in the following example, so you can see which one is better for you.
library(shiny)
library(shinyBS)
runApp(list(
ui = shinyUI(fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
# option 1, using ShinyBS with a modal window
actionButton("demo", "Using a modal"),
# modal window to show the plot
bsModal("largeModalID","Results", "demo", size = "large", plotOutput('plot')),
# Option 2, action button with a JavaScript function to move the scroll to the bottom
# after drawing the plot.
actionButton("demoJS", "Using JS",
# there is a delay to allow the renderPlot to draw the plot and you should
# change it according to the processes performed
onclick = "setTimeout( function() {
$('html, body').scrollTop( $(document).height() );},
300)"),
# to plot the results after click on "Using JS"
uiOutput("plotUI")
)
),
server = shinyServer(function(input, output, session) {
output$plot <- renderPlot({
# simple plot to show
plot(sin, -pi, 2*pi)
})
output$plotUI <- renderUI({
# this UI will show a plot only if "Using JS" is clicked
if (input$demoJS > 0)
# the margin-top attribute is just to put the plot lower in the page
div(style = "margin-top:800px", plotOutput('plot2'))
})
output$plot2 <- renderPlot({
# another simple plot,
plot(sin, -pi, 2*pi)
})
})
))
If you think that the JavaScript option works better for you, you could consider start using the shinyjs library, it includes very useful functions and you can easily add your own JavaScript code to your Shiny Apps.