I created a notification within Shiny dashboard that displays an icon and then the number of users registered in the last day. If I put in dummy text, the icon and the text are aligned on the same 'row'. But if I use renderText to pull the number dynamically, a line break is added after the icon.
Here's the ui code:
dropdownMenu(type = "notifications",
notificationItem(text = textOutput("regis")",
icon("users"))
Here's the server code:
output$regis <- renderText({
count <- registrationsToday()
paste(count,"new registrations today.",sep=" ")
})
I've tried to fix it but can't figure it out. Any ideas?
An interim solution to this problem was posted here:
https://github.com/rstudio/shinydashboard/issues/21
I tested this and it worked.
notificationItem(
text = tags$div(textOutput("regis"),style = "display: inline-block; vertical-align: middle;"), icon("users")
)
Hope this helps!
Related
I got an app that opens up a modalDialog with an image inside a spsComps::gallery. However, the enlargement works only the first time the modal has been opened. How can this be fixed? Here is a minimal reprex:
library(shiny)
library(spsComps)
ui <- fluidPage(
actionButton("modal", "Open modal")
)
server <- function(input, output, session) {
observeEvent(input$modal,
{
showModal(modalDialog(
title = "test",
fluidRow(gallery(
texts = "Click to enlarge", hrefs = "", image_frame_size = 6,
images = "https://cdn.pixabay.com/photo/2018/07/31/22/08/lion-3576045__340.jpg",
enlarge = TRUE, title = "When you close this modal, the enlargement does not work again",
enlarge_method = "modal"
)),
footer = modalButton("Cerrar"),
easyClose = TRUE,
size = "xl"))
})
}
shinyApp(ui, server)
The first time the modal is opened, you can enlarge the image by clicking it. It looks like this:
However, when you close and then reopen the modal, that enlargement feature is missing.
A temporary fix would be this:
library(shiny)
library(spsComps)
ui <- fluidPage(
actionButton("modal", "Open modal"),
singleton(
div(id = "sps-gallery-modal", class = "gallery-modal",
style="display: none;",
onclick = "galModalClose()", tags$span(class = "gallery-modal-close", "X"),
tags$img(id = "sps-gallery-modal-content",
class = "gallery-modal-content"),
div(class = "gallery-caption")
))
)
server <- function(input, output, session) {
observeEvent(input$modal,
{
showModal(modalDialog(
title = "test",
fluidRow(gallery(
texts = "", hrefs = "", image_frame_size = 6,
images = "https://cdn.pixabay.com/photo/2018/07/31/22/08/lion-3576045__340.jpg",
enlarge = TRUE, title = "When you close this modal, the enlargement does not work again",
enlarge_method = "modal"
)),
footer = modalButton("Cerrar"),
easyClose = TRUE,
size = "xl"))
})
}
shinyApp(ui, server)
The reason is I have this singleton(... in the gallery creation function. There is only one enlarge img container needed to be created no matter how many galleries you have (It's not practical to enlarge two pictures at the same time). So enlarged images from different galleries are displayed inside the same enlarge container. This saves computer resources, and singleton in Shiny is the function to prevent duplication. Even if you may call gallery many times, if the content inside singleton is sent to the DOM tree only once, it will not append it again.
The problem is when showModal is closed, Shiny deletes everything inside the modal, including the gallery singleton content. Meanwhile, I think the singleton content validation stays at R level. It does not actually go search the DOM tree if this content exists or not. So Shiny thinks singleton content is there, and therefore refused to send it to DOM when the second time you call showModal.
The fix above append singleton content to fluidPage container instead of Shiny modal container, so when modal is closed, it cannot delete the content.
This is a universal problem in Shiny when you have singleton and modalDialog. There is nothing I can do to fix Shiny, but I may think of a more user-friendly way in the next spsComps version to address it.
I want to use shiny.i18n in my app, which uses tooltips to provide more information on certain elements (using two types of tooltips, either with tipify or bsTooltip). However, I could not find how to integrate both, and the tooltips are not rendered properly.
As an example, this:
library(shiny)
library(shinyjs)
library(shinyBS)
library(shiny.i18n)
i18n <- Translator$new(translation_csvs_path = "data_translation/")
i18n$set_translation_language("en")
ui <- fluidPage(
useShinyjs(),
shiny.i18n::usei18n(i18n),
div(style = "float: left;",
selectInput('selected_language',
i18n$t("Change language"),
choices = i18n$get_languages(),
selected = i18n$get_key_translation())
),
mainPanel(
i18n$t("This is some text without a tooltip"),
textOutput("Text"),
bsTooltip("Text",
i18n$t("This is some text"),
placement="right", trigger = "hover", options=list(container="body")),
tipify(
actionButton("Button", "", icon = icon("house-user")),
i18n$t("This is a button"),
placement="right", trigger = "hover", options=list(container="body"))
))
server <- function(input, output, session) {
observeEvent(input$selected_language, {
shiny.i18n::update_lang(session, input$selected_language)
})
output$Text <- renderText({i18n$t("This is some text with a tooltip")})
}
shinyApp(ui, server)
file translate_fr.csv:
"en","fr"
"Hello","Bonjour"
"This is some text without a tooltip","Ceci est un texte sans tooltip"
"This is some text with a tooltip","Ceci est un texte avec tooltip"
"This is a button", "Ceci est un bouton"
"This is some text", "Ceci est un texte"
"Change language","Changer de langue"
returns:
While the tooltip should just contain "This is a button". I'm quite new to these tools - what am I missing?
The Problem is that the tooltips and tipify do not support HTML. That is the reason why your tooltips display the raw HTML created by shiny.18n.
There are two ways to achieve what you want.
The first one is to use popovers from the shinyBS packages. These support HTML and will achieve the language feature you are looking for.
The other one is to render the tooltips on the serverside in shiny. This way no HTML will be involved in creating the translations. This way would allow you to even use tipify/tooltips you asked for.
The reason for this problem is, that shiny.18n has two kind of tricks to achieve the translations. The first one is one the browser side. As you displayed shiny.18n is wrapping a span tag around the translations, so that it can later be modified by using JavaScripts in the browser.
The other method is to render everything new on the server side. This way no HTML will be needed, as the process is happening not on the browser anyway.
I am trying to understand how will the below code behave
library(shiny)
ui<-fluidPage(
sliderInput("inpslider","Slider",1,10,5),
uiOutput("radio"),
)
server <- function(input, output) {
output$radio<-renderUI({
x<-input$inpslider
radioGroupButtons(inputId = 'myRadioButton', choices = c("A","B"),status = 'warning',
direction = 'vertical', justified = T)
})
}
The first time the code runs it will add an input slider and grouped radio button.
Question:- Since output$radio block contains the reactive value input$slider it will be executed whenever the slider value is changed, So will shiny add a new set of radio button(on top of previous one) every time output$radio is executed? or will the old set of radio buttons will be flushed out every time and new one is added?
You're creating the element with renderUI each time the slider is invalidated it doesnt matter if you press it or reload it...
I am working on a shiny app, that reads data from a file, and display the data on the app, and also allows user to refresh the data. The app works fine, except that when I 'refresh' the data with the action button, some styling are gone.
Below is a simplified version of my app.R
library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"
# Define UI for application
ui <- fluidPage(
actionButton("refresh", "", icon("refresh") ),
tableOutput("table"),
uiOutput("slider")
)
# Define server logic required
server <- function(input, output, session) {
observeEvent(input$refresh,{
source("updatedata.R")
showModal(modalDialog(
title = "",
"Data refreshed",
easyClose = TRUE,
footer = NULL
))
})
# observe the raw file, and refresh if there is change every 5 seconds
raw <- reactivePoll(5000, session,
checkFunc = function(){
if (file.exists(file_name))
file.info(file_name)$mtime[1]
else
""
},
valueFunc = function(){
read.csv(file_name)
})
output$table <- renderTable(raw())
output$slider <- renderUI({
req(raw())
tagList(
# styling slider bar
tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
sliderInput("date","",
min = min(raw()$v1),
max = max(raw()$v1),
value = max(raw()$v1))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In the above, I used renderUI for my slider, as the values depends on the raw values I read from the local file. And I specify the color for the slider explicitly (currently set to red).
And in the same directory, I have updatedata.R that does something similar to the below:
file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(x =temp, file = file_name,row.names = FALSE )
To run the sample app without error, please run the above code first to initialize the csv files.
When the app first launches, the slider bar is red color. However, after I refresh the underlying data by clicking on the refresh button at the top of the app [NOT the browser refresh], the slider bar changed back to the default shiny app color.
I've searched for an answer for this for quite some time, but cannot even figure out what is the root cause for this. Does anyone has experienced similar issue before, or have an idea how I can fix it, so that the color of the slider bar is unchanged after the refresh?
Thank you!
Shiny increments the slider class each time a new slider is rendered.
therefore the initial class becomes .js-irs-1 on refresh, then .js-irs-2 etc.
change your css selector to .irs child as follows:
tags$style(HTML(paste0(".irs .irs-single, .irs .irs-bar-edge, .irs .irs-bar {background: ",
bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}")))
however i would recommend using server side logic to update the input. It's usually better practice since the html element is rendered on website and only certain values are updated not the whole element.
check updateSliderInput() function to update your slider
I haven't found any information in documentation of shinyBS and on the google/SO about how to use trigger = 'manual' on, for example, addPopover of shinyBS. I thought this would be the way to add a tooltip to a disabled button. (I dont want to do it with div'ving the button and giving title to div.
Also would be nice if someone has a way to add tooltips reactively to shiny apps
If you want to use trigger = manual on the popover, then you need to define a script to toggle the popover, e.g. with jQuery:
library(shiny)
library(shinyjs)
library(shinyBS)
ui <-shinyUI(fluidPage(useShinyjs(),
# press this button to trigger the popover
actionButton("addPopover", "Add Popover"),
# a disabled button
disabled(actionButton("disabledButton", "This button is disabled")),
# the popover to appear over the disabled button
bsPopover("disabledButton", "Popover", "Some text", trigger="manual"),
# the script to trigger the popover
uiOutput("trigger")))
server <- shinyServer(function(input,output, session){
# on checkbox selection, disable button and trigger the popover
output$trigger <- renderUI({
input$addPopover
tags$script("$('#disabledButton').popover('toggle');")
})
})
shinyApp(ui,server)
Since shosaco's solution didnt work for me, I got it to work this way:
if (input$disable) {
addCssClass("buttonId", "disabled")
bsTooltip("buttonId", "This button is currently disabled.")
} else {
bsTooltip("buttonId", "")
removeCssClass("buttonId", "disabled")
}
observeEvent(input$buttonId, {
if (!input$disable) {
output$text <- renderText("Bla")
} else {
output$text <- renderText(NULL)
}