Rmarkdown: Indentation of TOC items in HTML output - css

I want to indent TOC according to header level.
My example document looks like this:
# Tutorial
## Start a new project
### Project structure
### Analysis code
I'm compiling Rmd document with:
rmarkdown::render("foo.Rmd",
output_options = HTMLlook,
output_file = "foo.html")
HTMLlook <- list(toc = TRUE,
toc_depth = 5,
toc_float = list(collapsed = FALSE,
smooth_scroll = TRUE))
This produces document with TOC
However, I want indented TOC (indentation equivalent to header level). Wanted result should look like this:
Is it possible to set this option in render or maybe pass css parameters to it?

I am not aware of a built-in solution. But here is a little tweak:
<script>
$(document).ready(function() {
$items = $('div#TOC li');
$items.each(function(idx) {
num_ul = $(this).parentsUntil('#TOC').length;
$(this).css({'text-indent': num_ul * 10, 'padding-left': 0});
});
});
</script>
The depth of your headers is actually mapped inside the TOC. For each level you go down, a new ul element is created. This is what we are making use of here. In detail:
When the document has finished loading ($(document).ready(....):
Select all list items inside the element with id TOC
For each list item count the number of parent elements until you reach the element with id TOC. This is the number of ul elements.
Change the style for the current list item according to the number of parents.
You can tweak the spacing by playing around with the two parameters for text-indent and padding-left.
MRE:
---
title: "Habits"
author: Martin Schmelzer
date: September 14, 2017
output:
html_document:
toc: true
toc_depth: 5
toc_float:
collapsed: false
smooth_scroll: true
---
<script>
$(document).ready(function() {
$items = $('div#TOC li');
$items.each(function(idx) {
num_ul = $(this).parentsUntil('#TOC').length;
$(this).css({'text-indent': num_ul * 10, 'padding-left': 0});
});
});
</script>
# In the morning
## Waking up
### Getting up
#### Take a shower
##### Make coffee
# In the evening
## Make dinner
This is the result:

Related

Animate plots using echarts4r when quarto slides are on-screen

I am making a Revealjs presentation using Quarto in R Studio. I am using the package {echarts4r} to make my plots. {echarts4r} comes with default animations. When I render the presentation the default animation has already loaded for all the slides.
I want to run the default echarts4r animations when the slide is active (i.e. when the slide is in view) and reset when some other slide is in view. Could someone help me with this?
Here is the code for the quarto presentation.
---
title: "A Title"
subtitle: "A Subtitle"
author: "First Last"
institute: "Some Institute"
date: today
self-contained: true
format: revealjs
---
## Introduction
Hello There!
## Pie Chart
```{r}
library(tidyverse)
library(echarts4r)
data <- tibble(name = c("A", "B", "C", "D", "E", "F", "G"),
number = c(9.7, 2.1, 2.1, 1.9, 1.9, 1.9, 80.4))
data %>%
e_charts(name) %>%
e_pie(number, radius = c("50%", "70%")) %>%
e_legend(orient = "vertical", right = "5", top = "65%")
```
This isn't a fix or a Quarto method. However, this workaround is dynamic. I worked out what needs to happen with both echarts4r and highcharter because of the comment by #bretauv.
Assign Element IDs
The only thing you'll change with your charts is that you need to give them an element ID. IDs need to be unique across the entire presentation. It's perfectly okay to use something like 'ec0', 'ec1'... and so on for your plots' ids. (You only need to do this to plots that animate.)
Here's an example.
```{r pltEchart, echo=F}
iris |> group_by(Species) |>
e_charts(Sepal.Length, elementId = "pltEcht") |> # <--- id is here
e_scatter(Sepal.Width)
```
For highcharter, and most other widget style packages, adding the element id isn't built in. Here's how you add the id for highcharter.
```{r penquins,echo=F}
hc <- hchart(penguins, "scatter",
hcaes(x = flipper_length_mm, y = bill_length_mm, group = species))
hc$elementId <- "hc_id"
hc
```
Re-Animating Plots
For each of echarts4r plots, to apply this next part you need the slide it's on and it's element id.
For highcharter, you also need to know the order in which it appears in your presentation (only in terms of other highcharter plots).
Whether you use the less dynamic approach or the more dynamic approach, what remains is adding a JS chunk to your QMD. This chunk can go anywhere in the script file. (I usually put any JS in my RMDs/QMDs at the end.)
If you were not aware, JS is built-in. You don't need to do anything new or different to use JS this way. However, if you were to run this chunk in the source pane, it won't do anything. You have to render it to see it in action. If you end up changing the JS or writing more of your own, don't assume what you see in RStudio's viewer or presentation pane is exactly what you'll see in your browser.
I would skim over what you have to change for both methods before you decide! If you're not comfortable using JS, the second is definitely your best bet.
Customized Information For Each Presentation For Each Re-Animated Plot
For each plot you re-animate, you'll have to identify:
a substring of the slide title OR the slide number (where slide numbers are included on the slides via YAML declaration)
plot element ids
plot order (plot order or sequence is for Highcharts only).
For the slide title substring, as you use it in the JS:
it's a substring of the title based on the hash or anchor that is assigned in the background
substring is all lowercase
no special characters
must be unique to that slide
If you're unsure what to use or how to find what's unique—there's an easy way to find that information. If you open your presentation in your browser from the presentation pane in RStudio, the URL of the slides will look similar to this.
Every slide will have the same initial component to the URL, http://localhost:7287/#/, but beyond that, every slide will be unique.
http://localhost:7287/#/another-hc
The string after the # is the title anchor for that slide. You can use exactly what's in the URL (after #/).
Put it Altogether
This continuously checks if the slide has changed (10-millisecond interval). If there's a slide change, it then checks to see if one of the three plots is on that slide. If so, the slide animation is restarted.
What you need to personalize in the JS
ecReloader for charts4r has 2 arguments:
title substring OR slide number
plot element ID
hcReloader for highcharter has 3 arguments:
title substring OR slide number
plot element ID
plot sequence number
In the setInterval function (chunk named customizeMe, you will need to write a function call for each plot you want to re-animate. In my example, I reanimated three plots. This is the ONLY part you modify. (Note that each line needs to end with a semi-colon.)
ecReloader('code', 'pltEcht'); /* slide title. plot element id */
hcReloader('highchart', 'hc_id', 0); /* slide title, id, sequence */
hcReloader(6, 'another_hc_id', 1); /* slide number, id, sequence */
/* assuming only one on slide */
setInterval(function() {
var current = window.location.hash;
tellMe = keepLooking(current);
if(tellMe) { /* if the slide changed, then look */
ecReloader('code', 'pltEcht');
hcReloader('highchart', 'hc_id', 0);
hcReloader(6, 'another_hc_id', 1); /* second highcharter plot */
}
}, 10); // check every 10 milliseconds
In your presentation, you need to take both of the JS chunks to make this work. (Chunk names are customizeMe and reloaders.)
I'm sure there's a way to customize the appearance of the slide numbers; this code is based on the default, though.
Here's all the JS to make this work.
```{r customizeMe,echo=F,engine='js'}
/* assuming only one on slide */
setInterval(function() {
var current = window.location.hash;
tellMe = keepLooking(current);
if(tellMe) { /* if the slide changed, then look */
ecReloader('code', 'pltEcht');
hcReloader('highchart', 'hc_id', 0);
hcReloader(6, 'another_hc_id', 1); /* second highcharter plot */
}
}, 10); // check every 10 milliseconds
```
```{r reloaders,echo=F,engine='js'}
// more dynamic; a couple of key words for each plot
// multiple options for addressing Echarts plots
function ecReloader(slide, id) {
/* slide (string) slide title unique substring (check URL when on the slide)
--or--
(integer) as in the slide number
id (string) element id of the plot to change */
if(typeof slide === 'number') { // slide number provided
which = document.querySelector('div.slide-number'); // page numbers like '6 / 10'
validator = Number(which.innerText.split(' ')[0]);
if(slide === validator) { // slide number matches current slide
var ec = document.getElementById(id);
ele = echarts.init(ec, get_e_charts_opts(ec.id));
thatsIt = get_e_charts_opts(ec.id); /* store data */
ele.setOption({xAxis: {}, yAxis: {}}, true); /* remove data */
ele.setOption(thatsIt, false); /* append original data */
}
} else { // unique element in slide title
if(window.location.hash.indexOf(slide) > -1) {
var ec = document.getElementById(id);
ele = echarts.init(ec, get_e_charts_opts(ec.id));
thatsIt = get_e_charts_opts(ec.id); /* store data */
ele.setOption({xAxis: {}, yAxis: {}}, true); /* remove data */
ele.setOption(thatsIt, false); /* append original data */
}
}
}
// multiple options for addressing Highcharts plots, assumes 1 chart per slide!
function hcReloader(slide, id, order) {
/* slide (string) slide title unique substring (check URL when on the slide)
--or--
(integer) as in the slide number
id (string) element id of the plot to change
order (integer) 0 through the number of charts in the plot, which one is this plot?
(in order of appearance) */
if(typeof slide === 'number') { // slide number provided
which = document.querySelector('div.slide-number'); // page numbers like '6 / 10'
validator = Number(which.innerText.split(' ')[0]);
if(slide === validator) { // slide number matches current slide
var hc1 = document.getElementById(id).firstChild;
Highcharts.chart(hc1, Highcharts.charts[order].options); // re-draw plot
}
} else { // unique element in slide title
if(window.location.hash.indexOf(slide) > -1) {
var hc1 = document.getElementById(id).firstChild;
Highcharts.chart(hc1, Highcharts.charts[order].options); // re-draw plot
}
}
}
/* Current Slide Section (bookmark #) */
oHash = window.location.hash;
/* check if the slide has changed */
function keepLooking (nHash) {
if(oHash === nHash) {
return false;
} else {
oHash = nHash; /* if slide changed, reset the value of oHash */
return true;
}
}
```
Here is the entire QMD script I used to create and test this so you can see how it works.
---
title: "Untitled"
format:
revealjs:
slide-number: true
editor: source
---
## Quarto
```{r basics, echo=F}
library(echarts4r)
library(tidyverse)
library(htmltools)
library(highcharter)
```
```{r data, include=F,echo=F}
data("iris")
data(penguins, package = "palmerpenguins")
```
word
## Bullets
more words
## More Plots; How about Highcharter?
```{r penquins,echo=F}
hc <- hchart(penguins, "scatter",
hcaes(x = flipper_length_mm, y = bill_length_mm, group = species))
hc$elementId <- "hc_id"
hc
```
## Code
`echarts` style plot
```{r pltEcht, echo=F}
iris |> group_by(Species) |>
e_charts(Sepal.Length, elementId = "pltEcht") |> e_scatter(Sepal.Width)
```
## Another HC
```{r penquins2,echo=F}
hc2 <- hchart(iris, "scatter",
hcaes(x = Sepal.Length, y = Sepal.Width, group = Species))
hc2$elementId <- "another_hc_id"
hc2
```
```{r customizeMe,echo=F,engine='js'}
/* assuming only one on slide */
setInterval(function() {
var current = window.location.hash;
tellMe = keepLooking(current);
if(tellMe) { /* if the slide changed, then look */
ecReloader('code', 'pltEcht');
hcReloader('highchart', 'hc_id', 0);
hcReloader(6, 'another_hc_id', 1); /* second highcharter plot */
}
}, 10); // check every 10 milliseconds
```
```{r reloaders,echo=F,engine='js'}
// more dynamic; a couple of key words for each plot
// multiple options for addressing Echarts plots
function ecReloader(slide, id) {
/* slide (string) slide title unique substring (check URL when on the slide)
--or--
(integer) as in the slide number
id (string) element id of the plot to change */
if(typeof slide === 'number') { // slide number provided
which = document.querySelector('div.slide-number'); // page numbers like '6 / 10'
validator = Number(which.innerText.split(' ')[0]);
if(slide === validator) { // slide number matches current slide
var ec = document.getElementById(id);
ele = echarts.init(ec, get_e_charts_opts(ec.id));
thatsIt = get_e_charts_opts(ec.id); /* store data */
ele.setOption({xAxis: {}, yAxis: {}}, true); /* remove data */
ele.setOption(thatsIt, false); /* append original data */
}
} else { // unique element in slide title
if(window.location.hash.indexOf(slide) > -1) {
var ec = document.getElementById(id);
ele = echarts.init(ec, get_e_charts_opts(ec.id));
thatsIt = get_e_charts_opts(ec.id); /* store data */
ele.setOption({xAxis: {}, yAxis: {}}, true); /* remove data */
ele.setOption(thatsIt, false); /* append original data */
}
}
}
// multiple options for addressing Highcharts plots, assumes 1 chart per slide!
function hcReloader(slide, id, order) {
/* slide (string) slide title unique substring (check URL when on the slide)
--or--
(integer) as in the slide number
id (string) element id of the plot to change
order (integer) 0 through the number of charts in the plot, which one is this plot?
(in order of appearance) */
if(typeof slide === 'number') { // slide number provided
which = document.querySelector('div.slide-number'); // page numbers like '6 / 10'
validator = Number(which.innerText.split(' ')[0]);
if(slide === validator) { // slide number matches current slide
var hc1 = document.getElementById(id).firstChild;
Highcharts.chart(hc1, Highcharts.charts[order].options); // re-draw plot
}
} else { // unique element in slide title
if(window.location.hash.indexOf(slide) > -1) {
var hc1 = document.getElementById(id).firstChild;
Highcharts.chart(hc1, Highcharts.charts[order].options); // re-draw plot
}
}
}
/* Current Slide Section (bookmark #) */
oHash = window.location.hash;
/* check if the slide has changed */
function keepLooking (nHash) {
if(oHash === nHash) {
return false;
} else {
oHash = nHash; /* if slide changed, reset the value of oHash */
return true;
}
}
```
You can put the JS anywhere in your QMD.
If you see delays in loading (flashing, that sort of thing), you can lower the milliseconds between intervals. (That number is at the end of the setInterval function, where you see }, 10).
If something goes wrong, you can just set the JS to eval=F. You didn't actually change anything in your presentation permanently.

CSS selector for font color in flextable with shadow host on

I'm unsuccessfully trying to set the font color for flextable generated in r markdown using a css stylesheet.
I can accomplish this when I turn off shadow host, but not with it on. (Just turning it off removes other desirable features.) Here's a short r markdown file demonstrating the difference.
---
title: "Untitled"
output: html_document
---
<style>
div.flextable-shadow-host * {
color: pink;
}
div.tabwid * {
color: pink;
}
</style>
# ignores CSS above
```{r, echo=FALSE}
library(flextable)
flextable(head(mtcars))
```
# accepts CSS above
```{r, echo=FALSE}
ft <- flextable(head(mtcars))
htmltools_value(ft, ft.shadow = FALSE)
```
I want the css external to the r code because I have a button selector on the website the user can change the overall style (e.g., dark mode or not).
When using shadow, the table is assembled outside of HTML. Only the id connects the table to HTML. However, flextable has functions for setting the color. Why not just use one of the many built-in methods to change the color?
For example:
# ignores CSS above
```{r liberator,include=F}
library(flextable)
library(tidyverse)
```
```{r tbler, echo=FALSE}
flextable(head(mtcars)) %>%
color(color = "pink", part = "all")
```
# accepts CSS above
```{r, echo=FALSE}
ft <- flextable(head(mtcars))
htmltools_value(ft, ft.shadow = FALSE)
```
There are many things you can do with flextable styling. You can see more customization options here.
Update: Based on your comments
Okay, this works to change the color of a flextable.
This works if there is only one flextable in the script.
I have the color of the text set to #b21E29 (a shade of red). You can change that as you see fit.
These will SKIP non-shadow flextables
Add this chunk anywhere in your RMD script. This requires no additional libraries or any other customization in your R code.
```{r js_ing,results="asis",engine="js",echo=F}
// extract the styles that are set for the flextable
letMe = document.querySelector('div.flextable-shadow-host').shadowRoot.querySelector('div>style');
// replace color style
// preceding ';' so that 'background-color' doesn't change
letMe.innerHTML = letMe.innerHTML.replace(/;(color:.+?);/g, ';color:#b21e29 !important;');
```
If you have more than one flextable with shadow on, you can use one of the two following chunks instead. In the first--all the same color; in the second--each table has a different color.
These work if there is more than one flextable in the script.
Pay attention to the comments so you can see what to use when depending on your desired output.
All the same color:
```{r moreJs_ing,results="asis",engine="js",echo=F}
// collect all of the flextables with shadow
letMe = document.querySelectorAll('div.flextable-shadow-host');
// to set all shadow flextables to the same font color:
for(i = 0, n = letMe.length; i < n; i++){
showMe = letMe[i].shadowRoot.querySelector('div>style');
showMe.innerHTML = showMe.innerHTML.replace(/;(color:.+?);/g, ';color:#b21e29 !important;');
}
```
Each with there own color:
```{r evenMoreJs_ing,results="asis",engine="js",echo=F}
//alternatively to set each to a different color
// make sure you only include one of these options!
// collect all of the flextables with shadow
letMe = document.querySelectorAll('div.flextable-shadow-host');
// first table in script
showFirst = letMe[0].shadowRoot.querySelector('div>style');
showFirst.innerHTML = showFirst.innerHTML.replace(/;(color:.+?);/g, ';color:#b21e29 !important;');
// second table in script
showSecond = letMe[1].shadowRoot.querySelector('div>style');
showSecond.innerHTML = showSecond.innerHTML.replace(/;(color:.+?);/g, ';color:#003b70 !important;');
// change the indices for each table, keep in mind the first table is [0], not [1]
```
If you aren't sure where you want to go with these, add all three and and include=F as a chunk option to the two you aren't using at that moment in time.

How do I reduce/remove space between list items in my R Markdown code?

Okay, so I am knitting my R Markdown to a Word document and want to remove the whitespace available between the list items as much as possible.
The code I'm using is :
- The first line.
- The second line.
- The third line.
Can anyone help? Thanks in advance.
We can do this with CSS inside Rmarkdown! just add a CSS chunk and you can control the body of text, or any other desired text.
---
title: "Rmarkdown page"
output: html_document
---
```{css echo = FALSE}
body {line-height: 5;}
```
- item 1
- item 2
- item 3
---
title: "Rmarkdown page"
output: html_document
---
```{css echo = FALSE}
body {line-height: .8;}
```
- item 1
- item 2
- item 3

How do I add css style element to Rmd shiny renderImage?

I am struggling to add css style element to my shiny renderImage code.
I have tried various options with css source file via tag$link as well as with straight css code via tag$style.
I have tried both the tag$link as well as the tag$style options (in my sample code)
(1) outside of the renderImage code
(2) inside the renderImage code, outside of the list wrapper
(3) inside the renderImage code, inside of the list wrapper
I get one of two errors:
Error 1: Object of type 'closure' is not subsettable
Error 2: Object 'centerImage' not found
With my logo5.png image on my local machine, with no additional css - it works.
With my logo5.png image on my local machine, with additional css - it DOES NOT work.
Note that I left the '1', dir() and '2' in my code prior to renderImage to track execution.
Can someone please help?
(To run in Rstudio, change the rrr`` to the 3 back quotes in 4 places)
(My online image URL is http://www.richpat.com/wp-content/uploads/2019/04/logov5.png)
---
title: 'Shiny Dev with Logo'
output:
flexdashboard::flex_dashboard:
theme: united
orientation: columns
source_code: embed
runtime: shiny
---
rrr``{r setup, include=FALSE} #CORRECT THIS WHEN RUNNING
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
library(flexdashboard,quietly=TRUE, verbose=FALSE)
library(shiny,quietly=TRUE, verbose=FALSE)
library(plotly,quietly=TRUE, verbose=FALSE)
rrr`` #CORRECT THIS WHEN RUNNING
Corporate
=======================================================================
Column
-----------------------------------------------------------------------
### Logo
rrr``{r} #CORRECT THIS WHEN RUNNING
(1)
dir()
#tag$head(tags$link(rel = "stylesheet", type = "text/css", href = "BRstyle.css"))
#tag$head(tag$style("centerImage {text-align:center;}"))
(2)
renderImage({
rfilename=normalizePath("logov5.png")
list(src=rfilename, contentType = "image/png", alt = "logo5", class=centerImage)
}, deleteFile = FALSE)
rrr`` #CORRECT THIS WHEN RUNNING
Background
=======================================================================
Column
-----------------------------------------------------------------------
### Purpose
ad valorem libram
OK - so I found the answer. And simplicity is the route...
Instead of doing this in shiny renderImage, I learned a lot about how shiny and flexdashboard and markdown work together !!!
I used img html tag as part of the markdown section with direct display tags
<img src="http://www.richpat.com/wp-content/uploads/2019/04/logov5.png"
alt="Markdown Monster icon"
style="ftext-align:center; display: center;" />
And I removed the complete shiny renderImage r-code section
As a bonus - and just to show a bit more of what I learned, here is my revised yaml
title: 'Br F A'
output:
flexdashboard::flex_dashboard:
logo: logov5s.png
theme: readable
css: BRstyle.css
navbar:
- { title: "About", href: "http://www.richpat.com", align: left }
source_code: embed
orientation: columns
runtime: shiny

R Notebook HTML Format - add hyperlinks to paged table

I wish to knit an html file from an R Notebook that contains paged tables with hyperlinks.
Hyperlinks can be inserted using knitr::kable, but I can't find a way to generate a paged table with this function.
Paged tables are the default notebook output, but I can't find a way of inserting functional hyperlinks. Many thanks for your help.
---
title: "Paged notebook table with hyperlinks"
output:
html_notebook:
code_folding: "hide"
---
```{r rows.print=3}
wiki.url <- "https://en.wikipedia.org/wiki/"
df1 <- data.frame(Month=month.name, URL=paste0("[", month.name, "](", wiki.url, month.name, ")"))
df2 <- data.frame(Month=month.name, URL=paste0("<a href='", wiki.url, month.name, "'>", month.name, "</a>"))
print(df1)
```
```{r rows.print=3}
print(df2)
```
```{r rows.print=3}
knitr::kable(df1)
```
```{r rows.print=3}
knitr::kable(df2)
```
Since there doesn't seem to be a perfect solution to my problem, I thought I'd post the workaround that I came up with - in case someone has a similar problem.
I created the table plus hyperlinks with knitr::kable and then added an html button and inline javascript to toggle visibility - not as elegant as a paged table, but does the job.
Note the <script> tag at the bottom of the file that hides tables by default.
(Paste code into an .Rmd file in RStudio):
---
title: "Managing large tables with hyperlinks in html notebook"
output:
html_notebook:
code_folding: "hide"
---
<script>
function myFunction(id) {
var x = document.getElementById(id);
if (x.style.display === 'none') {
x.style.display = 'block';
} else {
x.style.display = 'none';
}
}
</script>
```{r}
library(knitr)
df1 <- data.frame(Month=month.name, Link=paste0("[", month.name, "](https://en.wikipedia.org/wiki/", month.name, ")"))
```
<button class="button" onclick="myFunction('DIV_months')">Show/hide table</button>
<div id="DIV_months" class="div_default_hide">
```{r}
knitr::kable(df1)
```
</div>
<script>
var divsToHide = document.getElementsByClassName("div_default_hide");
for(var i = 0; i < divsToHide.length; i++)
{
divsToHide[i].style.display = 'none';
}
</script>

Resources