正如评论中指出的那样，您正在寻找的选项未在包中实现。
如果您的请求被接受，未来的版本中可能会出现这种情况。
同时，如果您准备好重建包，修改以完成 n 次尝试问题是非常简单的：
下载 learnr-master并解压到一个目录
在 RStudio 下打开 learnr.Rproj
打开R/quizz.R，找到闪亮的模块：question_module_server_impl并用下面的代码替换它。
构建/安装和重启
您现在可以在 allow_retry 参数中设置重试次数：
question_text(
"Enter the deduced length due to the bolts for the ABEF rupture path:",
answer("1.625", correct = TRUE),
answer("1.6", correct = TRUE),
answer("2(13/16)",correct = TRUE),
incorrect = "Direction from top to bottom of the plate",
allow_retry = 2,
trim = TRUE
)
这个想法是使用现有的allow_retry参数，或者像以前一样使用布尔值，或者使用给出试验次数的整数，在这种情况下，将其与反应计数器进行比较。
====================================================
question_module_server_impl
代码中通过# new ===或突出显示的修改的更新版本# update ===：
question_module_server_impl <- function(
input, output, session,
question
) {
ns <- getDefaultReactiveDomain()$ns
# new ============================
# set counter
val <- reactiveValues(
numtry = 0
)
# ================================
# set a seed for each user session for question methods to use
question$seed <- random_seed()
# only set when a submit button has been pressed
# (or reset when try again is hit)
# (or set when restoring)
submitted_answer <- reactiveVal(NULL, label = "submitted_answer")
is_correct_info <- reactive(label = "is_correct_info", {
# question has not been submitted
if (is.null(submitted_answer())) return(NULL)
# find out if answer is right
ret <- question_is_correct(question, submitted_answer())
# new : Increment counter =======
isolate(val$numtry <- val$numtry+1)
# ===============================
if (!inherits(ret, "learnr_mark_as")) {
stop("`question_is_correct(question, input$answer)` must return a result from `correct`, `incorrect`, or `mark_as`")
}
ret
})
# should present all messages?
is_done <- reactive(label = "is_done", {
if (is.null(is_correct_info())) return(NULL)
# updated ====================================================
(!isTRUE(question$allow_retry>0)) || is_correct_info()$correct
# ============================================================
})
button_type <- reactive(label = "button type", {
if (is.null(submitted_answer())) {
"submit"
} else {
# is_correct_info() should be valid
if (is.null(is_correct_info())) {
stop("`is_correct_info()` is `NULL` in a place it shouldn't be")
}
# update the submit button label
if (is_correct_info()$correct) {
"correct"
} else {
# not correct
# updated =====================================
if (isTRUE(val$numtry<question$allow_retry)|(question$allow_retry&is.logical(question$allow_retry))) {
# not correct, but may try again
"try_again"
} else {
# not correct and can not try again
"incorrect"
}
}
}
})
# disable / enable for every input$answer change
answer_is_valid <- reactive(label = "answer_is_valid", {
if (is.null(submitted_answer())) {
question_is_valid(question, input$answer)
} else {
question_is_valid(question, submitted_answer())
}
})
init_question <- function(restoreValue = NULL) {
if (question$random_answer_order) {
question$answers <<- shuffle(question$answers)
}
submitted_answer(restoreValue)
}
# restore past submission
# If no prior submission, it returns NULL
past_submission_answer <- retrieve_question_submission_answer(session, question$label)
# initialize like normal... nothing has been submitted
# or
# initialize with the past answer
# this should cascade throughout the app to display correct answers and final outputs
init_question(past_submission_answer)
output$action_button_container <- renderUI({
question_button_label(
question,
button_type(),
answer_is_valid()
)
})
output$message_container <- renderUI({
req(!is.null(is_correct_info()), !is.null(is_done()))
withLearnrMathJax(
question_messages(
question,
messages = is_correct_info()$messages,
is_correct = is_correct_info()$correct,
is_done = is_done()
)
)
})
output$answer_container <- renderUI({
if (is.null(submitted_answer())) {
# has not submitted, show regular answers
return(
# if there is an existing input$answer, display it.
# if there is no answer... init with NULL
# Do not re-render the UI for every input$answer change
withLearnrMathJax(
question_ui_initialize(question, isolate(input$answer))
)
)
}
# has submitted
if (is.null(is_done())) {
# has not initialized
return(NULL)
}
if (is_done()) {
# if the question is 'done', display the final input ui and disable everything
return(
withLearnrMathJax(
question_ui_completed(question, submitted_answer())
)
)
}
# if the question is NOT 'done', disable the current UI
# until it is reset with the try again button
return(
withLearnrMathJax(
question_ui_try_again(question, submitted_answer())
)
)
})
observeEvent(input$action_button, {
if (button_type() == "try_again") {
# maintain current submission / do not randomize answer order
# only reset the submitted answers
# does NOT reset input$answer
submitted_answer(NULL)
# submit "reset" to server
event_trigger(
session,
"reset_question_submission",
data = list(
label = as.character(question$label),
question = as.character(question$question)
)
)
return()
}
submitted_answer(input$answer)
# submit question to server
event_trigger(
session = session,
event = "question_submission",
data = list(
label = as.character(question$label),
question = as.character(question$question),
answer = as.character(input$answer),
correct = is_correct_info()$correct
)
)
})
}