I'm trying to style a table in a Shiny app using the tableHTML package in R.
When I use the tableHTML() function in R it produces exactly what I want. I use the add_css_column to align the text in the column to the centre. However when I use it in a Shiny app the headers end up left aligned and the rows centre aligned. Any ideas how I can fix this?
output$viewers_website_top <- renderUI({
tableHTML(website_index, rownames = FALSE, widths=c(200,200)) %>%
add_css_column(css = list("text-align", "center"),
column_names = names(website_index))
})
This is a common issue with bootstrap 3 unfortunately. Whenever you use shiny it loads up a bootstrap 3 css (immediately) which makes it difficult to overwrite.
As for the solution to this using add_css_header would probably solve this one. add_css_header would change the th tag of the HTML table to the one you like (whereas add_css_header would change the td tags below the headers):
output$viewers_website_top <- renderUI({
tableHTML(website_index, rownames = FALSE, widths=c(200,200)) %>%
add_css_header(css = list("text-align", "center"),
headers = 1:ncol(website_index))
})
Another thing you can do is to add a separate css file with shiny::includeCSS. There is more info here and here on how to use includeCSS.
In the css file you need to write:
.table_website_index th {
text-align: center;
}
And that should do it!
P.S. table_website_index is the class the package assigns to the table which you can also change with the class argument.
P.S.2 I am the developer - thanks for using the package :)
Related
I have four goals:
Connect to a Postgresql database and pull some data
Gloss up a table with some colour and formatting
Include an image (company logo) above it
Export as PDF
1 and 2 are easy enough and 4 seems possible even if not convenient, but I don't think R was designed to add and position images. I've attached some sample code of how I envision creating the table, and then a mockup of what I think the final version might look like. Can anyone advise on the best way to accomplish this?
Sample data:
data(mtcars)
df <- head(mtcars)
HTML approach: flexible and portable to other apps
library(tableHTML)
html_table <- df %>%
tableHTML(rownames = FALSE, border = 0) %>%
add_css_row(css = list(c('font-family', 'text-align'), c('sans-serif', 'center'))) %>%
add_css_header(css = list(c('background-color', 'color'), c('#173ACC', 'white')), headers = 1:ncol(df))
Grob approach: Creating a ggplot-like image. I've seen recommendations to use grid.arrange to place an image on top and export as a PDF
library(ggpubr)
tbody.style = tbody_style(color = "black",
fill = "white", hjust=1, x=0.9)
grob_table <- ggtexttable(df, rows = NULL,
theme = ttheme(
colnames.style = colnames_style(color = "white", fill = "#173ACC"),
tbody.style = tbody.style
)
)
grid.arrange(table_image)
You are almost there. You just need to import your image (could be png, jpeg or svg) then pass it to grid::rasterGrob. Use the options in rasterGrob to adjust size etc. Then pass your grob table to gridExtra::grid.arrange
logo_imported <- png::readPNG(system.file("img", "Rlogo.png", package="png"), TRUE)
lg <- grid::rasterGrob(logo_imported)
gridExtra::grid.arrange(lg, grob_table)
You can then either render this to pdf by adding it to an rmarkdown report (probably best), or you can save directly to pdf via
gridExtra::grid.arrange(lg, grob_table)
pdf(file = "My Plot.pdf",
width = 4, # The width of the plot in inches
height = 4)
I´m starting to play with plot.ly in R and I´m amazed with the possibilities to publish my graphs directly in html using htmlwidgets.
Until now I´m unable to save multiple widgets in the same html.
I have saved multiple widgets in stand-alone htmls and than combine it by hand in the html code, but I would like to be able to do it in R.
A simple example:
#graph
graph<- ggplot(df, aes(x = Data, y=tax))+ geom_bar(stat='identity')
gg <- ggplotly(graph)
# save as HtmlWigdet
htmlwidgets::saveWidget(as.widget(gg), "Index.html")
How can I parse multiple ggplotly objects to saveWidgets?
(This is my first question here in stackoverflow, hope I did it right! Regards!)
This is the function I adapted from bits and pieces of the htmltools package to save a tag list and then return an iframe tag. You can wrap multiple htmlwidgets with htmltools::tagList, and then use this function to save the whole bunch.
save_tags <- function (tags, file, selfcontained = F, libdir = "./lib")
{
if (is.null(libdir)) {
libdir <- paste(tools::file_path_sans_ext(basename(file)),
"_files", sep = "")
}
htmltools::save_html(tags, file = file, libdir = libdir)
if (selfcontained) {
if (!htmlwidgets:::pandoc_available()) {
stop("Saving a widget with selfcontained = TRUE requires pandoc. For details see:\n",
"https://github.com/rstudio/rmarkdown/blob/master/PANDOC.md")
}
htmlwidgets:::pandoc_self_contained_html(file, file)
unlink(libdir, recursive = TRUE)
}
return(htmltools::tags$iframe(src= file, height = "400px", width = "100%", style="border:0;"))
}
What is the use-case you're after? You may want to consider adding these graphs to a Flexdashboard (which is created in R Markdown). It's been my recent goto, combined with Plotly.
I am trying to add padding to a table I am creating in an RMarkdown file that will generate both a pdf and an html flexdashboard. I know that there are a number of functions/packages I could use (pander, xtable, DT, etc.), but I would prefer to use the kable function from the knitr package.
The trouble I am having is that the padding argument does not seem to work. I would appreciate any help in solving this without having to add custom CSS to my document.
As a example, I have tried to run the code with padding set to 0, 10, 20 but the tables all look identical in the html file.
knitr::kable(head(cars), format = "html", padding = 0)
knitr::kable(head(cars), format = "html", padding = 10)
knitr::kable(head(cars), format = "html", padding = 20)
I am using knitr_1.14 and rmarkdown_1.0, and my session information is as follows.
R version 3.3.0 (2016-05-03)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1
The option table.attr='cellpadding="20px"' does not work for me. Using CSS styles and adding a class to the table with table.attr='class="myTable"' leads to all tables having the desired padding property (even if only one table carries the new class).
If I only want to modify one single table I usually go with jQuery:
---
title: "Table Cell Padding"
output: html_document
---
```{r}
knitr::kable(head(cars), format = "html")
```
```{r}
knitr::kable(head(cars), format = "html", table.attr='class="myTable"')
```
<style>
.myTable td {
padding: 40px;
}
</style>
Another option is to use jQuery to edit individual elements. The following example modifies the table in the same way as the CSS styles above.
<script type="text/javascript">
// When the document is fully loaded...
$(document).ready(function() {
// ... select the cells of the table that has the class 'myTable'
// and add the attribute 'padding' with value '20px' to each cell
$('table.myTable td').css('padding','20px');
});
</script>
Here I add the class myTable to the table I want to modify. Afterwards I execute some JavaScript (see comments).
You could add any other CSS property to the table elements (or the table itself $('table.myTable').css(...)) in the same way (e.g. $('table.myTable td').css('background-color','red');)
I've written an R shiny application and am styling it before I complete it. I've written a small amount of HTML and want to change things such as the background colour using CSS.
After consulting online I found I needed to seperate my css using the class argument, however when I specify a class for each page, it brings back no CSS at all.
Below is a shortened version of my R shiny application. Any help would be greatly appreciated.
library(shiny)
setwd("C:\\Users\\FRSAWG\\Desktop\\Application\\Shiny")
user <- shinyUI(navbarPage("",
tabPanel("Home Page",
div(class="one",
div(tags$style("#one body{background-color:blue;color:white;font-family:Arial}"),
div(HTML("<h1><b><center>Home Page</center></b></h1>"))))),
tabPanel("Glossary",
div(class="two",
div(tags$style("#two body{background-color:red;color:white;font-family:Arial}"),
div(HTML("<h1><b><center>Glossary</center></b></h1>")))))
))
serv <- shinyServer(function(input, output) {})
shinyApp(user, serv)
For reference I've designated one and two the class names for each of the pages.
UPDATE: Using the package shinyjs by Dean Attali (link), I wrote a helper function that you can call from R to create and run a jQuery function to modify the CSS element of a given object (or selector, in general) based on input from R syntax. You can use this to modify the CSS for your <body> when the tab changes.
This solves the problem with my previous suggestion - now there's no need to toggle the class of the body, which was sometimes causing flickering when for a split second all of the style classes for <body> were toggled off.
Here's the working example:
library(shiny)
library(shinyjs)
## Modify the CSS style of a given selector
modifyStyle <- function(selector, ...) {
values <- as.list(substitute(list(...)))[-1L]
parameters <- names(values)
args <- Map(function(p, v) paste0("'", p,"': '", v,"'"), parameters, values)
jsc <- paste0("$('",selector,"').css({", paste(args, collapse = ", "),"});")
shinyjs::runjs(code = jsc)
}
# UI for the app
user <- shinyUI(
navbarPage(title = "", id = "navtab",
header = div(useShinyjs()),
tabPanel("Home Page",
div(HTML("<h1><b><center>Home Page</center></b></h1>")),
"More text."
),
tabPanel("Glossary",
div(HTML("<h1><b><center>Glossary</center></b></h1>")),
"More text."
)
)
)
# Server for the app
serv <- shinyServer(function(input, output, session) {
observeEvent(input$navtab, {
currentTab <- input$navtab # Name of the current tab
if (currentTab == "Home Page") {
modifyStyle("body", background = "blue", color = "white", 'font-family' = "Arial")
}
if (currentTab == "Glossary") {
modifyStyle("body", background = "red", color = "white", 'font-family' = "Arial")
}
})
})
shinyApp(user, serv)
I'm new to CSS myself, but it seems your problem can be fixed by just altering the CSS tags slightly. Changing the #one to .one and removing the body preceding the brackets will make the CSS style get applied to the divs of class one.
Using the selector #one would be changing the CSS style of a div whose id, not class, is one. Here's a link to a guide on w3shools.com explaining the use of different selectors in CSS syntax.
Some other notes:
You could also use a tags$head to organize your style tags in
one place, instead of spreading them around the code. (This is down to personal preference, though.)
You can pass a class argument to tabPanel to set its CSS class - this removes the need for the inner div to set the class.
Modified example code:
library(shiny)
user <- shinyUI(navbarPage(
tags$head(
tags$style(HTML(".one {background-color: blue; color: white; font-family: Arial}")),
tags$style(HTML(".two {background-color: red; color: white; font-family: Arial}"))
),
tabPanel("Home Page", class = "one",
div(HTML("<h1><b><center>Home Page</center></b></h1>")),
"More text."
),
tabPanel("Glossary", class = "two",
div(HTML("<h1><b><center>Glossary</center></b></h1>")),
"More text."
)
))
serv <- shinyServer(function(input, output) {})
shinyApp(user, serv)
Like I mentioned, I'm new to CSS, so I'm not 100% sure if this is the output you are looking for, though.
EDIT2: Here's a solution using the package shinyjs to update the class of the <body> when the selected tab changes. (Note that in order to use the functions from shinyjs, you need to include useShinyjs() in your ui.)
The idea is to make navbarPage return the name of the tab that's currently active in input$navtab by setting its id to navtab. Then we can use the toggleClass function from the package shinyjs to change the class of the <body> dynamically, and thus have the appropriate CSS styling applied.
It's not perfect, since the class change only happens after the server gets notified that the tab has changed, which sometimes causes the background to flash before changing. It can get a bit annoying. I suspect a better solution would be to use javascript to change the <body> class when clicking the link to change the tab, but I couldn't figure out how to do that with Shiny.
Here's the code:
library(shiny)
library(shinyjs)
user <- shinyUI(
navbarPage(title = "", id = "navtab",
header = tags$head(
useShinyjs(),
tags$style(HTML(".one {background: blue; color: white; font-family: Arial}")),
tags$style(HTML(".two {background: red; color: white; font-family: Arial}"))
),
tabPanel("Home Page",
div(HTML("<h1><b><center>Home Page</center></b></h1>")),
"More text."
),
tabPanel("Glossary",
div(HTML("<h1><b><center>Glossary</center></b></h1>")),
"More text."
)
)
)
serv <- shinyServer(function(input, output, session) {
observeEvent(input$navtab, {
shinyjs::toggleClass(selector = "body", class = "one",
condition = (input$navtab == "Home Page"))
shinyjs::toggleClass(selector = "body", class = "two",
condition = (input$navtab == "Glossary"))
})
})
shinyApp(user, serv)
I am wondering how I can create a (html) table cell by cell with dynamic content in shiny?
right now I am using the following combination:
server.R
output$desc <- renderTable(
hdx.desc()
)
ui.R
tabsetPanel(
tabPanel("Description", tableOutput("desc"))
)
This works well. I would like to set links to some cells and also add some additional layout setting to the table like bold, without border etc. and also don't want to the row numbers at the front.
How can I do this? I tried the HTML() command, but it did't work.
Thanks for your help.
If you want to use renderTable the easiest way to style your table is using css. Removing the row numbers requires passing the option include.rownames = FALSE to print.xtable. There is a ... argument in the renderTable function that does this. You can include html in your table and use the sanitize.text.function argument.
runApp(list(
ui = bootstrapPage(
tableOutput("myTable")
, tags$head(tags$style(type="text/css",
"#myTable table th td {
border: 1px solid black !important;
}
#myTable table th
{
background-color:green;
color:white;
}"
))
),
server = function(input, output) {
output$myTable <- renderTable({
temp = c(runif(4),
as.character(tags$a(id = 'myId', href='http://www.example.com', runif(1)))
)
data.frame(date=seq.Date(Sys.Date(), by=1, length.out=5), temp = temp)
}, include.rownames = FALSE, sanitize.text.function = function(x) x)
}
))
Alternatively look at renderDataTable which allows you to use http://datatables.net/.
If you know that your table will be static and that only the content will be dynamic, you could follow my approach annotated here: Shiny - populate static HTML table with filtered data based on input
In short, I build a static html table and wrap it in a function in a seperated R file, source it in the server and call it in the renderUI() function with the newly filtered data. Thus, the table content gets updated with the user input.
A future project will be a function that allows the user to generate a static html table in a dynamic way, e.g., a function that creates a table with X rows, Y columns, rownames[], colnames[], etc. If I succeed, I will post my solution here.