When I use paste0() to add a reactive value, it tells me that I'm trying to do something that can only be done in a reactive environment. Can someone show me how to make the title reactive?
this code gives a tiny title in renderTable. How can I customise with colour, size, font, centre? Thanks!
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
tableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderTable(iris, striped = TRUE, bordered = TRUE, hover = TRUE, spacing = 'm',
width = '75%', align = 'c', rownames = TRUE, digits = 5,
caption = "Iris",
caption.placement = getOption("xtable.caption.placement", "top"))
}
)
}
Related
I know you can use options to adjust width by hand. Something along the lines:
DT::datatable(mtcars,
options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '70px',
targets = which(colnames(mtcars) %in% c("gear"))),
list(width = '100px',
targets = which(colnames(mtcars) %in% c("disp", "hp")))
)
)
)
I see no way to adjust the column width to fit content, without hardcoded values. I found a datatables function columns.adjust() which theoretically re-adjusts column width to input, but how to use it in R / R shiny?
MRE:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput(outputId = "table")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
DT::datatable(mtcars,
options = list(
autoWidth = TRUE, # here we set fixed width. how to set depending on input?
columnDefs = list(list(width = '70px',
targets = which(colnames(mtcars) %in% c("gear"))),
list(width = '100px',
targets = which(colnames(mtcars) %in% c("disp", "hp")))
)
)
)
})
}
shinyApp(ui, server)
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
I am trying to create a table using the bs_theme() function from the bslib package, specifically using the theme lux. The tables are very large and the cells have massive padding. Adding the "table-cell-padding" argument in bs_theme() doesn't change the cell sizes. How do I make the table compact and the cells tight around the numbers/column names?
Just add tags$style('#DT1 td {padding: 0}'), how simple is that.
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
tags$style('#DT1 td {padding: 0}'),
# style = "width: 50%",
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
Change the padding: 0 to any valid css unit you want, here I changed to 0, no padding. It will seem that it doesn't work on left and right, that's because you have autoWidth, it will always use the full width of the parent node. So, if you want the width to be smaller, uncomment the style line above, you should see is't only half of the screen.
I am making an app in shiny and I want the main panel to occupy 100% of the screen, how can I achieve this? In this occasion I am showing a table but I would also like to add a graph so that it can be seen large.
Below I show the code I am using
screen shiny
library(shiny)
library(DT)
shinyUI(fluidPage(
# Application title
titlePanel("Company-Feature Chart"),
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId =
"diagram")
)
)
)
shinyServer(function(input, output) {
datachart <- read.csv("examplechart1.csv", row.names=1, sep=";")
output$seleccione_col1<- renderUI({
selectInput(inputId="columnaD", (("Product")),
choices =names(datachart),
selected = names(datachart)[c(1,2)],multiple = TRUE)
})
output$seleccione_col2<- renderUI({
selectInput(inputId="columnaE", (("Features")),
choices =row.names(datachart),
selected = row.names(datachart)[1],multiple = TRUE)
})
output$diagram<- renderDataTable({
req(input$columnaE)
data <-datachart[input$columnaE,input$columnaD]
DT::datatable(data, escape = FALSE,options = list(sDom = '<"top">lrt<"bottom">ip',lengthChange = FALSE))
}, rownames = TRUE)
})
Use the width option:
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId = "diagram"),
width = 12
)
I'm trying to scaffold together a basic dashboard using the shinymaterial package (https://ericrayanderson.github.io/shinymaterial/) but having a slight issue where my dropdown menus (usually selectInput in regular shiny apps) don't show up in a nested UI module.
There should be two dropdown menus above the "Settings" button in this screenshot:
Here's the code snippet for my scaffolding so far:
library(shiny)
library(shinymaterial)
# Wrap shinymaterial apps in material_page
ui <- material_page(
title = "App Title",
nav_bar_fixed = FALSE,
nav_bar_color = "black",
background_color = "white",
# font_color = "black",
# Place side-nav in the beginning of the UI
material_side_nav(
fixed = FALSE,
# Place side-nav tabs within side-nav
material_side_nav_tabs(
side_nav_tabs = c(
"Home" = "home",
"About" = "about"
),
icons = c("home", "help")
),
background_color = "white"
),
# Define side-nav tab content
material_side_nav_tab_content(
side_nav_tab_id = "home",
material_row(
material_column(
material_card(title = NULL,
sidebarCharts("main"),
depth = NULL),
width = 2,
offset = 0
),
material_column(
material_card(title = NULL,
"Chart goes here",
depth = NULL),
width = 10,
offset = 0
)
)
),
material_side_nav_tab_content(
side_nav_tab_id = "about",
tags$h1("About")
)
)
server <- function(input, output, session) {
callModule(chartSettings, "main")
}
# Server modules
chartSettings <- function(input, output, session) {
## 'Home' tab -- Sidebar
output$selectRootSymbol <- renderUI({
.choices <- c('a','b','c')
tagList(
helpText("Root Symbol:"), # Note: helpText() looks a little cleaner versus using the 'label' parameter in selectInput() below
# selectInput(session$ns("reactiveRootSymbol"), label = NULL, choices = .choices, selected = NULL, width = '100%')
material_dropdown(session$ns("reactiveRootSymbol"), label = NULL, choices = .choices, selected = NULL, width = '100%')
)
})
output$selectSymbol <- renderUI({
req(input$reactiveRootSymbol)
.choices <- c('d', 'e', 'f')
tagList(
helpText("Symbol:"),
# selectInput(session$ns("reactiveSymbol"), label = NULL, choices = toupper(.choices), selected = NULL, width = '100%')
material_dropdown(session$ns("reactiveSymbol"), label = NULL, choices = toupper(.choices), selected = NULL, width = '100%')
)
})
}
sidebarCharts <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("selectRootSymbol")),
uiOutput(ns("selectSymbol")),
# actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-primary"),p()
material_button(ns("settings"), "Settings", icon = "settings")
)
}
shinyApp(ui = ui, server = server)
I think I have a namespace issue, but I'm not sure (since the button does show up in the nested module). What am I doing wrong?
Any help is much appreciated!
There are at least two issues here.
1. material_dropdown does not display (resolved)
This appears to be due to the unused width = 100% option inside material_dropdown(). Removing this results in some of the drop downs displaying and all of the labels displaying.
2. Consecutive material_dropdown does not display (unresolved)
Having two consecutive material_dropdown's results in only the first drop down displaying, even though both labels display. There have been previous bugs with material_dropdown in the shinymaterial package so this could be part of a related issue.
Here is the code following my exploration:
library(shiny)
library(shinymaterial)
# submodule UI
sidebarCharts <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("selectRootSymbol")),
uiOutput(ns("selectSymbol")),
# actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-primary"),p()
material_button(ns("settings"), "Settings", icon = "settings")
)
}
# submodule server
chartSettings <- function(input, output, session) {
## 'Home' tab -- Sidebar
output$selectRootSymbol <- renderUI({
.choices <- c('a','b','c')
material_dropdown(session$ns("reactiveRootSymbol"), label = "Root Symbol:", choices = .choices)
})
output$selectSymbol <- renderUI({
# req(input$reactiveRootSymbol)
.choices <- c('d', 'e', 'f')
material_dropdown(session$ns("reactiveSymbol"), label = "Symbol:", choices = .choices)
})
}
## Wrap shinymaterial apps in material_page ----
ui <- material_page(
title = "App Title",
nav_bar_fixed = FALSE,
nav_bar_color = "black",
background_color = "white",
# font_color = "black",
# Place side-nav in the beginning of the UI
material_side_nav(
fixed = FALSE,
# Place side-nav tabs within side-nav
material_side_nav_tabs(
side_nav_tabs = c(
"Home" = "home"
),
icons = c("home")
),
background_color = "white"
),
# Define side-nav tab content
material_side_nav_tab_content(
side_nav_tab_id = "home",
material_row(
material_column(
material_card(title = NULL,
sidebarCharts("main"),
depth = NULL),
width = 2,
offset = 0
),
material_column(
material_card(title = NULL,
"Chart goes here",
depth = NULL),
width = 10,
offset = 0
)
)
)
)
## main server ----
server <- function(input, output, session) {
callModule(chartSettings, "main")
}
## run ----
shinyApp(ui = ui, server = server)
Fairly new to R - doing OK with big picture stuff, and struggling on cleaning up the edges when I want to present something to other people.
Banging my head against the wall with something that's probably pretty simple - I simply want to add cell borders - to all cells - in a datatable in a shiny app. Here's a relevant chunk of code:
library(ggplot2)
library(shiny)
library(data.table)
library(DT)
library(plotly)
setwd("C:/Users/Will/Desktop/FinalPages")
lister <- read.table("PlayerList.csv", header=TRUE, quote ="", sep=",",fill = TRUE)
totals <- read.table("TotShooting.csv", header=TRUE, quote ="", sep=",",fill = TRUE)
items <- as.character(lister[[1]])
ui <- fluidPage(
sidebarLayout(
sidebarPanel(selectizeInput("players", "Player:", choices = items, multiple = FALSE),
width=2
),
mainPanel(h5("Total Shooting", align = "center"),
div(dataTableOutput("tot"), style = "font-size:80%", class = 'table-condensed cell-border row-border'),
position="center",
width = 10)
)
)
server <- function(input, output) {
output$tot <- DT::renderDataTable({
validate(
need(input$players, ' ')
)
filterone <- subset(totals, Name == input$players)
filterone <- filterone[,-1:-2]
DT::datatable(filterone,
rownames = FALSE,
options=list(iDisplayLength=7,
bPaginate=FALSE,
bLengthChange=FALSE,
bFilter=FALSE,
bInfo=FALSE,
rowid = FALSE,
autoWidth = FALSE,
ordering = FALSE,
scrollX = TRUE,
borders = TRUE,
columnDefs = list(list(className = 'dt-center', targets ="_all"))
))
}
)
I've been trying to track it down via google, but haven't been able to hit on a solution I can get to work. It's probably something very simple with tags, or a correct class name (I hope so, at least), but I'm lost here. Appreciate any help I can get.
The function that you are looking for is : formatStyle("your DT table", "vector of column index", border = '1px solid #ddd').
You can find a reproducible example here :
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("test")
),
server = function(input, output, session) {
output$test <- DT::renderDataTable({
datatable(mtcars) %>%
formatStyle(c(1:dim(mtcars)[2]), border = '1px solid #ddd')
})
})
There must be more elegant ways but it works !