trouble decreasing margin between elements in shiny app - r

I'm trying to reduce the margin between two elements on this shiny app. When open in a browser, the whitespace between the two is huge.
I tried setting the css by adding style = "margin:0px; padding:0px" to the UI, but it did not help. I also tried messing with the inline = TRUE settings, also no help.
ui <- fluidPage(
fluidRow(
column(width = 3,
htmlOutput("select1", inline = TRUE, style = "margin:0px; padding:0px")
),
column(width = 3,
htmlOutput("select2", inline = TRUE, style = "margin:0px; padding:0px")
),
column(width = 6)
)
)
server <- function(input, output, session) {
output$select1 <- renderUI({
pickerInput(
inputId = "select1",
label = "LETTERS",
#choices = sort(unique(inventory$SubDivision)),
choices = LETTERS,
options = list(
"actions-box" = TRUE,
size = 10,
`live-search`=TRUE
),
multiple = TRUE
)
})
output$select2 <- renderUI({
pickerInput(
inputId = "select2",
label = "letters",
#choices = sort(unique(inventory$SubDivision)),
choices = letters,
options = list(
"actions-box" = TRUE,
size = 10,
`live-search`=TRUE
),
multiple = TRUE
)
})
}
shinyApp(ui, server)
Whitespace in browser:

The issue here is not the margin or padding, but the limit of the width to 300px. To allow the control to grow to full size of the column, you can change the global style :
ui <- fluidPage(
fluidRow(
tags$head(
tags$style(HTML("
.shiny-input-container:not(.shiny-input-container-inline) {
width:100%;
}"))
),
column(width = 3,
htmlOutput("select1", inline = TRUE)
),
column(width = 3,
htmlOutput("select2", inline = TRUE)
),
column(width = 6)
)
)

Related

Data table greater than WellPanel in Shiny

How can I increase the size of the WellPanel to have my table completely inside the "grey" box?
image here
(I'm new in Shiny and edited the table due to confidential data).
I tried
wellPanel(
fluidRow(
fluidPage(
and only
wellPanel(
fluidRow(
None of then works
wellPanel(
fluidRow(
fluidPage(
headerPanel(""),
column(12, align="center",
output$dataprint_controles <- DT::renderDataTable({
datatable(data,
rownames = FALSE,
options = list(paging = TRUE,
scrollX = TRUE,
searching = TRUE,
ordering = FALSE,
autoWidth = FALSE,
names = TRUE,
columnDefs = list(list(visible = FALSE, targets = esconder),
list(className = 'dt-center', targets = "_all")
),
dom = '<"sep">',
headerCallback = DT::JS(stringr::str_glue(
"function(thead) {{",
" $(thead).closest('thead').find('th').css('border-top', '2px solid black');",
" $(thead).closest('thead').find('th').css('border-left', '0px solid black');",
" $(thead).closest('thead').find('th').css('background', '#D9D9D9');",
" $(thead).closest('thead').find('th').css('color', 'black');",
" $(thead).closest('thead').find('th').css('text-align', 'center');",
"}}"
))
)
)
}),
),
)
), # fecha fluid
), # fecha well panel
fluidPage should be the most outer element of the UI, and column must be contained in fluidRow. The wellPanel does not go beyond a width of 100%, so you have to add the CSS propert width: fit-content;.
library(shiny)
library(DT)
mat <- matrix(rnorm(5*14), nrow = 5, ncol = 14)
ui <- fluidPage(
fluidRow(
column(
12,
wellPanel(
style = "width: fit-content;",
DTOutput("dtable")
)
)
)
)
server <- function(input, output, session) {
output$dtable <- renderDT({
datatable(mat)
})
}
shinyApp(ui, server)

How to replace fluidRow with a horizontally scrollable non-wrapping row in tab panel?

The reproducible code below uses a fluidRow() to house several user selections using radio buttons. Works fine in this limited example of only 2 radio button groupings. But I need to fit more radio button groupings into this row, without any wrapping. To do this, I'd like to replace this combination of fluidRow()/column() with a horizontally scrollable, non-wrapping row that is not subject to the limitations of the 12-wide grid system currently used in this code.
Also, all objects viewed in the scrolling row need to be left aligned without "fluid" expansion. Currently, using this fluidRow()/column() combo, if the viewing pane is expanded, the 2 columns housing each radio button grouping also expanded which doesn't look good. They need to remain fixed width and stay to the left.
Is this possible?
I prefer sticking with this sidebar/main panel/tab panel/conditional panel layout as I find it very user friendly for navigating the type of data we work with.
The image at the bottom further explains.
Reproducible code:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)
How about using a carousel instead e.g. via shinyglide or slickR:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
library(shinyglide)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(12, glide(
height = "25",
controls_position = "top",
screen(
p(strong("Group 1")),
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
screen(
p(strong("Group 2")),
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
))
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)

How to apply css style to actionBttn from shinywigets in shiny

I have an example shiny app as below. In order to the actionButton with selectInput, I need to add style='margin-top:25px'. Shinywidgets package has actionBttn widgets with some built-in style. For example, I like the one with style='gradient'. But I wonder how I can use css style to add margin on the top to align the actionBttn with other element?
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "example"),
dashboardSidebar(),
dashboardBody(
box(width=12,
column(width = 3, dateRangeInput("dateRange", "Date Range",
start = "2017-01-01",
end = Sys.Date(),
min = "2001-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - ") ),
column(width=3, selectizeInput(inputId = 'var',
label='Select variable',
choices = c('cut', 'color'),
multiple=FALSE,
options = list(
maxItems = 1,
placeholder = '',
onInitialize = I("function() { this.setValue(''); }"))) ),
column(width=1, offset =2, actionButton('Apply', 'Apply', style='margin-top:25px') ),
column(width=3, actionBttn(
inputId = 'clear',
label = "Clear",
style = "gradient",
color = "danger" ) )
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Hard to say with out your .css but You can find a sample in here
To add a style to an existing element created by a package, sometimes you have to wrap that element. Here's three approaches:
Wrap the element itself in a div with the style you want. May not work for all CSS elements.
Write your own custom function using the source from your desired element. Here I used the source from https://github.com/dreamRs/shinyWidgets/blob/ac8134e944f91fdcc4490ace6d839c46e7df02ff/R/actionBttn.R#L63
Add in some external CSS that targets only that element. This is my least favored approach because it moves the logic away from where it's actually being applied, and you have to keep track of it for each element you want to modify.
library(shiny)
library(shinyWidgets)
# new function for approach #2
actionBttn_with_style <- function(inputId, label = NULL, icon = NULL, style = "unite",
color = "default", size = "md", block = FALSE,
no_outline = TRUE, my_additional_style = "") {
value <- shiny::restoreInput(id = inputId, default = NULL)
style <- match.arg(
arg = style,
choices = c("simple", "bordered", "minimal", "stretch", "jelly",
"gradient", "fill", "material-circle", "material-flat",
"pill", "float", "unite")
)
color <- match.arg(
arg = color,
choices = c("default", "primary", "warning", "danger", "success", "royal")
)
size <- match.arg(arg = size, choices = c("xs", "sm", "md", "lg"))
tagBttn <- htmltools::tags$button(
id = inputId, type = "button", class = "action-button bttn", `data-val` = value,
class = paste0("bttn-", style),
class = paste0("bttn-", size),
class = paste0("bttn-", color), list(icon, label),
class = if (block) "bttn-block",
class = if (no_outline) "bttn-no-outline",
style = my_additional_style
)
shinyWidgets:::attachShinyWidgetsDep(tagBttn, "bttn")
}
After you make your custom button function, you can use it just like actionBttn inside your ui.
ui <- dashboardPage(
dashboardHeader(
title = "example"
),
dashboardSidebar(),
dashboardBody(
# for approach #3, but this is far away from the button in the code
htmltools::tags$head(
htmltools::tags$style('button#clear_ext_css { margin-top:25px }')
),
box(
width = 12,
column(
width = 2,
dateRangeInput(
"dateRange",
"Date Range",
start = "2017-01-01",
end = Sys.Date(),
min = "2001-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - "
)
),
column(
width = 1,
actionButton('Apply', 'Apply', style = 'margin-top:25px')
),
column(
width = 3,
# approach #1, just wrapping it in a styled div
div(
actionBttn(
inputId = 'clear_div',
label = "Clear with div",
style = "gradient",
color = "danger"
),
style = 'margin-top:25px'
)
),
column(
width = 3,
# approach #2, custom function from above
actionBttn_with_style(
inputId = 'clear_fn',
label = "Clear with custom function",
style = "gradient",
color = "danger",
my_additional_style = 'margin-top:25px'
)
),
column(
width = 3,
# approach #3, but you don't see any custom logic here
actionBttn(
inputId = 'clear_ext_css',
label = "Clear with external CSS",
style = "gradient",
color = "danger"
)
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

Reset tableoutput with action button in shinydashboard

I have an shinydashboard app, the app get an filter box and a tabset which show a datatatable depending on filter.
I have a reset button which reset the filters whith shinyjs::reset function, and I want to reset also the tableset and showing the complete table or nothing.
I want also to do it for a valuboxes.
My app is like this :
For server interface I have an basic : output$tableprint_A <- DT::renderDataRable ({})
ui :
body <- dashboardBody(
tabItems(
#### First tab item #####
tabItem(tabName = "fpc",
fluidRow(
infoBoxOutput("kpm_inf", width = 6),
infoBoxOutput(outputId = "fpc_inf", width = 6)
),
fluidRow(
box(title = "Variables filter",
shinyjs::useShinyjs(),
id = "side_panel",
br(),
background = "light-blue",
solidHeader = TRUE,
width = 2,
selectInput("aaa", "aaa", multiple = T, choices = c("All", as.character(unique(fpc$aaa))))
br(),
br(),
p(class = "text-center", div(style = "display:inline-block", actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right"))),
div(style = "display:inline-block", actionButton("reset_button", "Reset",
icon = icon("repeat")))),
p(class = 'text-center', downloadButton('dl_fpc', 'Download Data'))),
tabBox(
title = tagList(),
id = "tabset1",
width = 10,
tabPanel(
"A \u2030 ",
DT::dataTableOutput("tableprint_A"),
bsModal(id = 'startupModal', title = 'Update message', trigger = '',
size = 'large',
tags$p(tags$h2("Last update of A : 01/09/2017",
br(), br(),
"Last update of B : 01/09/2017",
br(), br(),
"Last update of C : 01/09/2017",
style = "color:green", align = "center")))
),
tabPanel(
"B % Table",
DT::dataTableOutput("tableprint_B")),
type = "pills"
)
),
fluidRow(
# Dynamic valueBoxes
valueBoxOutput("info_gen", width = 6)
)
I tried this :
observeEvent(input$reset_button, {
output$tableprint_A <- NULL
})
Edit:
I want something like that, but when I action the search button I want it to appear again :
shinyjs::onclick("reset_button",
shinyjs::toggle(id = "tableprint_A", anim = TRUE))
You should try this out:
output$tableprint_A <- renderDataTable({
if(input$reset_button == 1) {
NULL
}else{
datatable(...)
}
})
if the button is clicked then nothing will be displayed, else the datatable is shown.
[EDIT]
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(selectInput("select", "select", choices = unique(iris$Species), multiple = T),
actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right")),
actionButton("reset_button", "Reset",
icon = icon("repeat")),
DT::dataTableOutput('tbl')),
server = function(input, output) {
values <- reactiveValues(matrix = NULL)
observe({
if (input$go_button == 0)
return()
values$matrix <- iris[iris$Species %in% input$select, ]
})
observe({
if (input$reset_button == 0)
return()
values$matrix <- NULL
})
output$tbl = DT::renderDataTable({
datatable(values$matrix, options = list(lengthChange = FALSE))}
)
}
)

shiny fluidrow column white space

I have a top banner that I want to split into two separate sections representing two different inputs. To do this, I've created a fluidRow and with two columns, one for each input. However, as it is now there is a little bit of white space between the columns, despite putting offset = 0. Is there any way to remove this white space so that the columns are immediately next to one another?
colors = c("green","blue","red")
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Info",
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 1")
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 2")
)
)
),
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "color",label = "color:",
choices = colors,
selected = colors[2],
multiple = FALSE)
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "points",label = "Number of Points:",
choices = c("30","60","90"),
selected = "10",
multiple = FALSE) )
)
),
br(),
br(),
fluidRow(
actionButton(inputId = "go",
label = "Update"
)
),
fluidRow(
plotOutput("plot", width = "100%")
)
)
)
)
server <- function(input, output,session) {
data = eventReactive(input$go, {
var1 = rnorm(isolate(as.numeric(input$points)),5)
cat1 = c(rep("red",length(var1)/3),rep("blue",length(var1)/3),rep("green",length(var1)/3))
data = cbind.data.frame(var1,cat1)
plotdata = data[which(data$cat1 ==isolate(input$color)),]
}
)
output$plot = renderPlot({
plotdata = data()
plotcol = isolate(input$color)
plot(plotdata$var1, col = plotcol)
})
}
shinyApp(ui = ui,server = server)
The white space is the padding of the column div. To remove that, use
column(width = 6, offset = 0, style='padding:0px;', ...)

Resources