Related
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)
})
```
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")}
```
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).
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)
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.