r - 在 r learnr:tutorial 中以编程方式创建具有多个答案的 question_text

Question

我有以下代码和 4 个正确答案。我希望学生输入所有 4 个。我不想要定义 24 个答案排列，而是想要 4 个只接受一次答案的字段框。

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
)

编辑

我尝试了这种方法，但我认为我不能将答案设置为单个文本以外的任何内容：

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
)

即使我设置pat <- c("ABEF","ABCDG","ABCDEF","ABDEF")它也不会成功运行。如何在不写出的情况下同时定义多个答案。

Answer 1

我不确定您想要的输出 - 但是，请检查以下内容。

参考：

如何在不写出的情况下同时定义多个答案。

您可以使用lapply来创建答案并将do.call不同的参数传递给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
  )
))

---

作为 *.Rmd 文件：

---
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
  )
))
```

关于：

我想要 4 个只接受一次答案的字段框

编辑：添加了一个事件处理程序来访问用户提供的答案。

---
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)
})
```