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)
Related
I have a shiny app with a DT::DataTable element in which the first column is a row header and the second column contains data. How can I change the color of the first column to be white text on a black background? If found ways to change the column headers (section 4.3 here), but I how do I get the same effect applied to the first column?
Here's some example code showing a very simplified version of the table without the desired effect. I'm certain that adding something to the options list in the renderDataTable function will solve it, but I don't know what to add.
EDIT: Below is a solution suggested by #Stéphane Laurent, which answers my original question. However, it makes the change to all tables present on the app. In my modified code, below, the global change is shown, but how do I target just one of the two tables?
library(shiny)
library(DT)
CSS <- HTML(
"td.firstcol {color: white; background-color: black}"
)
ui <- fluidPage(
tags$head(
tags$style(CSS)
),
fluidRow(
column(3,
DTOutput(outputId = 'tbl')
),
column(3,
DTOutput(outputId = 'tbl2')
)
)
)
server <- function(input, output) {
output$tbl<- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
output$tbl2 <- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
library(shiny)
library(DT)
CSS <- HTML(
"td.firstcol {color: white; background-color: black}"
)
ui <- fluidPage(
tags$head(
tags$style(CSS)
),
fluidRow(
column(3,
DTOutput(outputId = 'tbl')
)
)
)
server <- function(input, output) {
output$tbl<- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In the below MWE code I'd like to find a neat, organised way to arrange user checkbox inputs. The fluidRows and columns that I use are hard to work with and present cleanly. In the full App this MWE derives from, there are 12 user checkboxes so I need to find a clean way to arrange them and place them close together. As you can see in the below image and when running the code, the buttons do not line up in the rows correctly, the rows are too tall, gridlines would be helpful, etc.
The below code only uses "Show" and "Hide" checkboxes for the sake of clarity.
MWE code:
rm(list = ls())
library(shiny)
library(shinyMatrix)
library(shinyjs)
firstInput <- function(inputId){
matrixInput(inputId,
value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
secondInput <- function(inputId,x){
matrixInput(inputId,
value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
ui <- fluidPage(
titlePanel("Model"),
sidebarLayout(
sidebarPanel(
uiOutput("panel"),
hidden(uiOutput("secondInput"))),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output, session) {
input1 <- reactive(input$input1)
input2 <- reactive(input$input2)
output$panel <- renderUI({
tagList(
useShinyjs(),
firstInput("input1"),
strong(helpText("Generate curves (Y|X):")),
div(style = "font-size: 14px; padding: 0px; margin-top:0em",
fluidRow(
fluidRow(
column(5,),
column(2,helpText("Show"),align="center"),
column(2,helpText("Hide"),align="center"),
column(2,helpText("Reset"),align="center")
),
div(style = "font-size: 14px; padding: 0px; margin-top:0em",
fluidRow(
column(5, helpText("1st input"),offset = 1),
column(2, checkboxInput('show', NULL, value = FALSE, width = NULL)),
column(2, checkboxInput('hide', NULL, value = FALSE, width = NULL)),
column(2,)
)
),
div(style = "font-size: 14px; padding: 0px; margin-top:0em",
fluidRow(
column(5,helpText("2nd input"),offset = 1),
column(2,),
column(2,),
column(2,)
)
)
)
)
)
})
output$secondInput <- renderUI({
req(input1())
secondInput("input2",input$input1[1,1])
})
outputOptions(output, "secondInput", suspendWhenHidden = FALSE)
output$plot1 <-renderPlot({
req(input2())
plot(rep(input2(),times=5))
})
observeEvent(input$show,{
shinyjs::show("secondInput")
updateCheckboxInput(session, "hide", value = FALSE)
})
observeEvent(input$hide,{
shinyjs::hide("secondInput")
updateCheckboxInput(session, "show", value = FALSE)
})
}
shinyApp(ui, server)
You can try to put these inputs in a table:
library(shiny)
f <- function(action, i){
as.character(
checkboxInput(paste0(action, i), label = NULL)
)
}
actions <- c("shovv", "hide", "reset")
tbl <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Shovv", "Hide", "Reset")
rownames(tbl) <- c("1st input", "2nd input")
ui <- fluidPage(
br(),
tableOutput("checkboxes")
)
server <- function(input, output){
output[["checkboxes"]] <- renderTable({
tbl
},
rownames = TRUE, align = "c",
sanitize.text.function = function(x) x
)
observe({
print(input[["hide1"]])
})
}
shinyApp(ui, server)
With a bit of CSS, it renders well in the sidebar:
ui <- fluidPage(
tags$head(
tags$style(HTML(
"td .checkbox {margin-top: 0; margin-bottom: 0;}
td .form-group {margin-bottom: 0;}"
))
),
br(),
sidebarLayout(
sidebarPanel(
tableOutput("checkboxes")
),
mainPanel()
)
)
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)
)
)
I am currently developing a shiny app and I face an issue with the dynamic alignment of the data table.
The code used is
ui.R
shinyUI(fluidPage(
dashboardPage(
dashboardBody(
tabItems(
tabItem(tabName = "view_id",
sidebarLayout(
sidebarPanel(width = 2, checkboxGroupInput("sidebar", "People Viewer",
sidebar_content)
),
mainPanel(width=10,style ="background-color:RGB(255,255,255); border-color:RGB(255,255,255);align:left;",
wellPanel(DTOutput("tab") )
)
)
)
)
)))
server.R
shinyServer(function(input, output) {
output$tab <- {
renderDT(datatable(pep_view[ ,input$sidebar, drop = FALSE ], filter = 'top', extensions = 'FixedColumns',
options = list(scrollX = TRUE,scrollY = "400px" ,fixedColumns = TRUE, pageLength = 10, autoWidth = TRUE
), class = 'cell-border stripe')
)
}
})
The output obtained is
Can anyone resolve this issue? Thanks in advance!!
This is an issue with the package DT in R, for Shiny apps.
I noticed that with the option fixedHeader = TRUE, the frozen header will appear on all tabs of a Shiny app. Here is an example illustrating the problem. Simply go to "Tab2" and scroll down, and the header from "Tab1" should be visible (unwanted). I would like the header to only appear on "Tab1".
library(shiny)
library(DT)
data("volcano")
ui = shinyUI(navbarPage(title = 'Navbar',
tabPanel('Table',
fluidPage(
fluidRow(
column(width = 12,
DT::dataTableOutput('table'))
)
)
),
tabPanel('Tab2',
fluidPage(
fluidRow(
column(width = 4,
style = "height:1500px;background-color:#f0f0f5;border-radius:6px 0px 0px 6px;
box-shadow:1px 1px 8px #888888")
)
)
)
))
server = shinyServer(function(input, output){
output$table <- DT::renderDataTable(
volcano,
extensions = c('Buttons', 'FixedHeader'),
options = list(
pageLength = 100,
fixedHeader = TRUE
)
)
})
runApp(list(ui=ui, server=server), launch.browser = TRUE)