Set number of attempts for learnr:tutorial question before moving on to the next question?

Question

I am creating a homework problem with learnr:tutorial. I want to give the students 3 attempts to solve the problem before moving to the next section. I have progressive: true and allow_skip: false But at the moment, there is unlimited try again and even with the incorrect answer, the user can continue to the next question. An example of a question is:

### Part (a)

```{r part-a, echo=FALSE}

question_text(
  "Input all possible rupture paths:",
    answer("ABEF", correct = TRUE),
    answer("ABCDG", correct = TRUE),
    answer("ABCDEF",correct = TRUE),
    answer("ABDEF", correct = TRUE),
  allow_retry = TRUE,
  trim = TRUE
)
```
<br><br><br><br>
---

### Part (b)

```{r part-b1, echo=FALSE}

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 = TRUE,
  trim = TRUE
)
```

EDIT

I came across the conditional printing of the code chunks with

```{r setup, echo=FALSE}
show_text <- FALSE
````

```{r conditional_block, eval=show_text}
print("this will only print when show.text is TRUE")
```

I was wondering if there is a way to set show_text = TRUE if the feedback from the quiz question is correct so that the next section shows up.

Answer 1

As pointed out in comments, the option you're looking for isn't implemented in the package.
This will perhaps be the case in up coming versions if your request is accepted.

In the mean time, if you're ready to rebuild the package, modification to fulfill the n attempts question is quite straight forward :

1. download learnr-master and unpack it in a directory

2. Open learnr.Rproj under RStudio

3. Open R/quizz.R, find shiny module : question_module_server_impl and replace it by code below.

4. Build / Install & Restart

5. You can now set number of retry in allow_retry argument:

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
)

The idea is to use existing allow_retry argument either with boolean as before or with an integer giving the number of trials, and in this case to compare it to a reactive counter.

==================================================

Updated version of question_module_server_impl
Modifications highlighted in the code by # new === or # 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
      )
    )

  })
}