Related
I created a datatable in a flexdashboard with a checkbox, but the checkbox flows off the page. I tried to adjust the padding {data-padding = 10} but nothing changed. Below is the code and a picture of what the dashboard looks like. How do I move everything to the right so that it's aligned with the title of the page?
---
title: "School Dashboard"
author: "Shannon Coulter"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
theme: spacelab
---
```{r}
library(tidyverse)
library(crosstalk)
library(DT)
library(flexdashboard)
```
Student Lookup
================================================================================
### Chronic Absenteeism Lookup
```{r ca-lookup, echo=FALSE, message=FALSE, warning=FALSE}
ican_tab <- tibble(
year = c("2022", "2022", "2022", "2022", "2022"),
date = c("March", "March","March","March","March"),
school = c("ABC", "CDE","ABC","DEF","GHI"),
grade = c("6th", "7th","8th","4th","5th"),
race_eth = c("White", "Hispanic","White","Filipino","White"),
abs_levels = c("Not At-Risk of Chronic Absenteeism", "At-Risk of Chronic Absenteeism",
"Severe Chronic Absenteeism", "Severe Chronic Absenteeism",
"Moderate Chronic Absenteeism")
)
sd <- SharedData$new(ican_tab)
bscols(list(
filter_checkbox("abs_levels", "Level", sd, ~ abs_levels, inline = TRUE),
datatable(
sd,
extensions = c("Buttons",
"Scroller"),
options = list(
autoWidth = TRUE,
scrollY = F,
columnDefs = list(list(
className = 'dt-center',
targets = c(2, 3, 4, 5)
)),
lengthMenu = c(5, 10, 25, 100),
dom = "Blrtip",
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
buttons = list('copy',
'csv',
'pdf',
'print')
),
filter = "top",
style = "bootstrap",
class = "compact",
width = "100%",
colnames = c(
"Year",
"Date",
"School",
"Grade",
"Race",
"Level"
)
) %>%
formatStyle('abs_levels',
backgroundColor = styleEqual(
unique(ican_tab$abs_levels),
c(
"#73D055ff",
"#95D840FF",
"#B8DE29FF",
"#DCE319FF"
)
))
))
```
[![enter image description here][1]][1]
The easiest way to address this is probably to add style tags to your dashboard. You can put this anywhere. I usually put it right after the YAML or right after my first R chunk, where I just place my knitr options and libraries. This does not go inside an R chunk.
<style>
body { /*push content away from far right and left edges*/
margin-right: 2%;
margin-left: 2%;
}
</style>
Update based on your updated question and comments
I don't have the content around your table, so I will give you a few options that work. For the most part, any one option won't be enough. You can mix and match the options that work best for you.
This is what I've got for the original table:
Option 1: you can use CSS to push the table away from the edges (as in my original response
Option 2: change the font sizes
Option 3: constrain the size of the datatable htmlwidget
Option 4: manually make the columns narrower
Option 5: alter the filter labels (while keeping the same filters and data)
Aesthetically looks the best? It depends on what else is on the dashboard.
I think you will need the original CSS (option 1, in my original answer) regardless of what other options you choose to use.
Option 1 is above
Option 2
To change the font sizes, you have to modify the filter_checkbox and the datatable after they're made. Instead of presenting all of the programming code, I'm going to show you want to add or modify and how I broke down the objects.
Your original code for filter_checkbox remains the same. However, you'll assign it to an object, instead of including it in bscols.
Most of the code in your datatable will remain the same. there is an addition to the parameter options. I've included the original and change for that parameter.
# filter checkbox object
fc = filter_checkbox(...parameters unchanged...)
fc$attribs$style <- css(font.size = "90%") # <-change the font size
dt = datatable(
...
...
options = list( # this will be modified
autoWidth = TRUE, # <- same
scrollY = F, # <- same
initComplete = JS( # <- I'M NEW! change size of all font
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '90%'});",
"}"),
columnDefs = list( # <- same
list(className = 'dt-center', targets = c(2, 3, 4, 5))),
...
... # remainder of datatable and formatStyles() original code
)
# now call them together
bscols(list(fc, dt))
The top version is with 90% font size, whereas the bottom is the original table.
Option 3
To constrain the size of the datatable widget, you'll need to create the object outside of bscols, like I did in option 2. If you were to name your widget dt as in my example, this is how you could constrain the widget size. This example sets the datatable to be 50% of the width and height viewer screen (or 1/4 of the webpage). Keep in mind that the filters are not part of the widget, so in all, the table is still more than 1/4th of the webpage. You will have to adjust the size for your purposes, of course. I recommend using a dynamic sizing mechanism like vw, em, rem, and the like.
dt$sizingPolicy$defaultWidth <- "50vw"
dt$sizingPolicy$defaultHeight <- "40vh"
The top image has options 1, 2, and 3; the bottom is the original table.
Option 4
To modify the width of the columns, you can add this modification to the parameter options in you call to datatable. This could be good, because most of the columns don't require as much width as the last column. However, if you change the font size or scale the table, it will change the font size dynamically, so this option may not be necessary.
Despite using em here, in the course of this going from R code to an html_document, it was changed to pixels. So this is not dynamically sized. (Not a great idea! Sigh!)
columnDefs = list(
list(className = 'dt-center', targets = c(2, 3, 4, 5)),
list(width = '5em', targets = c(1,2,3,4,5))), # <- I'm NEW!
Option 5
For this option, I took the programming behind crosstalk::filter_checkbox() and modified the code a bit. I changed the function to filter_checkbox2(). If you use it, you can render it both ways and just keep the one you like better.
This first bit of code is the three functions that work together to create a filter_checkbox object with my modifications so that you can have a label that isn't exactly the same as the levels.
It's important to note that the filters are alphabetized by datatable. It doesn't matter if they're factors, ordered, etc. If you use this new parameter groupLabels, they need to be in an order that aligns with the levels when they're alphabetized.
I put this code in an include=F chunk by itself:
# this is nearly identical to the original function
filter_checkbox2 = function (id, label, sharedData, group,
groupLabels = NULL, # they're optional
allLevels = FALSE, inline = FALSE, columns = 1) {
options <- makeGroupOptions(sharedData, group,
groupLabels, allLevels) # added groupLabels
labels <- options$items$label
values <- options$items$value
options$items <- NULL
makeCheckbox <- if (inline)
inlineCheckbox
else blockCheckbox
htmltools::browsable(attachDependencies(tags$div(id = id,
class = "form-group crosstalk-input-checkboxgroup crosstalk-input",
tags$label(class = "control-label", `for` = id, label),
tags$div(class = "crosstalk-options-group",
crosstalk:::columnize(columns,
mapply(labels, values, FUN = function(label, value) {
makeCheckbox(id, value, label)
}, SIMPLIFY = FALSE, USE.NAMES = FALSE))),
tags$script(type = "application/json", `data-for` = id,
jsonlite::toJSON(options, dataframe = "columns",
pretty = TRUE))),
c(list(crosstalk:::jqueryLib()),crosstalk:::crosstalkLibs())))
}
inlineCheckbox = function (id, value, label) { # unchanged
tags$label(class = "checkbox-inline",
tags$input(type = "checkbox",
name = id, value = value),
tags$span(label))
}
# added groupLabels (optional)
makeGroupOptions = function (sharedData, group, groupLabels = NULL, allLevels) {
df <- sharedData$data(withSelection = FALSE, withFilter = FALSE,
withKey = TRUE)
if (inherits(group, "formula"))
group <- lazyeval::f_eval(group, df)
if (length(group) < 1) {
stop("Can't form options with zero-length group vector")
}
lvls <- if (is.factor(group)) {
if (allLevels) {levels(group) }
else { levels(droplevels(group)) }
}
else { sort(unique(group)) }
matches <- match(group, lvls)
vals <- lapply(1:length(lvls), function(i) {
df$key_[which(matches == i)]
})
lvls_str <- as.character(lvls)
if(is.null(groupLabels)){groupLabels = lvls_str} # if none provided
if(length(groupLabels) != length(lvls_str)){ # if the # labels != the # groups
message("Warning: The number of group labels does not match the number of groups.\nGroups were used as labels.")
groupLabels = lvls_str
}
options <- list(items = data.frame(value = lvls_str, label = groupLabels, # changed from lvls_str
stringsAsFactors = FALSE), map = setNames(vals, lvls_str),
group = sharedData$groupName())
options
}
When I used this new version of I changed label = "Level" to label = "Chronic Absenteeism Level". Then removed " Chronic Absenteeism" from the filter labels. The data and the datatable does not change, just the filter checkbox labels.
filter_checkbox2("abs_levels", "Chronic Absenteeism Level",
sd, ~ abs_levels, inline = TRUE,
groupLabels = unlist(unique(ican_tab$abs_levels)) %>%
str_replace(" Chronic Absenteeism", "") %>% sort())
The first image is your table with options 1, 2, 3, and 5 (not 4).
The top version in the next image has options 1, 2, 3, and 5 (not 4). The bottom is the original table. After that
If I've left anything unclear or if have any other questions, let me know.
I have 3 dataframes say df1, df2, df3 and I want to send it in an email as 3 separate tables with some space between them.
I am able to currently send 1 dataframe as table with below code
library("mailR")
df1 <- read.csv('Adhoc/temp.csv')
final1 <- print(xtable(df1,caption = "Report"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
date_of_report<- Sys.Date() - 1
send.mail(from = "no-reply#abc.com",
to = c('xyz.pqr#abc.com'
),
subject = paste('Report', date_of_report, sep=' '),
body = final1,
html = TRUE,
smtp = list(host.name = "aspmx.l.google.com", port = 25),
authenticate = FALSE,
send = TRUE,
debug=TRUE)
I wanted some help so that I can send all the dataframes in one email itself. Currently I send 3 such emails.
Suggested untested Solution: paste multiple pre-formatted tables:
final1 <- print(xtable(df1,caption = "Report"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final2 <- print(xtable(df2,caption = "Report2"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final3 <- print(xtable(df3,caption = "Report3"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final <- paste(final1, final2, final3, sep="\n")
date_of_report<- Sys.Date() - 1
send.mail(from = "no-reply#abc.com",
to = c('xyz.pqr#abc.com'
),
subject = paste('Report', date_of_report, sep=' '),
body = final,
html = TRUE,
smtp = list(host.name = "aspmx.l.google.com", port = 25),
authenticate = FALSE,
send = TRUE,
debug=TRUE)
I think it makes a lot of sense to define a function, here. And then there are a couple of things I would change up for future extensibility.
library(xtable) # This is required for the xtable function and print method
library(mailR)
# Read the data.frames into a list. This makes it easier to add/remove tables later
dfs <- list(
`Report 1` = data.frame(letter = LETTERS[seq_len(5L)],
number = seq_len(5L),
stringsAsFactors = FALSE
),
`Report 2` = data.frame(letter = letters[6L + seq_len(5L)],
number = 6L + seq_len(5L),
stringsAsFactors = FALSE
),
`Report 3` = data.frame(letter = LETTERS[20L:16L],
number = 20L:16L,
stringsAsFactors = FALSE)
)
Now we need to define the function that will format one of our tables. I'm just calling it make_xtable, and I'm giving it two arguments, the first is a data.frame, and the second is a string that will be used as the caption.
make_xtable <- function(df, caption) {
print(
xtable(df, caption = caption),
type = "html",
include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
print.results = FALSE # This suppresses the results from printing to the console
)
}
So far we've loaded in our data, and we've defined a process for creating the tables from a given data.frame and caption string, but we still need to actually run each of our tables through the process. Here is where putting our data.frames into a list will come in handy. The family of apply functions will help us run the function on every element of our list, and then paste0 will let us combine the resulting character vector into a character object of length 1.
email_body <-
paste0(
mapply(
make_xtable,
dfs, # The list of data.frames containing our data
names(dfs) # Names attribute of the list of data.frames
),
collapse = "<br \>" # Concatenate using an HTML newline as a separator
)
Then use email_body as the argument body in the send.mail function.
Ciao,
I'm writing a code to generate an automatic report using officer package. I was wondering how and if I can write some text with different font. In my case I'd like to write some normal text and some bold words.
Let me show you what I get. I use these functions to generate fp_text objects:
fp_normal <- function(){
return( fp_text(color = "black", font.size = 16,
bold = FALSE, italic = FALSE,
underlined = FALSE, font.family = "Arial",
shading.color = "transparent") )
}
fp_bold <- function(){
return( fp_text(color = "black", font.size = 16,
bold = TRUE, italic = FALSE,
underlined = FALSE, font.family = "Arial",
shading.color = "transparent") )
}
I used to use combination of pot function by using sum operator and function textProperties:
pot("not bold ") + pot("and bold", textProperties(font.weight = "bold") )
My question is: how should I combine fp_normal and fp_bold functions with ph_with_text function?
I have updated the package to make that kind of operation easier. Usage of id_chr is not easy and the code below give the advantage to not use it :)
library(magrittr)
library(officer)
fp_normal <- fp_text(font.size = 24)
fp_bold <- update(fp_normal, bold = TRUE)
fp_red <- update(fp_normal, color = "red")
pars <- block_list(
fpar(ftext("not bold ", fp_normal), ftext("and bold", fp_bold)),
fpar(ftext("red text", fp_red))
)
my_pres <- read_pptx() %>%
add_slide(layout = "Title and Content", master = "Office Theme") %>%
ph_with(pars, location = ph_location_type(type = "body") )
print(my_pres, target = "test.pptx")
Ok, at the end I think I've got it.
To apply different styles is in enough to combine ph_with_text function with ph_add_text function.
Namely ph_add_text do the same sum operator do for pot function. Keep in mind that, in order to refer to a certain line you have to provide id_chr argument. You can deduce the correct value by using slide_summary(ppt) command just after you run ph_with_text.
ppt <- read_pptx()
ppt <- add_slide(ppt, "Title and Content", master = "Office Theme")
ppt <- ph_with_text(ppt, "Some NOT bold text ", type = "body", index = 1)
slide_summary(ppt) # I see that the id is 2. Now I can delete this line.
ppt <- ph_add_text(ppt, "and some bold text", type = "body", style = fp_bold(), id_chr = 2)
print(ppt, target = "boldTest.pptx")
For the fp_bold() function see above in the question.
Ad this point we can add other pieces of text with different formats by keeping using ph_add_text (and maybe "\n" if we want write in new lines.
Ciao
Can you please help me with DT::datatable column formatting? I have for example this table:
DT::datatable(iris,
class = 'row-border stripe hover compact',
rownames = F,
autoHideNavigation = T,
options = list(pageLength = nrow(summary.month),
searching = F,
paging = F,
info = F))
I need to set:
1st column: bold, aligned left
3rd coumn: bold, aligned right
I found, that I should use columns.ClassName, but how to set the class styles in R?
The html output of datatable will be used in R markdown document then.
It has been a while since this question was initially asked, but I just had this same problem. Here is a simpler solution that doesn't require editing the source data or calling JS, but instead uses functions within the DT package itself.
DT::datatable(iris,
class = 'row-border stripe hover compact',
rownames = F,
autoHideNavigation = T, escape =FALSE) %>%
formatStyle(columns = c("Sepal.Length"), fontWeight = 'bold', `text-align` = 'left') %>%
formatStyle(columns = c("Petal.Length"), fontWeight = 'bold', `text-align` = 'right')
So far the only way I can get it to work is by manually setting the HTML tags first, and then using escape = FALSE
Here we wrap Sepal.Length in the bold HTML tag:
iris$SepalLength2 <- paste0("<b>", iris$Sepal.Length, "</b>")>
Then use escape = FALSE so that the HTML tags are parsed.
datatable(iris,
class = 'row-border stripe hover compact',
rownames = F,
autoHideNavigation = T, escape =FALSE)
Edit:
For align left/right, you can wrap in a <p align ="left"></p>
So: iris$SepalLength2 <- paste0('<p align ="right"><b>', iris$Sepal.Length, '</b></p>')
Note that I am neither an HTML guru, nor an expert on this particular library, but this seems like one way to get your desired result.
You don't need to modify the contents of your data. Instead, you can use the rowCallback option:
library(DT)
rowCallback <- c(
"function(row, data, index){",
" $(this.api().cell(index, 0).node())",
" .css('text-align', 'left')",
" .css('font-weight', 'bold');",
" $(this.api().cell(index, 2).node())",
" .css('text-align', 'right')",
" .css('font-weight', 'bold');",
"}"
)
DT::datatable(iris,
class = 'row-border stripe hover compact',
rownames = FALSE,
autoHideNavigation = TRUE,
options = list(pageLength = 5,
searching = FALSE,
paging = TRUE,
info = FALSE,
rowCallback = JS(rowCallback))
)
This is a continuation of a question I posted earlier. I have a code.Rnw file in RStudio which I knit into a code.tex file using knit("code.Rnw") command.
I have a data frame that I am printing using the xtable command. In the example below, it is 20 rows. However, to save space, I am printing it out as two columns, each with 10 rows.
Below is my code:
\documentclass[11pt, a4paper]{article}
\usepackage[margin=3cm]{geometry}
\usepackage{longtable}
\begin{document}
<<echo=FALSE,results='asis'>>=
library(xtable)
set.seed(1)
spaceCol = rep(" ",10)
df1 = data.frame(student = letters[1:10], vals=runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
dfFull = data.frame(df1,spaceCol,df2)
names(dfFull) = c(" ","% Correct"," "," ", "% Correct")
row.names(dfFull) = NULL
x.big <- xtable(dfFull, label ='tabtwo',caption ='Caption for table with student scores')
print(x.big, tabular.environment ='longtable', floating = FALSE, include.rownames=FALSE)
#
\end{document}
This is what the output looks like:
I like the aesthetics of this output, especially because in the longtable format, this output will automatically page-break if need be. However, what I am trying to improve, is to make it more easy to visualize that this output is really two distinct columns.
To do that, I would like to add a space between the two columns, so the output looks more as follows:
However, if that proves impossible, then I could consider something like adding a vertical line to distinguish the two columns, as shown below:
How might this be possible given my limitation in using xtable?
\documentclass[11pt, a4paper]{article}
\usepackage{subfig}
\begin{document}
<<echo = FALSE>>=
library(xtable)
opts_chunk$set(
echo = FALSE,
results = 'asis'
)
set.seed(1)
mynames <- c("", "% Correct")
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
colnames(df1) <- mynames
colnames(df2) <- mynames
#
\begin{table}\centering
\subfloat{
<<>>=
print(xtable(df1), floating = FALSE, include.rownames = FALSE)
#
} \hspace{2cm}
\subfloat{
<<>>=
print(xtable(df2), floating = FALSE, include.rownames = FALSE)
#
}
\caption{Caption for table with student scores} \label{tabtwo}
\end{table}
\end{document}
The only drawback is, that you cannot use longtable with this approach.
UPDATE: Here is an alternative that makes use of longtable. The trick is to use xtable for the contents of the table only and build the headline by hand, so you have full control over all lines etc. I decided to use an empty column for the space because making column 2 wider would make the horizontal lines look ugly.
\documentclass{article}
\usepackage{longtable}
\begin{document}
\thispagestyle{empty}
<<echo = FALSE>>=
library(xtable)
opts_chunk$set(
echo = FALSE,
results = 'asis'
)
set.seed(1)
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
dfFull <- cbind(df1, NA, df2)
#
\begin{longtable}{lrl#{\hskip 2cm}lr} \cline{1-2} \cline{4-5}
& \% Correct & & & \% Correct \\ \cline{1-2} \cline{4-5}
<<>>=
print(xtable(dfFull), only.contents = TRUE, include.rownames = FALSE, include.colnames = FALSE, hline.after = NULL)
#
\cline{1-2} \cline{4-5}
\caption{Caption for table with studen scores} \label{tabtwo}
\end{longtable}
\end{document}
UPDATE2: Finally, a solution that uses longtable and doesn't involve creating half of the table "by hand". The trick is to remove all horizontal lines (hline.after = NULL) and than add \clines where required using add.to.row (inspired by this question).
\documentclass{article}
\usepackage{longtable}
\begin{document}
\thispagestyle{empty}
<<echo = FALSE, results = 'asis'>>=
library(xtable)
set.seed(1)
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(letters[11:20], runif(10, 1, 10))
dfFull <- cbind(df1, NA, df2)
# To test "longtable", rbind data several times:
multiply <- 5
dfFull <- do.call("rbind", replicate(multiply, dfFull, simplify = FALSE))
colnames(dfFull) <- c("", "% Correct", "", "", "% Correct")
print(xtable(dfFull,
caption = "Caption for table with student scores",
label = "tabtwo",
align = c("l", # ignored (would apply to colnames)
"l", "r",
"l#{\\hskip 2cm}", # space between blocks
"l", "r")),
include.rownames = FALSE,
include.colnames = TRUE,
hline.after = NULL, # Remove all default lines. A line after the very last row remains, which is automatically added when using "longtable".
tabular.environment = "longtable",
floating = FALSE,
add.to.row = list(
pos = list(-1, 0),
command = rep("\\cline{1-2} \\cline{4-5}", 2))
)
#
\end{document}