I'm struggling to find out how to target 1 of the two dropdowns specifically with css styling code.
I can style the dropdowns in general, but not individually
I have tried to target it in the following ways, but none work.
#MyDropDown1 .sw-show.sw-dropdown-content {
#sw-content-MyDropDown1 .sw-show.sw-dropdown-content {
.dropdown-content-MyDropDown1 {
#dropdown-content-MyDropDown1 {
#dropdown-menu-MyDropDown1 {
How to find the right syntax to target the 1st dropdown?
here is the app:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$head(tags$style(HTML('
.sw-show.sw-dropdown-content {
display: block;
left: 200px;
top: 100px;
height: 300px;
width:
} '))),
dropdown(inputId = "MyDropDown1",
tags$h3("List of Input")),
dropdown(inputId = "MyDropDown2",
tags$h3("List of Input"))
)
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
Maybe this is a way to go. But unfortunately because of the margin I end up with 2 boxes...
But at least the css style apply only on the first dropdown
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$head(tags$style(HTML('
.test {
display: block;
background-color:red;
left: 200px;
top: 100px;
height: 300px;
width:
} '))),
dropdown(inputId = "MyDropDown1",
tags$h3("List of Input"), class = "test"),
dropdown(inputId = "MyDropDown2",
tags$h3("List of Input"))
)
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
Related
Here is a link to a two slide slickR carousel that works well on a desktop but when viewed on an iphone, the image is cut off. ie it is not responsive.
How do I use slickR's carousel with images and have it work on both desktop and mobile without images being cutoff?
Do I need to add the responsive behaviour manually? The original JS page talks about it, but I'm not sure how to translate that to R.
R Script
library(shiny)
library(slickR)
# Test #########################################################################
gic_changed_filenames <- c( "/home/law/whatbank_website/static/fb/img/gic1-5_yield_curve_d9bf51fdc3ec3cec.png",
"/home/law/whatbank_website/static/fb/img/gic1-5_yield_curve_fb2482d0f9923086.png")
################################################################################
num_slides <- length(gic_changed_filenames)
# Capture everything after img/ and add to link
chart_names <- paste0("http://whatbank.ca/fb/img/", sub(".*img/", "", gic_changed_filenames))
ui <- fluidPage(
tags$head(
tags$style(HTML("
.arrows {
height: 20px;
}
.slick-prev {
left: 230px; # moves right
}
.slick-next {
left: 250px; # moves right
}
"))
),
fluidRow(
column(6,),
column(2,
tags$div(class="arrows"
)),
column(4)),
slickROutput("slick_output")
)
server <- function(input, output, session) {
output$slick_output <- renderSlickR({
slickR(obj = chart_names, height = 300, width = "100%") +
settings(dots = TRUE, appendArrows = '.arrows')
})
}
shinyApp(ui, server)
By default "auto" is set for .slick-slide img's width property. You can overwrite this setting using relative css units (% / vw / vh) to rescale the image:
Edit: removed the column chaos and calculated relative positions for the arrows.
library(shiny)
library(slickR)
# Test #########################################################################
gic_changed_filenames <- c( "/home/law/whatbank_website/static/fb/img/gic1-5_yield_curve_d9bf51fdc3ec3cec.png",
"/home/law/whatbank_website/static/fb/img/gic1-5_yield_curve_fb2482d0f9923086.png")
################################################################################
num_slides <- length(gic_changed_filenames)
# Capture everything after img/ and add to link
chart_names <- paste0("http://whatbank.ca/fb/img/", sub(".*img/", "", gic_changed_filenames))
ui <- fluidPage(
tags$head(
tags$style(HTML("
.arrows {
height: 20px;
}
.slick-prev {
left: calc(50% - 30px);
}
.slick-next {
right: calc(50% - 30px);
}
.slick-slide img {
width: 100% !important;
}
"))
),
fluidRow(
column(12, tags$div(class="arrows"))
),
slickROutput("slick_output")
)
server <- function(input, output, session) {
output$slick_output <- renderSlickR({
slickR(obj = chart_names, height = "50%") +
settings(dots = TRUE, appendArrows = '.arrows')
})
}
shinyApp(ui, server)
I am using R's bsplus package to build a carousel of images. I want to move the chevrons next to the bullets.
I am aware of this SO sol'n regarding how to reposition the prev/next chevrons.
I can get close (see the 'right' chevron) but when I position it where I want it (see the 'left' chevron) it's no longer clickable.
Why is this?
How can I position the chevrons next to the bullets and maintain their functionality?
R Script
library("shiny")
library("bsplus")
ui <- fluidPage(
includeCSS("/home/law/whatbank_home/tests/bullet.css"),
# Application title
titlePanel("Carousel Demo"),
uiOutput("carousel")
)
server <- shinyServer(function(input, output) {
output$carousel <- renderUI({
bs_carousel(id = "images", use_indicators = TRUE) %>%
bs_append(
content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Merry")
) %>%
bs_append(
content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Christmas")
) %>%
bs_append(
content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=To")
) %>%
bs_append(
content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=All")
)
})
})
# Run the application
shinyApp(ui = ui, server = server)
css
.carousel-control.left,
.carousel-control.right {
background: transparent;
}
.carousel-indicators .active {
background-color: #FCB700;
margin-bottom: 70px;
}
.carousel-indicators li {
background-color: #D8D8D8;
border: 1px solid #000;
margin-bottom: 70px;
}
.carousel-control.left .glyphicon {
left: 180px;
margin-left: 180px;
top: 183px;
margin-top: 183px;
}
.carousel-control.right .glyphicon {
right: 180px;
margin-right: 180px;
top: 160px;
margin-top: 160px;
}
You should try
.carousel-control {
width: 2%
}
In the example below, I use 2%.
library(shiny)
library(shinydashboardPlus) ### carousel() is from this package
library(DT)
jscode <-"
$(document).ready(function(){
$('#mycarousel').carousel( { interval: false } );
});"
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tags$head(
tags$style(HTML("
#mycarousel {
width:900px;
height:600px;
}
.carousel-control{
color:#FF0000;
width: 2%;
}
"))
),
tags$head(tags$script(HTML(jscode))),
carousel(
id = "mycarousel",
carouselItem(
DTOutput("show_iris_dt")
),
carouselItem(
caption = "An image file",
tags$img(src = "YBS.png")
),
carouselItem(
caption = "Item 3",
tags$img(src = "http://placehold.it/900x500/39CCCC/ffffff&text=Happy+New+Year")
)
)
),
title = "Carousel Demo"
),
server = function(input, output) {
output$show_iris_dt <- renderDT({
datatable(iris)
})
}
)
I'm wondering whether these is any option to include math mode in tooltip title using bsTooltip() from shinyBS package.
Small example:
rm(list = ls())
library(shiny)
library(shinyBS)
ui <- basicPage(
headerPanel("Tooltip test"),
bsTooltip(id = "Equation", title = "\\(\\bar{X} = \\frac{1}{n}\\sum_{p = 1}^{n}X_p\\)", placement = "bottom", trigger = "hover", options = NULL),
mainPanel(
p("some text", htmlOutput("Equation", inline = TRUE))
)
)
server <- shinyServer(function(input, output,session) {
output$Equation <- renderUI({HTML("<font color='blue'><u>something which needs equation</u></font>")})
})
shinyApp(ui = ui, server = server)
The result (math mode) is not satisfactory:
No way with 'shinyBS'.
Here is a way using the qTip2 JavaScript library.
In order to use it, you have to download the files jquery.qtip.min.css and jquery.qtip.min.js, and put these two files in the www subfolder of the Shiny app.
library(shiny)
js <- "
$(document).ready(function() {
$('#Equation').qtip({
overwrite: true,
content: {
text: $('#tooltip')
},
position: {
my: 'top left',
at: 'bottom right'
},
show: {
ready: false
},
hide: {
event: 'unfocus'
},
style: {
classes: 'qtip-youtube qtip-rounded'
},
events: {
blur: function(event, api) {
api.elements.tooltip.hide();
}
}
});
});
"
library(shiny)
ui <- basicPage(
tags$head(
tags$link(rel = "stylesheet", href = "jquery.qtip.min.css"),
tags$script(src = "jquery.qtip.min.js"),
tags$script(HTML(js)),
),
withMathJax(),
headerPanel("Tooltip test"),
mainPanel(
p("some text", htmlOutput("Equation", inline = TRUE)),
div(
id = "tooltip", style = "display: none;",
HTML("$$\\int_0^1 f(x) dx = \\pi$$")
)
)
)
server <- shinyServer(function(input, output,session) {
output$Equation <-
renderUI({HTML("<font color='blue'><u>something which needs equation</u></font>")})
})
shinyApp(ui = ui, server = server)
Just to add another option, we could create our own tooltip class following the example from W3 here. Then we can use {shiny}'s withMathJax() function to render the tooltip as formula.
I usually use custom tooltips in cases where I only have a few tooltips that I want to customize. It has the advantage that it comes with no additional dependencies. The major drawbacks of this custom tooltip are that (1) it is displayed as child element and not in a separate container on the top layer like tooltips generated with javascript and that (2) you have to create css classes for each arrow direction. So if you have many tooltips pointing in different directions an additional javascript library like qTip2 should be definitely worth the dependency.
library(shiny)
ui <- fluidPage(
tags$head(
tags$style(HTML(
# tooltip implementation from:
# https://www.w3schools.com/css/tryit.asp?filename=trycss_tooltip_arrow_top
# just added a `t` to make classes unique
".ttooltip {
position: relative;
display: inline-block;
border-bottom: 1px dotted black;
}
.ttooltip .ttooltiptext {
visibility: hidden;
width: 120px;
background-color: black;
color: #fff;
text-align: center;
border-radius: 6px;
padding: 5px 0;
position: absolute;
z-index: 1;
top: 150%;
left: 50%;
margin-left: -60px;
}
.ttooltip .ttooltiptext::after {
content: '';
position: absolute;
bottom: 100%;
left: 50%;
margin-left: -5px;
border-width: 5px;
border-style: solid;
border-color: transparent transparent black transparent;
}
.ttooltip:hover .ttooltiptext {
visibility: visible;
}")
)
),
headerPanel("Tooltip test"),
mainPanel(
p("some text", htmlOutput("Equation", inline = TRUE)),
))
server <- shinyServer(function(input, output,session) {
output$Equation <- renderUI({
span(class = "ttooltip",
style = "color: blue",
"something which needs equation",
span(class = "ttooltiptext",
withMathJax("$$\\bar{X} = \\frac{1}{n}\\sum_{p = 1}$$"))
)
})
})
shinyApp(ui = ui, server = server)
I use the insertUI() function to create new dragUI() dynamically. Unfortunatly, the newly created dragUI does not behave as expected. I can’t drag them as dragUI that were created from the ui initial function.
library(shiny)
library(shinyDND)
ui <- fluidPage(
actionButton('insertBtn', 'Insert'),
dropUI("Box", row_n = 3, col_n = 3, style = "height: 200px; width: 700px"),
dragUI("Drag0",style = "display: inline-block; height: 100px; width: 100px",tags$a("Initial"))
)
shinyApp(ui, server = function(input, output) {
observeEvent(input$insertBtn, {
insertUI(
selector = '#Box',
where = c("afterEnd"),
ui = (dragUI(id="newDragUI",style = "display: inline-block; height: 100px; width: 100px",tags$a("new")))
)
})
})
How do I add text to the right of a dashboard header sidebar icon? It seems that previous similar solutions no longer work under updates to dashboardHeader().
This is what I am trying to do in a basic shinydashboard setting:
I can use the strategy from this answer to get text in the header, but it's right-justified (which I can likely fix custom css) and also feels pretty hacky.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "demo",
tags$li(class = "dropdown",
tags$p("foo")
)
), dashboardSidebar(), dashboardBody())
server <- function(input, output) { }
shinyApp(ui, server)
Is there a better way to do this?
The dashboardHeader is expecting elements of type dropdownMenu. So it will be hard to find a not hacky solution. The possible (hacky) options are: a) Modify the dashboardHeader function, or b) use some JavaScript code to add the text after creating the header. Below is my attempt to solve your problem using JavaScript, maybe it could help you.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML(
'.myClass {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}
'))),
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<span class="myClass"> Text Here </span>\');
})
'))
)
)
server <- function(input, output) { }
shinyApp(ui, server)
Adding to Geovany & Tiffany's answers, if you'd like the text content to be dynamic, you can have it change based on user input with the shinyjs::html function.
For example, I'm using it to display the name of the selected tab in the header. You can access the selected tab name in the server function as long as you have given the sidebar menu an id, in my case this is tabs.
I also had to add an id to the div that is appended to the header in Geovany's code, in this case pageHeader.
Then adding this to the server function will change the header text to display the selected tab, with switch being used to create a more presentable header format. Note the useShinyJs() in dashboardPage parameters:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML(
'.myClass {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}
'))),
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div id="pageHeader" class="myClass"></div>\');
})
'))
),
useShinyjs()
)
server <- function(input, output) {
observeEvent(input$tabs, {
header <- switch(input$tabs,
tab1 = "Tab 1",
tab2 = "Tab 2",
tab3 = "Tab 3")
# you can use any other dynamic content you like
shinyjs::html("pageHeader", header)
})
}
shinyApp(ui, server)
A slightly modified version of Geovany's code to customize font auto-sizing, placement etc. would be:
ui.R file in directory1 containing:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div class="myClass"> Text Here </div>\');
})
')),
tags$head(
# Include our custom CSS
includeCSS("styles.css"),
)
)
)
server.R file in directory1 containing:
library(shiny)
library(shinydashboard)
server <- function(input, output) { }
a css style sheet (style.css in directory1) that controls the text parameters on resizing windows with a defined maximum size and unlimited shrink with the following code:
.myClass {
line-height: 50px;
text-align: center;
font-family: "Arial";
padding: 0 15px;
color: black;
font-size: 2vw;
}
#media (min-width: 1200px) {
.myClass {
line-height: 50px;
text-align: center;
font-family: "Arial";
padding: 0 15px;
color: black;
font-size: x-large
}
}
run using:
shiny::runApp("path to directory1")
Adding the padding properties can be a possible fix. Other options such as width, border and margin can be explored based on your requirements.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "demo",
tags$li(class = "dropdown",
style = "padding: 10px 1200px 0px 0px;",
tags$p("foo")
)
), dashboardSidebar(), dashboardBody())
server <- function(input, output) { }
shinyApp(ui, server)
Hope this helps!