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

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

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

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") 它也不会 运行 成功。如何在不写出来的情况下同时定义多个答案。

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

参考:

How can define multiple answers at the same time without writing them out.

您可以使用 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
  )
))
```

关于:

I want 4 field boxes that would only accept an answer once

编辑:添加了 event handler 以访问用户提供的答案。

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