Show an R markdown chunk in the final output - r

I am writing on a presentation using Knitr, Markdown and Slidify. The slides will be partly deal with Knitr as topic which is the reason why I stumbeld upon a problem. I cannot include for example a knitr-markdown chunk to show it on the slide. It will always be interpreted on the first run even if I do something like this:
```
```{r eval = F, include = T}
```
```
How can I prevent a chunk to be interpreted and thus removed from the final output so that I can show how a chunk is structured when using Markdown and Knitr?
EDIT:
I tried the version of you #Ramnath and made up te following slides:
## Testslide 1
```{r verbatimchunk, verbatim = TRUE}
x = 1 + 1
x
```
```{r regularchunk}
x = 1 + 1
x
```
---
## Testslide 2
```{r verbatimchunk_2, verbatim = TRUE}
x = 1 + 1
x
```
* element 1
* element 2
---
## Testslide 3
* element 1
* element 2
```{r verbatimchunk_3, verbatim = TRUE}
x = 1 + 1
x
```
The first two slides work fine but the last one is the problem. If there is a bullet list before the verbatim chunk, it is interpreted as usual. So it is the same as with the first solution from #Scott. I do not understand this.
EDIT 2/3 (Working solution)
```{r echo = FALSE}
require(knitr)
hook_source_def = knit_hooks$get('source')
knit_hooks$set(source = function(x, options){
if (!is.null(options$verbatim) && options$verbatim){
opts = gsub(",\\s*verbatim\\s*=\\s*TRUE\\s*", "", options$params.src)
bef = sprintf('\n\n ```{r %s}\n', opts, "\n")
stringr::str_c(bef, paste(knitr:::indent_block(x, " "), collapse = '\n'), "\n ```\n")
} else {
hook_source_def(x, options)
}
})
```
## Testslide
* Element one
* Element two
Some text here breaks list environment:
```{r verbatim = T}
any code
```

Here is another solution that makes use of chunk hooks. The idea is that if you have a chunk with option verbatim = TRUE, it activates the hook and outputs the chunk verbatim. I have checked that it works with Slidify too.
```{r echo = FALSE}
require(knitr)
hook_source_def = knit_hooks$get('source')
knit_hooks$set(source = function(x, options){
if (!is.null(options$verbatim) && options$verbatim){
opts = gsub(",\\s*verbatim\\s*=\\s*TRUE\\s*", "", options$params.src)
bef = sprintf('\n\n ```{r %s}\n', opts, "\n")
stringr::str_c(bef, paste(knitr:::indent_block(x, " "), collapse = '\n'), "\n ```\n")
} else {
hook_source_def(x, options)
}
})
```
```{r verbatimchunk, verbatim = TRUE}
x = 1 + 1
x
```
```{r regularchunk}
x = 1 + 1
x
```
EDIT: The trick with code chunks after a list is that the list environment needs to be broken. A quick and dirty way is just to add an empty paragraph element. Alternately, you can fix the hook so that en empty paragraph is automatically added at the beginning of the code chunk.
* element 1
* element 2
<p></p>
```{r verbatimchunk_3, verbatim = TRUE}
x = 1 + 1
x
```

I think you need to add an empty string after ```{r}, and knitr will not execute the chunk, but will display it. See the example here
This on a slide works for me (where the top one executes and the bottom does not)
---
```{r}
list(5, 6, 7)
```
```{r}`r ''`
hist(rnorm(100))
5 + 6
```
---

Very late to the party, but this also seems to work:
```{r echo=FALSE, class.output="r", comment=""}
cat("```{r}\nx <- 1 + 1\nx\n```")
```
Or, equivalent but perhaps nicer to read and write:
```{r echo=FALSE, class.output="r", comment=""}
cat(paste(sep = "\n",
"```{r}",
"x <- 1 + 1",
"x",
"```"
))
```

Related

flextable in Rmarkdown docx not printing within if statement if other text

I'm trying to use the package flextable to get some nicely formatted tables in my Rmarkdown (going to word file). The tables work just fine in general but if I put it within an if statement, if there is anything else being printed from the if statement I don't see the table. Any ideas what's going on?
Update Jan 2020 for any people still looking at this
As of version 0.5.5 of flextable there is a new function docx_value to address this, I have updated the answer to reflect this so that other people don't use the complicated workarounds now there is a simple solution.
My example (run all together) :
---
title: "Testing"
output:
word_document:
reference_docx: styles.docx
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## R Markdown
```{r defaults}
library(pander)
library(knitr)
library(flextable)
```
1st test works fine - no if statement and new lines either side of table
## test 1 table no if statemnets
```{r test1, echo = FALSE, results = 'asis'}
test <- data.frame (c = 1:5, x = 6:10)
testft <- flextable(test)
testft
```
2nd test has an if statement with no other text and works fine
## test 2 if statement no other text
```{r test2, echo = FALSE, results = 'asis'}
RunTable <- TRUE
if(RunTable){
testft
}
```
But if I try and add other outputs in my if statement, either with or without new line breaks I don't get any table in my output
## test 3 if statement with other text
```{r test3, echo = FALSE, results = 'asis'}
#Hack so dat works up to year 2047 as cpp functions in padr can't handle data beyond 2038
#Get Daily Values
RunTable <- TRUE
if(RunTable){
print("before ")
testft
print("after ")
}
```
## test 4 if statement with other text and newlines
```{r test4, echo = FALSE, results = 'asis'}
RunTable <- TRUE
if(RunTable){
print("if with linebreak before ")
cat(" \n")
knit_print(testft)
cat(" \n")
print("if with linebreak after ")
}
```
Output:
You can use chunk option results = 'asis' and write the openxml content with format as following
## test 4 if statement with other text and newlines
```{r test4, echo = FALSE, results = 'asis'}
RunTable <- TRUE
if(RunTable){
print("if with linebreak before ")
cat(" \n")
cat(
paste(
"\n```{=openxml}",
format(testft, type = "docx"),
"```\n", sep = "\n")
)
cat(" \n")
print("if with linebreak after ")
}
```
Not sure if you would consider a different package, but this seems to work:
---
title: "Testing"
output:
word_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, fig.height=1.5, fig.width=3, fig.align='right', fig.align = "center")
```
## R Markdown
```{r defaults}
library(pander)
library(knitr)
library(flextable)
library(tableHTML)
```
## test 1 table no if statemnets
```{r test1, echo = FALSE}
test <- data.frame (c = 1:5, x = 6:10)
tab <- tableHTML(test, widths = c(60, 60), rownames = FALSE) %>% add_theme('scientific')
tab %>% tableHTML_to_image()
```
## test 2 if statement no other text
```{r test2, echo = FALSE}
RunTable <- TRUE
if(RunTable){
tab %>% tableHTML_to_image()
}
```
```{r test3, echo = FALSE}
#Hack so dat works up to year 2047 as cpp functions in padr can't handle data beyond 2038
#Get Daily Values
RunTable <- TRUE
if(RunTable){
print("before ")
tab %>% tableHTML_to_image()
print("after ")
}
```
## test 4 if statement with other text and newlines
```{r test4, echo = FALSE}
RunTable <- TRUE
if(RunTable){
print("if with linebreak before ")
cat(" \n")
tab %>% tableHTML_to_image()
cat(" \n")
print("if with linebreak after ")
}
For example, you can see test 4 as an output:
A couple of notes:
You can format the table in the exact way you want.
The code produces an image.
I presume your problem is related to this issue.
Changing the problematic chunks like this seems to work:
## test 3 if statement with other text
```{r test3, echo = FALSE}
RunTable <- TRUE
if(RunTable){
text <- c(
"before ",
knit_print(testft),
"after "
)
asis_output(paste(text, collapse = "\n"))
}
```
## test 4 if statement with other text and newlines
```{r test4, echo = FALSE}
RunTable <- TRUE
if(RunTable){
text <- c(
"if with linebreak before ",
" \\newline",
knit_print(testft),
" \\newline\n",
"if with linebreak after "
)
asis_output(paste(text, collapse = "\n"))
}
```
Regarding the last one:
I had to use \\newline to actually insert an extra blank line before the table.
I don't know why an extra \n is needed for the blank line after, it wouldn't work for me otherwise.
Just to test, I tried adding several \\newline entries, both before and after, but one blank line was the most I could get.
Update Jan 2020 for any people still looking at this
As of version 0.5.5 of flextable there is a new function docx_value to address this, as described in the package news:
flextable 0.5.5
new features
new function docx_value to let display flextables from non top level
calls inside R Markdown document.

Collapse error message into a single block when the error message is modified to print in red

How can I get a printed error message in RMarkdown to collapse into a single block when the error message itself was modified to print in red?
In this example collapse = T works as expected.
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = TRUE)
```
```{r error=T}
x <- c(1,2,3,4,5)
x * 10
X * 10
```
In this example, I modified the error message to be formatted in red (based on this answer). But then it doesn't collapse with the rest:
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = TRUE)
knitr::knit_hooks$set(error = function(x, options) {
paste0("<pre style=\"color: red;\"><code>", x, "</code></pre>")
})
```
```{r error=T}
x <- c(1,2,3,4,5)
x * 10
X * 10
```
I tried to specify collapse = T again in the specific code chunk but this won't work either:
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = TRUE)
knitr::knit_hooks$set(error = function(x, options) {
paste0("<pre style=\"color: red;\"><code>", x, "</code></pre>")
})
```
```{r error=T, collapse = T}
x <- c(1,2,3,4,5)
x * 10
X * 10
```
With the current development version of knitr (remotes::install_github('yihui/knitr')), you can specify the CSS class for error messages. Here is an example:
```{r setup, include=FALSE}
knitr::opts_chunk$set(collapse = TRUE)
```
```{css, echo=FALSE}
.red {
color: red;
padding-top: 0;
margin-top: -15px;
border-top-color: #f5f5f5;
}
```
```{r error=T, class.error='red'}
x <- c(1,2,3,4,5)
x * 10
X * 10
```
Output:
When knitting to HTML, the highlighting is done in the last step, when the site is generated. The collapsing of chunks is done prior to that.
What complicates this is the fact that errors are highlighted just like strings and cannot be distinguished from actual string output.
Adding classes by altering a hook (like ```{.myClass} ...source code... ```) does not help us, since this will break the chunk collapsing mechanism and even if I fix this (can be done by simply changing the underlying regex inside the chunk hook) the class is not present anymore when the site has rendered.
So in the end I only came up with the following.
---
title: "test"
output: html_document
---
<script>
$(document).ready(function() {
window.setTimeout(function() {
$(".hljs-comment:contains('####')").css("color", "red");
var tmp = $(".hljs-comment:contains('####')").text();
$(".hljs-comment:contains('####')").text(tmp.replace("####", "##"));
}, 15);
});
</script>
# Header 1
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = T)
default_hook <- knitr::knit_hooks$get("error")
knitr::knit_hooks$set(error = function(x, options) {
x <- paste0("##", x)
default_hook(x, options)
})
```
```{r error=T}
x <- c(1,2,3,4,5)
x * 10
X * 10
```
Here we change the error hook in that sense that two additional hashes are prepended to the output. In the Javascript snippet we then look for these lines, change the font color to red and delete the hashes again. This is done with a delay of 15ms. Why? If we execute the code immediately, the elements carrying the classes generated by highligh.js are not yet present. So we have to be a little slower.

RMarkdown: How to use hooks on individual chunks?

I want to use knitr hooks on individual chunks using the datacamp/tutorial package. As per the following document, I get to set two options of height and greedy by using tutorial::go_interactive(greedy=FALSE, height=500)
How can I set different variables for individual chunks using knitr_hooks?
For eg., For the first chunk I want to set it up as greedy=TRUE, and for the second one, I want greedy=FALSE.
---
title: "Example Document"
author: "Your name here"
output:
html_document:
self_contained: false
---
```{r, include=FALSE}
tutorial::go_interactive()
```
Here's an example of a Python fiddle/
```{python}
a = 2
b = 3
print(a + b)
```
```{python}
x = 2
y = 3
print(x + y)
```
Never mind. Found the answer here
You have to set tut = FALSE on the chunk to knit it as a normal chunk.
```{r, include=FALSE}
tutorial::go_interactive()
```
Here's an example of a Python fiddle/
```{python}
a = 2
b = 3
print(a + b)
```
```{python, tut=FALSE}
x = 2
y = 3
print(x + y)
```

knit_child in a loop - variable as title

Following this and this stackoverflow-questions, I tried to use knit-child inside a loop, containing a variable-defined title.
Instead of the variables (e.g. A, B, C) as title, I get them with # still attached (# A, # B, # C)
Parent:
---
title: "Untitled"
output: html_document
---
```{r,include=FALSE}
library(knitr)
```
```{r,echo=FALSE}
titles<-LETTERS[1:3]
```
```{r,include=FALSE,echo=FALSE}
out = NULL
for (i in titles){
out = c(out, knit_child('Child.Rmd'))
}
```
`r paste(out, collapse='\n')`
Child:
---
title: "Untitled"
output: html_document
---
```{r,echo=FALSE,results='asis'}
cat("\n\n # ", i,"\n")
```
```{r,echo=FALSE,results='asis'}
cat("\n\n This text is about ", i,"\n")
```
Output:
While I would prefer:
The # character only indicates a heading in markdown if it is the first character of the line.
cat("\n\n # ", i,"\n") produces two new lines, then one space and then the #. Remove the whitespace to fix the issue:
cat("\n\n# ", i,"\n")
Consider using pandoc.headerinstead of Cat.
i = 1
pander::pandoc.header(i, level = 1)
> # 1
pander::pandoc.header(paste0("Subheading ", i), level = 3)
> ### Subheading 1
I recommend using the knit_expand function.
You create your Child.Rmd as
# {{current_title}}
This text is about {{current_title}}
Remember that `current_title` is a literal string, so
if you want use it in code then must be quoted:
<!-- Use `current_title` in chunk name to avoid duplicated labels -->
```{r {{current_title}}}
data.frame({{current_title}} = "{{current_title}}")
```
Then your main document shoud looks like this:
---
title: "Untitled"
output: html_document
---
```{r,include=FALSE}
library(knitr)
```
```{r,echo=FALSE}
titles<-LETTERS[1:3]
```
```{r,include=FALSE,echo=FALSE}
expanded_child <- lapply(
titles
,function(xx) knit_expand("Child.Rmd", current_title = xx)
)
parsed_child <- knit_child(text = unlist(expanded_child))
```
`r parsed_child`
Results:

Creating dynamic tabs in Rmarkdown

In Rmarkdown, it's possible to create tabs, for example:
---
output: html_document
---
# Tabs {.tabset}
## Tab 1
foo
## Tab 2
bar
I'm wondering if it's possible to create an arbitrary number of tags? How can I create a tab programatically?
The following code is a poor attempt to do this, but it results in a heading instead of a tab.
---
output: html_document
---
# Tabs {.tabset}
```{r echo=FALSE}
shiny::tags$h2("Tab 1")
```
foo
## Tab 2
bar
Solution
Thanks to #GGamba for providing a great solution. I needed to go one step further and be able to add tabs as part of a loop, so I needed to make two changes. First of all, I used this code to dynamically add tabs (the only difference here is that I force the evaluation of hrefCode inside the timeout because otherwise all timeouts called together will use the same value)
(function(hrefCode){setTimeout(function(){
var tabContent = document.createElement('div');
var tabContainerTarget = document.getElementsByClassName('tab-content')[0];
tabContent.setAttribute('id', 'tab-' + hrefCode);
tabContent.setAttribute('class', 'tab-pane')
tabContent.innerHTML = '", gsub('\n', '', Panel, fixed = TRUE), "';
tabContainerTarget.appendChild(tabContent);
}, 100);
})(hrefCode);
Secondly, to add tabs in a loop, you can do something like this:
tabsToAdd <- list("tab3" = "hello", "tab4" = "world")
shiny::tagList(lapply(names(tabsToAdd), function(x) {
addToTabset(title = x, tabsetId = 'tbSet1',
tabPanel(x, tabsToAdd[[x]]))
}))
There is also a simple rmarkdown solution to this problem that does not require shiny and/or custom javascript. Does not work for all kinds of R output (see below):
## Tabbed Example {.tabset}
```{r, results = 'asis'}
for (nm in unique(iris$Species)){
cat("### ", nm, "\n")
cat(knitr::knit_print(plot(iris[iris$Species == nm, ])))
cat("\n")
}
```
A more involved method, that first creates a list of raw Rmarkdown code as a list of character vectors, which are then evaluated in a separate (inline) code chunk with knitr::knit(). This works for all kinds of output, not just base plots.
## Tabbed Example ggplot {.tabset}
```{r}
library(ggplot2)
template <- c(
"### {{nm}}\n",
"```{r, echo = FALSE}\n",
"ggplot(iris[iris$Species == '{{nm}}', ], aes(x = Sepal.Length, y = Sepal.Width)) + geom_point()\n",
"```\n",
"\n"
)
plots <- lapply(
unique(iris$Species),
function(nm) knitr::knit_expand(text = template)
)
```
`r knitr::knit(text = unlist(plots))`
As far as I know what you are trying to do is not possible in rmarkdown (but I'd love to stand corrected). But of course we can implement a function to do just that.
I based my answer on this answer by #KRohde, so all the credits goes to him. I just adapted it to work in a simpler markdown document.
The answer is mostly build with JS rather than R, but as the markdown is mostly an HTML I feel JS is a better tool.
Here is the code:
---
output: html_document
---
```{r echo=FALSE, results='asis'}
library(shiny)
addToTabset <- function(title, tabsetId, Panel) {
tags$script(HTML(paste0("
/* Getting the right tabsetPanel */
var tabsetTarget = document.getElementById('", tabsetId, "');
/* Creating 6-digit tab ID and check, whether it was already assigned. */
hrefCode = Math.floor(Math.random()*100000);
/* Creating node in the navigation bar */
var navNode = document.createElement('li');
var linkNode = document.createElement('a');
linkNode.appendChild(document.createTextNode('", title, "'));
linkNode.setAttribute('data-toggle', 'tab');
linkNode.setAttribute('data-value', '", title, "');
linkNode.setAttribute('href', '#tab-' + hrefCode);
navNode.appendChild(linkNode);
tabsetTarget.appendChild(navNode);
setTimeout(function(){
var tabContent = document.createElement('div');
var tabContainerTarget = document.getElementsByClassName('tab-content')[0];
tabContent.setAttribute('id', 'tab-' + hrefCode);
tabContent.setAttribute('class', 'tab-pane')
tabContent.innerHTML = '", gsub('\n', '', Panel, fixed = T), "';
tabContainerTarget.appendChild(tabContent);
}, 100);
")
))
}
```
The code above should stay in a 'setup chunk', as it define an R function to call a JS function that mostly just add the right things to the DOM.
It can then be used when needed, passing the tabPanel title, the 'target' tabset and the normal tabPanel function.
```{r results='asis', echo=FALSE}
shiny::tabsetPanel(id = 'tbSet1',
shiny::tabPanel('Tab 1', 'foo'),
shiny::tabPanel('Tab 2', 'bar')
)
```
```{r results='asis', echo=FALSE}
addToTabset(title = 'Tab 3',
tabsetId = 'tbSet1',
tabPanel(
h1('This is a title'),
actionButton('btn',label = 'Clicky button'),
radioButtons('asd', LETTERS[1:5], LETTERS[1:5])) )
```
This also appears to be a good way to also deal with the problem of dynamic tabsets with plotly graphics at https://github.com/ropensci/plotly/issues/273
I created the plots first and saved them in a list which I then extract and display with a simple code in the template variable below. This saves me from having to enclose the large code in quotes in the template file.
However, if I try this trick a second time in the same document, it complains with a "duplicate chunk label "unnamed-chunk-1"... error and will not compile.
This appears to be "fixable" by specifying options(knitr.duplicate.label = "allow") but are there any "consequences" to allowing duplicate labels that I need to be aware of? I read https://bookdown.org/yihui/rmarkdown-cookbook/duplicate-label.html and I think I'm ok but is there a better way than allowing duplicate chunk labels?
---
title: "Tabsets for plotly graphs"
output:
html_document:
number_sections: yes
toc: yes
toc_depth: 4
---
## Tabbed Set 1 {.tabset}
```{r}
options(knitr.duplicate.label = "allow")
library(plotly)
plotlist <- plyr::dlply(iris, "Species", function(iris.part){
plot_ly(data=iris.part, x = ~Sepal.Length, y = ~Sepal.Width)
})
template <- c(
"### First {{nm}}\n",
"```{r, echo = FALSE}\n",
"plotlist[[{{nm}}]] \n",
"```\n",
"\n"
)
plots <- lapply(1:length(plotlist), function(nm) {knitr::knit_expand(text = template)})
```
`r knitr::knit(text = unlist(plots))`
## Tabbed set 2 {.tabset}
```{r}
library(plotly)
template <- c(
"### Second {{nm}}\n",
"```{r, echo = FALSE}\n",
"plotlist[[{{nm}}]] \n",
"```\n",
"\n"
)
plots <- lapply(1:length(plotlist), function(nm) {knitr::knit_expand(text = template)})
```
`r knitr::knit(text = unlist(plots))`

Resources