R - shiny radioGroupButtons not rendering well in viewer - css

I used some of the logic from here
How to put shiny radioGroupButtons into columns
and can't seem to get the layout to look correctly in the viewer pane. The buttons look fine in Chrome. I'm not sure how to fix it.
library(shiny)
library(shinyWidgets)
library(stringr)
# need radioGroupButtons to be in columns
my_css <-
".btn {
padding:2px;
width: 250px;
height: 60px;
}
.btn-group, .btn-group-vertical {
column-count: 3;
column-width: 0;
}"
# if you're not familiar with local() it just prevents clutter in the global env
# by just returning the last object
button_options <- local({
first_3 <- "^([^ ]* ){3}"
sample_sentences <- sentences[1:9]
paste(
"<big>", str_extract(sample_sentences, first_3),
"</big><br>", str_remove(sample_sentences, first_3)
)
})
# build gadget
ui <- fluidPage(
tags$head(tags$style(HTML(my_css))),
shinyWidgets::radioGroupButtons(
inputId = "buttons",
label = NULL,
choices = button_options
)
)
server <- function(input, output) {}
runGadget(shinyApp(ui, server))

The fix was using a CSS grid instead:
.btn-group-container-sw {
display: grid;
grid-template-columns: 1fr 1fr 1fr;
}
.radiobtn {
width: 100%;
}

Related

How to position label beside slider in R Shiny?

There are a few solutions here and here but none of them works on Shiny 1.3.2.
This is what I attempted so far
library(shiny)
server <- shinyServer(function(input, output) { NULL })
ui <- shinyUI(
pageWithSidebar(
headerPanel("side-by-side"),
sidebarPanel(
fluidRow(
tags$head(
tags$style(type="text/css", "label.control-label, .selectize-control.single{ display: table-cell; text-align: center; vertical-align: middle; } .form-group { display: table-row;}")
),
column(2),
column(4,
sliderInput("slider", label = h5("slider") ,value = 500,min = 0, max =1000,ticks = F)
)
)),
mainPanel(
fluidRow(
h3("bla bla")
))
)
)
shinyApp(ui=ui,server=server)
Is there a way to make the slider wider?
There’s a lot of different ways to do positioning with CSS. My choice here would be to use flexbox, as annotated below. Note the use of a
.label-left container to scope the positioning changes.
library(shiny)
ui <- fluidPage(
tags$style(HTML(
"
.label-left .form-group {
display: flex; /* Use flexbox for positioning children */
flex-direction: row; /* Place children on a row (default) */
width: 100%; /* Set width for container */
max-width: 400px;
}
.label-left label {
margin-right: 2rem; /* Add spacing between label and slider */
align-self: center; /* Vertical align in center of row */
text-align: right;
flex-basis: 100px; /* Target width for label */
}
.label-left .irs {
flex-basis: 300px; /* Target width for slider */
}
"
)),
div(class = "label-left",
sliderInput("slider_1", "First slider", 0, 10, 5),
sliderInput("slider_2", "Second slider", 0, 10, 5)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)

Math mode in bsTooltip in shiny

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)

R shiny align 100 radioGroupButtons 10x10

I have the following example, which renders 100 reactive radio button.
library(shiny)
library(shinyWidgets)
if (interactive()) {
ui <- fluidPage(
tags$h1("radioGroupButtons examples"),
radioGroupButtons(
individual = T, selected = "",status = "danger",
inputId = "somevalue1",
label = "Make a choice: ",
choices = rep("x", 100)
),
verbatimTextOutput("value1"),
)
server <- function(input, output) {
output$value1 <- renderPrint({ input$somevalue1 })
}
shinyApp(ui, server)
}
I would like now to arrange/align the buttons in 10 columns by 10 rows, but I cannot figure out which CSS class I should target to do so.
You can use CSS flexbox or grid
Flexbox example :
#content {
display: flex;
flex-wrap: wrap;
width: 250px;
}
#content>input {
width: 25px;
height: 25px;
}
Grid example :
#content {
display: grid;
grid-template-columns: repeat(10, 1fr);
}

Is there a way to *output* star rating in R Shiny?

Dears,
In my app, users rate some stuff.
I want to output 5-star ratings based on their ratings just like the ones in IMDB.
There are fractions in my numbers, and I want the stars to accommodate them.
I don't know Java nor JavaScript at all.
Is there something like a package for this? or what to do?
Thanks in advance.
You'll need to create two files, a css and then your app...ie:
app.R
-- www/
------ stars.css
Your stars.css file will have the rules for the HTML markup which will update based on our app after using includeCSS in the header::
.ratings {
position: relative;
vertical-align: middle;
display: inline-block;
color: #b1b1b1;
overflow: hidden;
}
.full-stars{
position: absolute;
left: 0;
top: 0;
white-space: nowrap;
overflow: hidden;
color: #fde16d;
}
.empty-stars:before,
.full-stars:before {
content: "\2605\2605\2605\2605\2605";
font-size: 44pt; /* Make this bigger or smaller to control size of stars*/
}
.empty-stars:before {
-webkit-text-stroke: 1px #848484;
}
.full-stars:before {
-webkit-text-stroke: 1px orange;
}
/* Webkit-text-stroke is not supported on firefox or IE */
/* Firefox */
#-moz-document url-prefix() {
.full-stars{
color: #ECBE24;
}
}
/* IE */
<!--[if IE]>
.full-stars{
color: #ECBE24;
}
<![endif]-->
In our app we want the final markup to appear as follows:
<div class="ratings">
<div class="empty-stars"></div>
<div class="full-stars" style="width:70%"></div>
</div>
So to do this we use a combination of UI static elements and then uiOutput, which matches a renderUI on the server side:
library(shiny)
ui <- fluidPage(
includeCSS("www/stars.css"),
sliderInput(inputId = "n_stars", label = "Ratings", min = 0, max = 5, value = 3, step = .15),
tags$div(class = "ratings",
tags$div(class = "empty-stars",
uiOutput("stars_ui")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$stars_ui <- renderUI({
# to calculate our input %
n_fill <- (input$n_stars / 5) * 100
# element will look like this: <div class="full-stars" style="width:n%"></div>
style_value <- sprintf("width:%s%%", n_fill)
tags$div(class = "full-stars", style = style_value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Our app then using the slider inpout to create the fill % of stars.
I wrote a package to solve similar problem so that others don't need to work with CSS and JS. https://github.com/shahronak47/shinyRatings
#Installation of the package from Github
#devtools::install_github('shahronak47/shinyRatings')
library(shiny)
library(shinyRatings)
ui <- fluidPage(
shinyRatings('star'),
textOutput('text')
)
server <- function(input, output, session) {
output$text <- renderText({paste("No. of stars : ", input$star)})
}
shinyApp(ui, server)

Target specific dropdown css from shinywidget package

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)

Resources