How to suppress downloading progress in HTML file - r

I am using imfr package to download some IMF data series
library(imfr)
t <- imf_data(database_id = "BOP", indicator = "BCA_BP6_USD",
country = "all", start = "1990", freq = "Q")
I prespecified certain parameters in a separate chunk before to suppress downloading progress
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, error = FALSE, results = 'hide', fig.keep = 'all')
However, neither of these options did the job. Moreover results = 'hide' suppressed all the output including text and figures.
How can I solve this issue without having a separate chunk for data downloading?

You can capture all those downloads message and progress bar in capture.output and wrap it with invisible. (Got this idea from this question and answer on SO).
And then make a wrapper function imf_data which works the same (mask the imfr::imf_data function) but does not print all those download messages and the progress bar.
---
title: "IMF Data"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)
imf_data <- function(...) {
invisible(capture.output(dt <- imfr::imf_data(...)))
return(dt)
}
```
```{r}
library(imfr)
t <- imf_data(database_id = "BOP", indicator = "BCA_BP6_USD",
country = "all", start = "1990", freq = "Q")
```
```{r, comment=""}
head(t)
```

Related

Programmatically create a question_text with multiple answers in r learnr:tutorial

I have the following code with 4 correct answers. I want the students to input all 4 of them. Instead of defining 24 permutations of the answers, I want 4 field boxes that would only accept an answer once.
question_text(
"Input all paths:",
answer("ABEF", correct = TRUE),
answer("ABCDG", correct = TRUE),
answer("ABCDEF",correct = TRUE),
answer("ABDEF", correct = TRUE),
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
EDIT
I tried this approach but I do not think I can set the answer as anything other than a single text:
library(gtools)
pat <- permutations(4, 4, c("ABEF","ABCDG","ABCDEF","ABDEF"))
question_text(
"Input all possible rupture paths:",
answer(pat, correct = TRUE),
allow_retry = TRUE,
trim = TRUE
)
Even if I set pat <- c("ABEF","ABCDG","ABCDEF","ABDEF") it does not run successfully. How can define multiple answers at the same time without writing them out.
I'm not sure about your desired output - however, please check the following.
Referring to:
How can define multiple answers at the same time without writing them
out.
You can use lapply to create the answers and do.call to pass the different arguments to question_text:
library(learnr)
do.call(question_text, c(
list("Input all paths:"),
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
list(
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
))
as *.Rmd file:
---
title: "Tutorial"
output: learnr::tutorial
runtime: shiny_prerendered
---
```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = FALSE)
```
```{r two-plus-two, exercise=FALSE}
do.call(question_text, c(
list("Input all paths:"),
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
list(
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
))
```
Regarding:
I want 4 field boxes that would only accept an answer once
Edit: Added an event handler to access to the answers provided by the user.
---
title: "Tutorial"
output: learnr::tutorial
runtime: shiny_prerendered
---
```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = FALSE)
questions <-
mapply(
FUN = question_text,
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
text = paste("Question", 1:4),
incorrect = paste("Incorrect", 1:4),
MoreArgs = list(allow_retry = TRUE,
trim = TRUE),
SIMPLIFY = FALSE
)
```
```{r q1, echo = FALSE}
do.call(quiz, c(list(caption = "Quiz 1"), questions))
```
```{r context="server-start"}
event_register_handler("question_submission", function(session, event, data) {
# names(data):
# "label" "question" "answer" "correct"
message("event: question_submission: ", data$answer)
})
```

Retrieve and execute example code from an R package function as a codeblock in R-markdown

I want to extract the example code from an R package and run it in an rmarkdown file automatically.
I am able to extract the code using the function utils::example as follows.
example("geom_histogram", package = "ggplot2", ask = F,
prompt.prefix = "", give.lines = TRUE)[-(1:5)]
I have tried to use chunk options results="asis" as follows, but the result is given as code output rather than code chunk.
```{r,echo = FALSE, results="asis"}
cat("```{r}")
library(ggplot2)
cat(paste(example("geom_histogram", package = "ggplot2", ask = F,
prompt.prefix = "", give.lines = TRUE)[-(1:5)], collapse = "\n"))
cat("```")
```
I would like to have the code as a code block and the output from the same as in http://ggplot2.tidyverse.org/reference/geom_histogram.html. How to achieve this?
Updated answer:
You can create a function to extract code and use it as a code argument in chunk option.
# Function saved in functions.R file
getCode <- function(myFunction, myPackage) {
example(myFunction, myPackage, ask = FALSE, character.only = TRUE,
prompt.prefix = "", give.lines = TRUE)[-(1:5)]
}
Your Rmd (myFile.Rmd) should look like this:
```{r, meta, include = FALSE}
myPackage <- "ggplot2"
myFunction <- "geom_histogram"
source("functions.R")
```
```{r, intro, echo = FALSE, results = "asis"}
cat("#", myPackage, "\n")
cat("##", myFunction, "\n")
library(myPackage, character.only = TRUE)
```
```{r, runCode, code = getCode(myFunction, myPackage)}
```
Knit Rmd with: knitr::knit2html("myFile.Rmd") for a result like this:
Previous answer:
Write extracted code to a dummy file (foo.R) and use it as a code argument in chunk option.
Example file (myFile.Rmd):
First chunk: loads tested library
Second chunk: extracts example and saves it to a file
Third chunk: runs extracted code
```{r, meta, include = FALSE}
library(ggplot2)
```
```{r, getCode, include = FALSE}
code <- example("geom_histogram", package = "ggplot2", ask = FALSE,
prompt.prefix = "", give.lines = TRUE)[-(1:5)]
write.table(code, "foo.R", quote = FALSE, row.names = FALSE, col.names = FALSE)
```
```{r, runCode, code = readLines("foo.R")}
```
knit file with knitr::knit2html("myFile.Rmd") for a result like this:
We can also remove hard-coded variables to have a more flexible output:
```{r, meta, include = FALSE}
myPackage <- "ggplot2"
myFunction <- "geom_histogram"
library(myPackage, character.only = TRUE)
```
```{r, getCode, include = FALSE}
code <- example(myFunction, myPackage, ask = FALSE, character.only = TRUE,
prompt.prefix = "", give.lines = TRUE)[-(1:5)]
write.table(code, "foo.R", quote = FALSE, row.names = FALSE, col.names = FALSE)
```
```{r, intro, echo = FALSE, results = "asis"}
cat("#", myPackage, "\n")
cat("##", myFunction, "\n")
```
```{r, runCode, code = readLines("foo.R")}
```

rmarkdown resize plot inside of code chunk

I have an rmarkdownfile with a chunck that has a loop that creates many pages. Below is a toy example. See the "loop_chunk" code chunk. The "loop_chunk" has fig.width=9, fig.height=6, results="asis" and I am running into a problem where i need to reduce the size of a plot inside loop_chunk. All plots are 9x6 but I need to adjust one plot. I found the codee below: http://michaeljw.com/blog/post/subchunkify/
and I tried using it below but when you run the code you can see that there are 2 plots on pages 3 and 5 and there should not be. it is somehow not keeping the \newpages. There should be 1 plot on pages 2,3,4 and 5. There should only be 5 pages.
Any idea how to fix this?
---
title: "Untitled"
output: pdf_document
toc: yes
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE , comment = NA, message= FALSE, warning = TRUE)
subchunkify <- function(g, fig_height=7, fig_width=5) {
g_deparsed <- paste0(deparse(
function() {g}
), collapse = '')
sub_chunk <- paste0("
`","``{r sub_chunk_", floor(runif(1) * 10000), ", fig.height=", fig_height, ", fig.width=", fig_width, ", echo=FALSE}",
"\n(",
g_deparsed
, ")()",
"\n`","``
")
cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
}
data = data.frame(group= c("A","A"), value = c(1,3))
```
```{r loop_chunk, fig.width=9, fig.height=6, results="asis", message= FALSE, warning = FALSE}
for(i in 1:nrow(data)){
cat(paste0("\\newpage\n # Page ", i ," \n"))
plot(data$value[i])
cat("\n\n")
cat(paste0("\\newpage\n ## page with smaller plot \n\n"))
cat("Here is some text on this page for the smaller plot.")
cat("\n\n")
data2 = data.frame(x = 7, y = 900)
library(ggplot2)
myplot = ggplot(data2, aes(x = x, y = y ))+geom_point()
subchunkify(myplot , 4,4 )
# print(myplot) -> IS there a way to just reduce the height and width with print()?
cat("\n\n")
}
```
Using your subchunkify() function for the graphics::plot call outputs those plots to the intended pages. Replacing plot(data$value[i]) in your second chunk with
subchunkify(plot(data$value[i]), 5, 5)
outputs the 5 pages with plots as intended (where height & width are set to 5/can be edited to conditionally set dimensions for a specific plot).

Suppress alt text for GIFs in rmarkdown HTML output

I'm generating GIFs using the gganimate package within an RMarkdown file. When using output = github_document in the front matter, the GIF appears as expected in the output (github-document-output). However, when using output = html_document, the GIF generates with alt text, which defaults to the chunk name (html-document-output).
Is there a way to suppress this automatic caption? I've tried setting my own caption using the fig.cap chunk option, but that was unsuccessful.
RMarkdown code
---
output:
html_document: default
github_document: default
---
```{r}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "output/test-fig-",
cache.path = "output/test-cache-"
)
```
```{r cache = FALSE}
library(knitr)
library(animation)
ani.options(autobrowse = FALSE, interval = 1)
opts_knit$set(animation.fun = function(x, options, format = "gif") {
x = c(knitr:::sans_ext(x), knitr:::file_ext(x))
fig.num = options$fig.num
format = sub("^[.]", "", format)
fig.fname = paste0(sub(paste0(fig.num, "$"), "*", x[1]),
".", x[2])
mov.fname = paste0(sub(paste0(fig.num, "$"), "", x[1]), ".",
format)
# order correctly
figs <- Sys.glob(fig.fname)
figs <- figs[order(as.numeric(stringr::str_match(figs, paste0("(\\d+)\\.", x[2]))[, 2]))]
animation::im.convert(figs, output = mov.fname)
sprintf("![%s](%s)", options$label, paste0(opts_knit$get("base.url"), mov.fname))
})
opts_chunk$set(cache = TRUE, message = FALSE, warning = FALSE, fig.show = "animate")
```
```{r pkgs, cache = FALSE}
library(gapminder)
library(ggplot2)
theme_set(theme_bw())
```
```{r setup}
p <- ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, color = continent, frame = year)) +
geom_point() +
scale_x_log10()
```
```{r dependson = "setup"}
library(gganimate)
gg_animate(p)
```
The problem here is that you include the resulting animation with markdown syntax. This introduces some iiritations I guess.
Taking a look at hook_plot_html we can simulate the default output for standard plots:
sprintf(paste0('<div class="figure %s">',
'<img src="%s">',
'<p class="caption">%s</p>',
'</div>'), options$fig.align, mov.fname, options$fig.cap)

Display two rCharts NVD3 figures next to each other in rmarkdown

I want to display two charts with the rCharts package, one next to the other, more or less like the two pies are displayed in this link:
http://nvd3.org/examples/pie.html
I have a partial solution using <iframe>, but the solution has three problems:
It is too case specific
Including controls becomes a complicated task
It does not look too nice
Minimum working example:
---
title: "Example"
output: html_document
---
```{r rcht, message=FALSE, echo=FALSE, results='asis'}
library(rCharts)
df<-data.frame(label=c("One","Two","Three"),valuea=c(1,2,3),othera=c(10,11,12),
valueb=c(4,5,6),otherb=c(10,11,12),stringsAsFactors = FALSE)
p1 <- nPlot(valuea~ label, data = df, type = 'pieChart',height = 225, width = 300)
p2<- nPlot(valueb~ label, data = df, type = 'pieChart',height = 225, width = 300)
p1$show('inline', include_assets = TRUE, cdn = F)
p2$show('inline', include_assets = TRUE, cdn = F)
```
```{r message=FALSE, echo=FALSE}
p1$save("pie1.html", standalone = TRUE)
p2$save("pie2.html", standalone = TRUE)
```
<div align="center">
<font size="10" color="black" face="sans-serif">Both Pies</font><br>
<p>
<iframe src="pie1.html" height="400" width="400"></iframe>
<iframe src="pie2.html" height="400" width="400"></iframe>
</p>
<div>
I know pie charts should not be used and that I could use a multi-bar chart. However, I want to use this type of layout with other kinds of charts in the rCharts package.
Additionally, I would like to include controls in the charts whilst they are shown next to each other. Including the following code before the $save() function adds the controls:
```{r message=FALSE, echo=FALSE}
p1$addControls('y','valuea',values=c('valuea','othera'))
p2$addControls('y','valueb',values=c('valueb','otherb'))
```
This issue is less relevant to me, but if someone has a solution (preferably with only one control for both charts), it would be great.
I understand all this might be too much to handle from R. Any help/advice is appreciated.
Not elegant, but functional (I did not try it with controls):
---
title: "Example"
output: html_document
---
```{r rcht, message=FALSE, echo=FALSE, results='asis'}
library(rCharts)
library(htmltools)
df <- data.frame(label=c("One","Two","Three"),valuea=c(1,2,3),othera=c(10,11,12),
valueb=c(4,5,6),otherb=c(10,11,12),stringsAsFactors = FALSE)
p1 <- nPlot(valuea~ label, data = df, type = 'pieChart',height = 225, width = 300)
p2 <- nPlot(valueb~ label, data = df, type = 'pieChart',height = 225, width = 300)
```
```{r echo=FALSE, results="asis"}
cat("<table width='100%'><tr style='width:100%'><td width='50%'>")
```
```{r echo=FALSE, results="asis"}
p1$show('inline', include_assets = TRUE, cdn = FALSE)
```
```{r echo=FALSE, results="asis"}
cat("</td><td>")
```
```{r echo=FALSE, results="asis"}
p2$show('inline', include_assets = TRUE, cdn = FALSE)
```
```{r echo=FALSE, results="asis"}
cat("</td></tr></table>")
```
Hi I am having the same problem with controls it looks that in the viewer of R-studio everything works fine but not when I compile with Rmarkdown it doesn't show the plot at all.
```{r results = 'asis', comment = NA}
require(rCharts)
require(datasets)
p2 <- nPlot(mpg ~ cyl, group = 'wt',
data = mtcars, type = 'scatterChart')
p2$xAxis(axisLabel = 'Log2')
p2$yAxis(axisLabel = 'Log2')
p2$chart(tooltipContent = "#! function(key, x, y, e){
return '<b>Name:</b> ' + e.point.GeneID
} !#")
p2$chart(color = c('red', 'green'))
p2$addControls("x", value = 'mpg', values = names(mtcars))
p2$addControls("y", value = 'cyl', values = names(mtcars))
cat('<style>.nvd3{height: 400px;}</style>')
p2$print('chart2', include_assets = TRUE)
```
The code above is the addControls are removed actually works also in the rmarkdown.
Also, if you try to run the code above in Rstudio console (just from p2<-nPlot to cat command) and then calling p2 I can actually see the controls.

Resources