Programatically generate titles in R notebook - r

I am trying to generate a report in R notebook where a large number of plots are generated. I am trying to use the H1 tag to have a nice table of content but whenever I run my code. I get the titles bunched up at the top and the graphs bunched up at the bottom instead of having a title followed by the graph.
I am using this old SO as template.
Here is a minimalistic reproduction:
---
title: "R Notebook"
output:
html_notebook:
toc: yes
---
```{r, results='hide'}
library(tidyverse)
dt <- as_tibble(iris)
dt %>% mutate(Species = as.character(Species)) %>%
group_by(Species) %>%
nest() %>%
mutate(plot = map(data, ~ ggplot(data=.x) + geom_line(aes(y= Sepal.Length, x= Sepal.Width)))) ->Plots
```
```{r echo = FALSE, results='asis'}
for( i in 1:nrow(Plots)){
dt <- Plots[i,]
cat('\n#', dt[[1]], '\n')
p <- dt[[3]]
print(p)
cat('\n')
}
```
This is my output
Any ideas?

Related

RMarkdown knitting produces each plot twice

This is the code:
---
title: "Data Analysis"
author: "Author"
date: "`r Sys.Date()`"
output: word_document
---
{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(viridisLite)
library(ggplot2)
library(GGally)
library(plotly)
library(readxl)
library(vtable)
library(imputeTS)
library(janitor)
library(tibble)
library(readr)
library(survival)
library(survminer)
library(tidyr)
library(tidyverse)
library(broom)
library(DataExplorer)
library(dplyr)
library(WeibullR)
library(ggfortify)
library(factoextra)
library(gridExtra)
```
Text Text Text
{r unsorted, echo=FALSE, warning=FALSE}
setwd("C:/Users/R//")
df = data.frame(read.csv("file.csv"
, header = TRUE
, sep = ";"
, dec = ","
, na.strings = "---"))
# clean data frame ----
df<- df %>%
clean_names()
df<- df %>% janitor::remove_empty(whic=c("rows"))
df<- df %>% janitor::remove_empty(whic=c("cols"))
df<- dplyr::distinct(df)
colnames(df)[1]<- "country"
df_unsorted<- df
DataExplorer::plot_missing(df_unsorted[, 1:ncol(df_unsorted)]
, theme_config =list(axis.text=element_text(size = 12))) + theme_bw()
```
which, whyever, results in:
weird enough, that the plots look slightly different but I don't see any reasons why they are plotted, respectively why one of them.
I've also seen Why is this graph showing up twice in R Markdown? but there is no answer given.
The issue is that as a side effect DataExplorer::plot_missing prints the plot and returns the ggplot object invisibly. By adjusting the theme of the returned ggplot object via + theme_bw you get a second plot.
One option to prevent that would be to set the theme via the ggtheme argument.
Making use of the default example from ?DataExplorer::plot_missing:
---
output: html_document
date: '2022-04-20'
---
```{r}
library(DataExplorer)
library(ggplot2)
plot_missing(airquality, theme_config = list(axis.text = element_text(size = 12)), ggtheme = theme_bw())
```

Cannot knit Markdown doc using the {flair} package - "Could not find function viewer"

I'm trying out the flair package within a markdown document, and I'm having trouble knitting a document as shown in the package's announcement page. Here's a basic .Rmd example using code from that page:
---
title: "test"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(ggplot2)
library(readr)
library(flair)
baby_names <- read_delim("https://education.rstudio.com/blog/2020/05/flair/kellys_ca.txt", delim = " ")
```
```{r geoms, include=FALSE}
baby_names %>%
ggplot(aes(x = Year, y = Count, fill = Gender)) +
geom_col()
baby_names %>%
ggplot(aes(x = Year, y = Count, color = Gender)) +
geom_line()
```
```{r echo=FALSE}
decorate("geoms") %>%
flair("_col") %>%
flair("fill = ") %>%
flair("_line") %>%
flair("color = ")
```
This fails to knit, giving me this error:
Error in viewer(htmlFile) : could not find function "viewer" Calls: ... knit_print.default -> normal_print -> print -> print.with_flair
I have tried knitting without preview without success either. I'm not entirely certain where the "viewer" function is coming from, or why it's being utilized.
EDIT: Will keep it open for now, but it seems to be a bug: https://github.com/kbodwin/flair/issues/13

Printing headers, plots, and tables in a loop in rmarkdown

I'm trying to use RMarkdown/R Notebooks to produce an automated report based on a single dataset broken out by department. Intuitively, I want to use a for loop that filters the dataset to a single department, provides a title, displays a few graphs and tables specific to that deparment, and then produces a page break and starts with the next department.
Here's a reprex of what I have so far. Problems with the resulting code:
There are blank spaces throughout, pretty sure related to the use of dev.off() and plot.new(). If I remove these, only the first plot prints and the titles print all together in a bunch at the beginning. If I include the dev.off and plot.new calls, then I get blank graphics placeholders.
There are NA items throughout. I'm not sure why. They don't appear when running the code in RStudio, only in the resulting output.
I can't get headers to work and act like H1, H2 etc.
headers. They are rendered as code output.
Am I approaching this wrong? Should I not use a for loop, but do something else instead? If I take everything out of the loop and do it manually, it works great.
```
---
title: "Demo Notebook"
output:
word_document: default
---
```{r echo=FALSE, message=FALSE, warning=FALSE, paged.print=TRUE, results= "asis"}
library(tidyverse)
library(knitr)
spp <- unique(iris$Species)
for (i in seq_along(spp)) {
print(paste0("# Species: ", spp[i]))
d <- iris %>%
filter(Species == spp[i])
# one kind of plot
p <- ggplot(d, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_smooth() +
ggtitle(spp[i])
print(p)
dev.off()
plot.new()
# another plot
q <- plot(d$Sepal.Length)
print(q)
dev.off()
# a table
print(kable(head(d)))
}
```
That seems to be more complicated than anticipated. I managed with this solution, using flextable and, for some reason, needed two types of page breaks to actually get one in the word document:
---
title: "Demo Notebook"
output:
word_document: default
---
```{r setup, include=FALSE}
library(tidyverse)
library(flextable)
```
```{r, echo=FALSE, message=FALSE, warning=FALSE, results='asis', fig.height=3, out.width="50%"}
spp <- unique(iris$Species)
for (x in seq_along(spp)) {
print(paste0("# Species: ", spp[x]))
d <- iris %>% filter(Species == spp[x])
cat("\n\n")
# one kind of plot
p1 <- ggplot(d, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_smooth() +
ggtitle(spp[x])
plot(p1)
cat("\n\n")
# another plot
plot(d$Sepal.Length)
cat("\n")
# a table
ft <- d[1:10, ] %>%
flextable() %>%
align(part = "all") %>% # left align
set_caption(caption = "Table 1: Example") %>%
font(fontname = "Calibri (Body)", part = "all") %>%
fontsize(size = 10, part = "body") %>%
theme_booktabs() %>% # default theme
autofit()
cat("\n")
cat(paste("\n```{=openxml}",
format(ft, type = "docx"),
"```\n", sep = "\n"))
cat("\n\n\\pagebreak\n")
cat('<div style="page-break-before: always;" />')
}
```

Create RMarkdown chuncks in a loop

I would like to be able to create RMarkdown chuncks in a loop. I have tried doing this through a for loop, without much success. I imagine this could probably be possible through lapply, as one would do for creating UIs in a shiny app. However, I haven't had any success so far.
Reprex:
---
title: "Untitled"
output:
html_document:
theme: united
highlight: tango
toc: true
toc_float:
collapsed: false
smooth_scroll: false
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(ggplot2)
df <- datasets::iris %>%
dplyr::as_tibble()
```
## setosa
```{r}
df %>%
dplyr::filter(Species == "setosa") %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
```
## versicolor
```{r}
df %>%
dplyr::filter(Species == "versicolor") %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
```
## virginica
```{r}
df %>%
dplyr::filter(Species == "virginica") %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
```
My goal is to create the headings (setosa, versicolor, and virginica) and the chuncks with a loop.
For example:
for(i in c("setosa", "versicolor", "virginica")) {
## i
df %>%
dplyr::filter(Species == i) %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
}
Any ideas on how accomplish this?
If you want to create headings + outputs within a loop, you can do:
```{r species_loop, results='asis'}
for(i in c("setosa", "versicolor", "virginica")) {
cat(paste0("\n\n## ", i, "\n"))
p <- df %>%
dplyr::filter(Species == i) %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
print(p)
}
```
So:
Using results='asis' to allow output that you cat() to be interpreted as Markdown syntax
cat()ing the required markdown syntax to produce the headers (surrounded by some newlines to make sure it's interpreted properly)
Explicitly print()ing the plot within the loop.
A function based on cat would replicate your chunks for every iris species. For the one-time chunks use single cats.
FUN <- function(x) cat("\n##", x, "
```{r}
df %>%
dplyr::filter(Species == ",x, ") %>%
ggplot2::ggplot(ggplot2::aes(Sepal.Length, Petal.Length)) +
ggplot2::geom_point()
```\n")
To produce the shown .Rmd file, you could use sink. (For sake of brevity I'll omit the header here.)
sink(file="iris.Rmd") ## start `sink`
cat("```{r}
library(dplyr)
library(ggplot2)
df <- datasets::iris %>%
dplyr::as_tibble()
```")
invisible(sapply(c("'setosa'", "'versicolor'", "'virginica'"), FUN))
sink() ## end `sink`
You'll find your .Rmd file in your working directory (getwd()).

Using long figures in markdown

I'm displaying long figures in a markdown report.
These are long because they use ggplot2::facet_wrap so their height depend on the data, which is not constant.
I can set the figure.height parameter of the chunk but then it's fixed and my report looks bad. Is their a way around this ?
Example :
---
title: "title"
author: "author"
date: '`r Sys.Date()`'
output: html_document
---
```{r, figure.height=40}
library(dplyr)
library(ggplot2)
iris %>%
mutate_at("Sepal.Length",cut, 5) %>%
mutate_at("Sepal.Width",cut,2) %>%
group_by_at(c(1,2,5)) %>%
summarize_at("Petal.Length",mean) %>%
ggplot(aes(Species, Petal.Length)) +
geom_col() +
facet_wrap(Sepal.Length ~ Sepal.Width,ncol=2)
```
I had a similar issue and was not able to get Peter's solution to work. From what I'm able to gather, eval.after does not work with fig.height.
But thanks to Peter's example, I was able to find a work-around:
---
author: "author"
date: '`r Sys.Date()`'
output: html_document
---
```{r setup}
library(dplyr)
library(ggplot2)
library(knitr)
FACET_HEIGHT <- 3.4
```
In chunk 1: First, create the ggplot.
Then, use `ggplot_build` to create a new variable called `adaptive_figure_height`.
Finally, use knitr::opts_chunk$set to update the chunk option `fig.height` to better suit your ggplot.
```{r}
g <-
iris %>%
mutate_at("Sepal.Length",cut, 5) %>%
mutate_at("Sepal.Width",cut,2) %>%
group_by_at(c(1,2,5)) %>%
summarize_at("Petal.Length",mean) %>%
ggplot(aes(Species, Petal.Length)) +
geom_col() +
facet_wrap(Sepal.Length ~ Sepal.Width, ncol = 2)
adaptive_fig_height <- FACET_HEIGHT * max(ggplot_build(g)$layout$layout$ROW)
opts_chunk$set( fig.height = adaptive_fig_height )
```
In chunk 2: Plot the ggplot.
If needed, you can revert `fig.height` back to a default value.
```{r }
g
opts_chunk$set( fig.height = 7 )
```
Repeat the setup in chunk 1 and 2 if you have multiple long plots with differing heights.
To go along with the n * single_height idea: you can use the chunk option eval.after so that the fig.width and fig.height options will be evaluated after the rest of the chunk is evaluated and then use the ggplot_build to pull apart a ggplot object and determine the number of rows and columns used in the facets.
For example:
---
author: "author"
date: '`r Sys.Date()`'
output: html_document
---
```{r setup}
library(dplyr)
library(ggplot2)
library(knitr)
FACET_HEIGHT = 3.4
FACET_WIDTH = 5
opts_chunk$set(out.width = "80%",
out.height = "80%",
eval.after = c("fig.height", "fig.width"))
```
For the example we'll have one basic plot to which we will set different facets.
```{r}
g <-
iris %>%
mutate_at("Sepal.Length",cut, 5) %>%
mutate_at("Sepal.Width",cut,2) %>%
group_by_at(c(1,2,5)) %>%
summarize_at("Petal.Length",mean) %>%
ggplot(aes(Species, Petal.Length)) +
geom_col()
```
A graphic with two columns
```{r fig1, fig.height = FACET_HEIGHT * max(ggplot_build(g1)$layout$layout$ROW), fig.width = FACET_WIDTH * max(ggplot_build(g1)$layout$layout$COL)}
g1 <- g + facet_wrap(Sepal.Length ~ Sepal.Width, ncol = 2)
g1
```
A graphic with two rows
```{r fig2, fig.height = FACET_HEIGHT * max(ggplot_build(g2)$layout$layout$ROW), fig.width = FACET_WIDTH * max(ggplot_build(g2)$layout$layout$COL)}
g2 <- g + facet_wrap(Sepal.Length ~ Sepal.Width, nrow = 2)
g2
```
A screenshot of the resulting html is:
Some fine tuning of the image width and height will be needed, but this should be a good starting point.

Resources