I'd like for my font size in the footnotes to be smaller than the text in the table, but can't figure it out. Is there something similar to kable_styling where I can edit the text and color of rows in the table that can be used for footnotes? I am using RMarkdown to generate the HTML not LateX.
---
title: "Untitled"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE )
library( kableExtra )
library( knitr )
```
```{r mtcars}
tab_mtcars <- knitr::kable( mtcars[ 1:5 , c( 1:4 )] , format = "html", col.names = c( "MPG", "CYL", "DISP" , "HP" ) , align = "lccc" , escape = F ) %>% kable_styling( full_width = T , bootstrap_options = c( "hover", "condensed" , "bordered"), position = "left") %>% add_header_above( c( "mtcars example" = 5 ) , bold = TRUE ) %>% footnote( general = c( "Here is the footnote where I would like font smaller than above" ), general_title = "Note: ", footnote_as_chunk = T )
```
`r tab_mtcars`
You could use the html <small> tag in the text for the general and general_title parameters of the kabaleExtra::footnote function. See example:
tab_mtcars <-
knitr::kable(
mtcars[1:5 , c(1:4)] ,
format = "html",
col.names = c("MPG", "CYL", "DISP" , "HP") ,
align = "lccc" ,
escape = F
) %>%
kable_styling(
full_width = T ,
bootstrap_options = c("hover", "condensed" , "bordered"),
position = "left"
) %>% add_header_above(c("mtcars example" = 5) , bold = TRUE) %>% footnote(
general = c(
"<small>Here is the footnote where I would like font smaller than above</small>"
),
general_title = "<small>Note: </small>",
footnote_as_chunk = T ,
escape = F
)
There doesn't seem to be a way to control that from kable() that I can see, so you could change the CSS styling. With your YAML as the following:
---
title: "Untitled"
output:
html_document:
css: style.css
---
and a style.css file in the same folder containing some css code:
tfoot {
font-size: 80%;
}
Related
I'm trying to generate a Word document with figures. I use {officedown} and {officer} packages. I need to do it dynamically, in a loop since I don't know how many figures there will be. This is my Rmarkdown code:
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
```
```{r}
block_toc(seq_id = "fig")
```
```{r results='asis'}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- lapply(seq_len(length(ttp)), function(i) {
fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]],
external_img(src = tmps[[i]], width = 6, height = 5)
)
})
do.call(block_list, fpars)
```
The problem is when I generate the table of figures in the rendered document. It looks like this:
An entry is kept together with the image itself, I don't know why.
I save temporary png files to be able to use them inside fpar function. Using plot function directly inside fpar causes bad effects. Maybe there's another/better way?
I found this construction useful, but unfortunately it puts captions under the figures by default. My goal is figure captions behave more like table captions, i.e. a caption is above a figure.
```{r fig.cap=unlist(titles)}
plot(iris[1:10, 1:2])
```
How can I generate the plots with captions dynamically with {officedown} or {officer} packages?
The only issue is about the last lapply, you need to put the image in a separate paragraph, so a for loop will be easier to stack 2 paragraphs into a list instead of 1 for each iteration.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- list()
for (i in seq_along(ttp)) {
fpars[[length(fpars)+1]] <- fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]]
)
fpars[[length(fpars)+1]] <- fpar(
external_img(src = tmps[[i]], width = 6, height = 5)
)
}
do.call(block_list, fpars)
```
This is an answer for "how to do it with officer" from scratch.
But the following is much more simple. There is an option fig.topcaption that do the same thing.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r fig.cap = "miaou", fig.topcaption=TRUE}
plot(cars)
```
```{r fig.cap = "ouaf", fig.topcaption=TRUE}
plot(cars)
```
I see there's a function in flextable package, namely fp_text_default. In help files to this function the only example you can find is
fp_text_default(bold = TRUE)
I was wondering if I can use this function to avoid setting font.size=11 everytime I use custom formatting in my flextables, e.g.
flextable(df) %>%
compose(value = as_paragraph(
as_chunk("foo", props = fp_text(shading.color = "orange", font.size=11))
)) %>%
compose(value = as_paragraph(
as_chunk("bar", props = fp_text(bold = TRUE, font.size=11))
))
The default font.size param in fp_text is 10 and I always have to set it to 11.
Can fp_text_default be used to set font.size to 11 permaently?
You can use set_flextable_defaults() so that you don't have to call again and again fontsize() or some other functions (i.e. padding, color).
https://davidgohel.github.io/flextable/reference/set_flextable_defaults.html
fp_text_default() is a convenient function to overwrite only values that are specified, it keeps other formatting parameters as they are. So far more convenient than fp_text() that force you to specify all params...
Both can be used together...
---
title: "Untitled"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flextable)
library(magrittr)
set_flextable_defaults(
font.family = "Arial", font.size = 10,
padding = 3, border.color = "gray"
)
```
```{r}
flextable(head(iris)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
flextable(head(mtcars)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
set_flextable_defaults(font.size = 12, padding = 5)
flextable(head(mtcars)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
```
Is there a way to include an absolute panel like in this example (https://shiny.rstudio.com/gallery/superzip-example.html) to a flexdashboard (on a leaflet) ?
The idea would be to have a mobile panel dedicated to the leaflet output instead of a sidebar panel.
The absolute panel example here based on a shiny example (with ui and server parts)
library(shiny)
ui <- shinyUI(bootstrapPage(
absolutePanel(
id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
HTML('<button data-toggle="collapse" data-target="#demo">Collapsible</button>'),
tags$div(id = 'demo',
checkboxInput('input_draw_point', 'Draw point', FALSE ),
verbatimTextOutput('summary')))
))
server <- shinyServer(function(input, output, session) {
output$summary <- renderPrint(print(cars))
})
shinyApp(ui = ui, server = server)
a code example below for the Flexdashboard part :
---
title: "Waste Lands - America's forgotten nuclear legacy"
author: Philipp Ottolinger
output:
flexdashboard::flex_dashboard:
theme: journal
social: menu
source_code: embed
---
```{r setup, include = FALSE}
library(flexdashboard)
library(shiny)
library(jsonlite)
library(maptools)
library(ggplot2)
library(tidyr)
library(dplyr)
library(purrr)
library(leaflet)
library(plotly)
sites <- fromJSON(flatten=TRUE,
"https://raw.githubusercontent.com/ottlngr/2016-15/ottlngr/ottlngr/sites.json")
sites$locations <- map(sites$locations, function(x) {
if (nrow(x) == 0) {
data_frame(latitude=NA, longitude=NA, postal_code=NA, name=NA, street_address=NA)
} else {
x
}
})
sites <- unnest(sites)
sites <- sites[complete.cases(sites[,c("longitude", "latitude")]),]
sites$ratingcol <- ifelse(sites$site.rating == 0, "orange",
ifelse(sites$site.rating == 1, "green",
ifelse(sites$site.rating == 2, "red", "black")))
sites$ratingf <- factor(sites$site.rating,
levels=c(3:0),
labels=c("Remote or no potential for radioactive contamination.",
"No authority to clean up or status unclear.",
"Cleanup declared complete.",
"Cleanup in progress."))
sites$campus <- ifelse(grepl("University", sites$site.name) |
grepl("University", pattern = sites$street_address) |
grepl("Campus", sites$street_address), 1, 0)
sites$campuscol <- ifelse(sites$campus == 1, "red", "black")
```
Column {data-width=650}
-----------------------------------------------------------------------
### All sites and their current status
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites$longitude,
sites$latitude,
color = sites$ratingcol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites$site.city,
sites$site.name,
sep = "")) %>%
addLegend("bottomleft",
colors = c("orange","green", "red", "black"),
labels = c("Cleanup in progress.",
"Cleanup complete.",
"Status unclear.",
"No potential for radioactive contamination."),
opacity = 0.8)
```
Column {data-width=350}
-----------------------------------------------------------------------
### Number of sites
```{r}
sites %>%
count(ratingf) %>%
plot_ly(type = "bar",
x = ratingf,
y = n,
color = ratingf,
text = paste(n,ratingf,sep=""),
hoverinfo = "text") %>%
layout(xaxis = list(showline = F,
showticklabels = F,
fixedrange = T,
title = ""),
yaxis = list(fixedrange = T,
title = ""))
```
### Sites on campus
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites[sites$campus == 1, ]$longitude,
sites[sites$campus == 1, ]$latitude,
color = sites[sites$campus == 1, ]$campuscol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites[sites$campus == 1, ]$site.city,
sites[sites$campus == 1, ]$site.name,
sep = ""))
```
Thanks
Try this.
---
title: "haha"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
editor_options:
chunk_output_type: console
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flexdashboard)
library(shiny)
library(leaflet)
```
# without container-fluid
### Sites on campus
```{r}
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
renderLeaflet(mapfunction())
```
```{r}
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto',
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
```
### server
```{r}
mapfunction <- reactive({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
```
# with container-fluid
```{r}
shinyApp(
fluidPage(
leafletOutput(outputId = "somemap"),
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto', fixed = TRUE,
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
),
server = function(input, output, session){
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
output$somemap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
}
)
```
If you need to use interactive components from shiny, like XXinput, you need to specify runtime: shiny on the top, otherwise, you can delete this line.
I use reactive as the simplest server part. If you want to use a more complex server (logic), e.g. several components interact together, you need to write the actual server function. I would suggest just write a shiny app instead of a flexdashboard.
unfortunately, components in flexdash are not inside container-fluid class which with this can allow you to drag the panel. There may be a way to work around, you can search for it. Look at the last chunck, I inserted a actual shiny app and the panel is draggable. You should see two tabs when you run the doc, watch the difference. So, if you really want to drag this panel, you should write a "real" shiny app.
I want to produce slide dynamically in my Rmarkdown presentation with shiny
Here below the code works.
But as soon as I uncomment the for loop it doesn't.
---
title: "dynamic_plots"
output: ioslides_presentation
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
```{r, echo = FALSE, results = "asis"}
number_of_bins_selected <- c(20,30)
i <- 1 # If for loop commented
#for (i in 1:length(number_of_bins_selected)) {
cat("## New slide \n")
input1_id <- paste(i, "nbreaks", sep = "_")
input2_id <- paste(i, "bw_adjust", sep = "_")
inputPanel(
selectInput(input1_id, label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = number_of_bins_selected[i]),
sliderInput(input2_id, label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input[[input1_id]]),
xlab = "Duration (minutes)", main = "Geyser eruption duration")
dens <- density(faithful$eruptions, adjust = input[[input2_id]])
lines(dens, col = "blue")
})
cat(" \n\n") # End the slide
#}
```
Isn't it possible to create slides on a for loop ?
---
title: "Title"
author: ''
date: ''
output:
pdf_document:
template: default.tex
geometry: top=0.5cm, bottom=0.5cm, left=0.5cm, right=0.5cm
header-includes: null
fontsize: 4pt
classoption: portrait
sansfont: Calibri Light
---
#Name1: `r "Name1"`
#Name2: `r "Name2"`
```{r, echo=FALSE, message=FALSE, warning=FALSE, results='asis'}
df <- mtcars
n = nrow(df)
hlines=c(-1,0,(n-1),n)
my_align = "c|c|c|ccccc|ccc|c|"
rws <- seq(1, (n-1), by = 2)
col <- rep("\\rowcolor[gray]{.90} ", length(rws))
xtable::print.xtable(xtable(df
, align = my_align)
, add.to.row = list(pos = as.list(rws), command = col)
, booktabs = F
, hline.after = hlines, type = "latex")
```
I am using an Rmarkdown to print a table which has a lot of formatting. When I add the add.to.rwo part to get grey and white alternate rows the vertical lines are removed in the grey rows.
How do I correct this? It is very difficult to create a reproducible example but hopefully the same problem will apply to any df (with the correct Latex packages behind it)
Thanks :)
Try comparing these two tables. The first is your table as you coded it, the second is done by pixiedust with the hhline option set to TRUE.
---
title: "Title"
author: ''
date: ''
output:
pdf_document:
geometry: top=0.5cm, bottom=0.5cm, left=0.5cm, right=0.5cm
header-includes:
- \usepackage{amssymb}
- \usepackage{arydshln}
- \usepackage{caption}
- \usepackage{graphicx}
- \usepackage{hhline}
- \usepackage{longtable}
- \usepackage{multirow}
- \usepackage[dvipsnames,table]{xcolor}
fontsize: 4pt
classoption: portrait
sansfont: Calibri Light
---
#Name1: `r "Name1"`
#Name2: `r "Name2"`
```{r, echo=FALSE, message=FALSE, warning=FALSE, results='asis'}
library(xtable)
df <- mtcars
n = nrow(df)
hlines=c(-1,0,(n-1),n)
my_align = "c|c|c|ccccc|ccc|c|"
rws <- seq(1, (n-1), by = 2)
col <- rep("\\rowcolor[gray]{.90} ", length(rws))
xtable::print.xtable(xtable(df
, align = my_align)
, add.to.row = list(pos = as.list(rws), command = col)
, booktabs = F
, hline.after = hlines, type = "latex")
```
```{r}
library(pixiedust)
dust(df,
hhline = TRUE,
keep_rownames = TRUE) %>%
medley_bw() %>%
sprinkle_colnames(.rownames = "") %>%
sprinkle(cols = c(".rownames", "mpg", "cyl", "qsec", "gear", "carb"),
border = "right") %>%
sprinkle(rows = nrow(mtcars),
border = "top") %>%
sprinkle(bg_pattern_by = "rows")
```