File size: 2,802 Bytes
9cee884 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | # Run spec: the question, the references and the inputs of one run.
#
# A question is list(type, instructions, answers). The type is "noul",
# "choice" or "score". The names of answers are the answer names. The values
# are the descriptions ("" for none). For noul the names are "true" and "false".
#
# A spec is list(mode, question, references, inputs, source, name). The inputs
# are a tibble with id, path, text, file and label.
# The smallest and the largest number of answers of a type. Yes / no has the
# two fixed answers true and false.
answer_range <- function(type) ANSWER_RANGE[[type]] %||% c(2, 2)
# Problems of a question, as a character vector (empty when it is valid)
check_question <- function(question) {
answers <- question$answers
problems <- character()
if (question$type %in% names(ANSWER_RANGE)) {
range <- ANSWER_RANGE[[question$type]]
if (length(answers) < range[1] || length(answers) > range[2]) {
problems <- c(problems, stringr::str_glue(
"A {question$type} question needs {range[1]} to {range[2]} answers."
))
}
}
if (nchar(question$instructions) > MAX_INSTRUCTIONS) {
problems <- c(problems, stringr::str_glue(
"The instructions can have {MAX_INSTRUCTIONS} characters at most."
))
}
if (any(nchar(answers) > MAX_DESCRIPTION)) {
problems <- c(problems, stringr::str_glue(
"A description can have {MAX_DESCRIPTION} characters at most."
))
}
keys <- stringr::str_to_lower(stringr::str_squish(names(answers)))
if (anyDuplicated(keys) > 0 || any(keys == "")) {
problems <- c(problems, "The answer names must be unique and not empty.")
}
as.character(problems)
}
# The question of the decisions package that decide() needs
as_decisions_question <- function(question) {
answers <- as.list(question$answers)
switch(question$type,
noul = decisions::question_noul(
question$instructions,
true = if (nzchar(answers$true)) answers$true,
false = if (nzchar(answers$false)) answers$false
),
choice = decisions::question_choice(question$instructions, unlist(answers)),
score = decisions::question_score(question$instructions, unlist(answers))
)
}
# The answer that counts as the target of the metrics
target_answer <- function(question, pick = NULL) {
answers <- names(question$answers)
if (question$type == "noul") {
"true"
} else if (!is.null(pick) && pick %in% answers) {
pick
} else {
dplyr::last(answers)
}
}
# One hash for what decides the answers, so that a saved run can be matched
spec_fingerprint <- function(spec) {
rlang::hash(list(
spec$mode, spec$question$type, spec$question$instructions,
spec$question$answers, MODEL,
purrr::map(spec$references, \(paths) list(basename(paths), file.size(paths)))
))
}
|