R/olat_eval.R

In c403: Exam Tools for Department of Statistics (c403), Uni Innsbruck

#' Evaluate OLAT Exams
#'
#' Evaluate OLAT exams produced with \code{\link[c403]{exams2olat}},
#' and carried out and exported in (Open)OLAT.
#'
#' @param file character. Base file name of RDS and XLS file with
#'        exam generated by \code{\link[c403]{exams2olat}} and exported
#'        OLAT results, respectively.
#' @param plot logical. Should barplots with the aggregated
#'        results be displayed on the screen?
#' @param export logical. Should detailed questions along with
#'        individual results be exported to HTML files in a ZIP archive
#'        for convenient import into OLAT?
#'
#' @details \code{olat_eval} is a companion function for \code{\link[c403]{exams2olat}}.
#' It evaluates the exams carried out in OLAT for further processing outside
#' of OLAT (in CSV format) and optionally exports detailed individual HTML
#' reports (in a ZIP archive) for reimport into OLAT.
#'
#' @return A \code{data.frame} with the detailed exam results is returned invisibly.
#' It is also written to a CSV file in the current directory, along with a ZIP
#' file containing the HTML reports (for upload into OLAT).
#'
#' @importFrom graphics barplot par
#' @importFrom grDevices hcl
#' @importFrom stats median na.omit
#' @importFrom tools file_path_sans_ext
#' @import utils
#' @seealso \code{\link[c403]{exams2olat}}
#' @keywords utilities, OLAT
#' @export
olat_eval <- function(file, plot = TRUE, export = FALSE) {

  ## file basename
  file <- file_path_sans_ext(file)

  ## read/parse data
  exm <- readRDS(paste(file, "rds", sep = "."))
  res <- paste(file, c("xls", "xlsx"), sep = ".")
  res <- res[file.exists(res)]
  res <- read_olat_results(res, exm)

  n   <- length(exm)
  k   <- length(exm[[1L]])

  ## omit duplicated students, keep only last result
  ## (assuming chronological ordering -> could also be enforced otherwise)
  if("registrationnumber" %in% names(res)) {
    res <- res[!duplicated(res$registrationnumber, fromLast = TRUE), ]
  } else {
    res <- res[!duplicated(res$username, fromLast = TRUE), ]  
  }

  ## write results to csv
  write.table(res, paste(file, "csv", sep = "."), sep = ";",
              row.names = FALSE, col.names = TRUE, quote = FALSE)
  
  ## visualize aggregate statistics
  if(plot) {
    ## plots
    par(mar = c(4, 6, 4, 1), mfrow = c(1, 2))

    ## exercise names (FIXME: somewhat uibkmath-specific!)
    nam0 <- sapply(exm[[1L]], function(obj) obj$metainfo$file)
    nam <- try(sapply(strsplit(nam0, "-", fixed = TRUE), "[[", 3L), silent = TRUE)
    nam <- if(inherits(nam, "try-error")) {
      nam0
    } else {
      sapply(strsplit(nam, "_", fixed = TRUE), "[[", 1L)
    }

    ## error proportion
    pts <- as.matrix(res[, paste("points", 1L:k, sep = ".")])
    pts[is.na(pts)] <- 0
    pmx <- sapply(exm[[1L]], function(obj) {
      p <- obj$metainfo$points
      if(is.null(p)) 1 else p
    })
    pts <- 1 - pts/pmx
    pts <- colMeans(pts, na.rm = TRUE)
    barplot(pts[k:1L], names = nam[k:1L], horiz = TRUE, las = 1, main = "Error proportion")

    ## median duration
    drt <- as.matrix(res[, paste("duration", 1L:k, sep = ".")])
    drt <- as.vector(apply(drt/3600, 2, median, na.rm = TRUE))
    barplot(drt[k:1L], names = nam[k:1L], horiz = TRUE, las = 1, main = "Median duration")
  }

  ## export HTML results for OLAT
  if(export) olat_eval_export(results = res, xexam = exm,
    file = paste0(file, "-eval.zip"), html = paste0(file, ".html"),
    col = hcl(c(1, 0, 60, 120), 70, 90))

  ## return overall results invisibly
  invisible(res)
}


#' Read OLAT Results from XLSX file
#'
#' Get OLAT test results (FIXME: eval support and cloze evaluation).
#' TODO: Write proper documentation.
#'
#' @param file name of the file ...
#' @param xexam ...
#' @return ...
#'
#' @importFrom tools file_ext
read_olat_results <- function(file, xexam = NULL) {

  ## checking
  stopifnot(file.exists(file <- path.expand(file)))

  ## read xexam (if any)
  if(!is.null(xexam)) {
    if(is.character(xexam)) xexam <- readRDS(xexam)
  }

  ## QTI 2.1 xlsx or QTI 1.2 xls?
  xlsx <- file_ext(file) == "xlsx"

  ## -------------------------------------------------
  ## Import results (xml file).
  ## Identify "blocks of question-relted information"
  ## which includes the information which answer was
  ## marked by the participants, duration, time started ...
  ## -------------------------------------------------
  if(xlsx) {
    ## Read first two rows. Used to identify columns with section scores.
    x_head <- openxlsx::read.xlsx(file, colNames = FALSE, rows = 1:2)
    ## Find columns where the first row contains a string of the format
    ## defined below (regular expression;
    ## (typically "Sektion \"<user text>\"" or "Section \"<user text>\"").
    ## We will later on (see read.xlsx) ignore these columns and only take
    ## the ones where x_take_cols is TRUE.
    x_take_cols <- !grepl("^[A-Z][a-z]+\\s\\\".*\\\"$", x_head[1, ])

    ## Read 'main' content of the file.
    x <- openxlsx::read.xlsx(file, startRow = 2L, cols = which(x_take_cols))

    rm(list = c("x_take_cols", "x_head"))

    ## modify names, translate everything.
    x <- olat_eval_adjust_lang(x)

    ## columns pertaining to items
    ## Only test results (not user information).
    ## Creates a vector with the indizes of all columns
    ## containing a "_C0"
    iid <- grep("_C0$", names(x))

    ## Repeat idd, creates a vector which (may) look as follows:
    ## c(16, 16, 16, 16, 16, 16, 22, 22, 22, 22, 22, ...) where
    ## each unique integer defines a block of columns for a specific
    ## question. Used later on to extract the quetions (block-wise,
    ## check object 'y').
    iid <- rep(iid, c(diff(iid), 1 + ncol(x) - max(iid)))
  } else {

    ## The old OLAT 1.2 exported a CSV file with the file extension xls. This
    ## is the way results have been imported before olat 2.1.

    ## read data
    x <- readLines(file, warn = FALSE)
    x <- read.table(file, header = TRUE, sep = "\t",
                    colClasses = "character", skip = 1, fill = TRUE,
                    nrows = min(which(x == "")) - 3, quote = "\"", na.strings = "\"\"")

                                                                                                                                      
    # Step 1: find all columns starting with X[0-9]+ as they
    # contain the information about the individual questions.
    col_idx <- grep("^X[0-9]+_", names(x))
    # Step 2: rest is meta information
    meta_idx <- (1:ncol(x))[-col_idx]
    # Step 3: extract question ID and rename
    # the columns (e.g., "X111_Pkt" to "Pkt.111")
    iid <- question_id <- as.integer(regmatches(names(x)[col_idx], regexpr("(?<=(^X))[0-9]+", names(x)[col_idx], perl = TRUE)))
    stopifnot(all(!is.na(question_id)))

    # Create new variable names
    new_name <- regmatches(names(x)[col_idx], regexpr("(?<=(\\_)).*$", names(x)[col_idx], perl = TRUE))
    new_name <- paste(gsub("\\.+s\\.$", "", new_name), question_id, sep = ".")
    names(x)[col_idx] <- new_name

    ## modify names, translate everything.
    x <- olat_eval_adjust_lang(x)
    stop("old olat csv/xls mode: fails later when trying to crate the ipmat as \"Start\" column missing.")
  }

  ## -------------------------------------------------
  ## Extracting user information
  ## -------------------------------------------------
  ## The data.frame 'x' contains the user meta information and the
  ## details about all the questions in the test (column-by-column).
  ## The following few lines extract the user meta info, will be added
  ## to the result further down in this function again.
  take <- c("registrationnumber", "firstname", "lastname", "username", "date",
            "time", "element_score", "element_passed")
  idx <- grep(sprintf("^(%s)$", paste(take, collapse = "|")), names(x), perl = TRUE)
  user_info <- x[, idx]

  ## Check if we have all expected columns. If not, proceed,
  ## but throw a warning!
  if (!all(take %in% names(user_info))) {
    warning(sprintf("not all columns found as expected! Missing variable(s): %s\n",
                    paste(take[!take %in% names(user_info)], collapse = ", ")))
  }

  ## -------------------------------------------------
  ## Element-wise evaluation.
  ## -------------------------------------------------
  ## Extracts/prepares the information of the individual questions.
  ## iid is an integer sequence which contains unique ID's
  ## where (in which columns) the individual questions/answers can
  ## be found. The following line evaluates question-by-question
  ## and stores it on y (list).
  y <- lapply(split(x = seq(min(iid), ncol(x)), f = iid), function(ind) x[, ind, drop = FALSE])

  ## Convert list 'y' into a matrix
  ipmat_fun <- function(d) {
      col <- grep("^Start$", names(d))
      stopifnot(length(col) == 1L)
      return(nchar(as.character(d[, col])) > 10L)
  }
  ipmat <- t(sapply(y, ipmat_fun))

  ## assume xexams object
  ## number of sections and items
  ix1 <- lapply(1:ncol(ipmat), function(i) which(ipmat[ , i, drop = TRUE]))
  ni <- max(sapply(ix1, length))      # Number of questions in the quiz
  ns <- length(unique(iid)) / ni      # Number of different (random) quizzes


  stopifnot(ns %% 1 == 0)             # Must be divisible by 1.

  ix2 <- lapply(ix1, function(i) {
    ix <- rep(NA, ni)
    ix[1L + (i - 1L) %/% ns] <- 1L + (i - 1L) %% ns
    ix
  })

  ## Convert datetime information to POSIXct
  toPOSIXct <- if(xlsx) {
    function(x) if(is.na(x) || x == "") NA else as.POSIXct(format(structure((x - 25567) * 24 * 3600, class = c("POSIXct", "POSIXt"))))
  } else {
    function(x) if(is.na(x) || x == "") NA else as.POSIXct(strptime(x, format = "%Y-%m-%dT%H:%M:%S"))
  }

  ## -------------------------------------------------
  ## compute results
  ## -------------------------------------------------
  process_item_result <- function(j)
  {
    rval <- lapply(1:length(ix2[[j]]), function(i) {
      id <- ix2[[j]][i]
      if(!is.na(id)) {

        # Pick data.frame to process
        ir <- y[[id + (i - 1) * ns]][j, ]

        # Find indizes. Depending on the original language of the
        # xlsx file from Olat the order might be different!
        col_idx <- list(duration = grep("^Duration", names(ir)),
                        start    = grep("^Start",    names(ir)),
                        comment  = grep("^Comment",  names(ir)),
                        score    = grep("^Score",    names(ir)))

        stopifnot(all(sapply(col_idx, length) == 1L))

        col_idx$ssol <- (1:ncol(ir))[-unlist(col_idx)]
        #stopifnot(!length(col_idx$ssol) == 2L)

        # Extracting points
        points <- as.numeric(ir[, col_idx$score])
        points <- if(is.na(points)) 0 else points

        # Extracting start and duration
        start <- ir[, col_idx$start]
        dur <- ir[, col_idx$duration]

        # Answer/Solution
        ssol <- ssol0 <- ir[, col_idx$ssol]

        if(NCOL(ssol) > 1L) {
          ssol <- ssol0 <- if(xlsx) {
            try(gsub("NA", "0", gsub("x", "1", paste(ssol, collapse = ""), fixed = TRUE), fixed = TRUE), silent = TRUE)
          } else {
            try(gsub(".", "0", paste(ssol[-length(ssol)], collapse = ""), fixed = TRUE), silent = TRUE)      
          }
        } else {
          ssol <- ssol0 <- try(gsub(",", ".", ssol, fixed = TRUE), silent = TRUE)
        }
        if(inherits(ssol, "try-error")) ssol <- ssol0 <- NA
        solx <- scheck <- NA

        # Find solution/tolerance/type/points from
        # question meta information
        if(!is.null(xexam) & !is.na(id)) {
          solx  <- xexam[[id]][[i]]$metainfo$solution  # exsolution e.g., 0010
          tolx  <- xexam[[id]][[i]]$metainfo$tolerance
          typex <- xexam[[id]][[i]]$metainfo$type[1L]
          ptsx  <- xexam[[id]][[i]]$metainfo$points
          if(is.null(ptsx)) ptsx <- 1
          if(typex %in% c("mchoice", "schoice")) {
            solx   <- exams::mchoice2string(solx)
            scheck <- as.numeric(points > 0) ## (ssol == solx) * ptsx
          } else if(typex == "num") {
            ssol   <- as.numeric(gsub(",", ".", ssol, fixed = TRUE))
            scheck <- as.numeric(points > 0) ## ((ssol >= solx - tolx) & (ssol <= solx + tolx)) * ptsx
          } else if(typex == "cloze") {
            stop("OLAT cloze reader not yet implemented")
          }
        }

        # Check that $ssol has the same length as the
        # solution string (solx; 0010 or similar).
        stopifnot(length(col_idx$ssol) == nchar(solx))

        if(is.na(scheck)) scheck <- 0
        res <- data.frame(id + (i - 1) * ns,
                          round(as.numeric(points), digits = 8),
                          scheck, ssol0, solx,
                          toPOSIXct(start),
                          as.numeric(dur),
                          stringsAsFactors = FALSE)
      } else {
        res <- data.frame(t(rep(NA, 7L)))
      }

      if(!xlsx) res[res == ""] <- NA
      names(res) <- paste(c("id", "points", "check", "answer", "solution", "start", "duration"), i, sep = ".")
      return(res)
    })
    return(data.frame(rval, stringsAsFactors = FALSE))
  }

  res <- lapply(1L:length(ix2), process_item_result)

  ## -------------------------------------------------
  ## Combine results
  ## -------------------------------------------------
  ## Combines the user meta information (user_info)
  ## and the detailed information of the different
  ## questions (res) as returned from porcess_item_results.
  res <- cbind(user_info, do.call(rbind, res))


  ## Some other stuff, convert datetime information,
  ## round scores, ...
  if(xlsx) {
    # Convert date into POSIXct
    if(any(grepl("^date$", names(res))))
        res[["date"]] <- toPOSIXct(res[["date"]])
    # Round points to 8 digits
    if(any(grepl("element_score", names(res))))
        res[["element_score"]] <- round(res[["element_score"]], digits = 8)
  } else {
    true_false <- apply(res, 2, function(x) {
      if(is.character(x)) {
        x == "true" || x == "false"
      } else FALSE
    })
    if(any(true_false)) {
      for(i in which(true_false)) {
        wh <- FALSE
        if(!any(grepl("false", res[[i]]))) {
          res[[i]] <- rep(TRUE, length(res[[i]]))
          wh <- TRUE
        }
        if(!any(grepl("true", res[[i]]))) {
          wh <- TRUE
          res[[i]] <- rep(FALSE, length(res[[i]]))
        }
        if(!wh) res[[i]] <- res[[i]] == "true"
      }
    }
  }


  ## Rename element_score and element_passed to "score" and "passed"
  ## for convenience. Why now? Before, the individual questions also
  ## have had a "Score" column, thus we do have to do it here.
  names(res) <- gsub("^element_score$",  "score", names(res))
  names(res) <- gsub("^element_passed$", "passed", names(res))

  ## And that's it!
  return(res)
}


#' Guess language of the OLAT results file
#'
#' Given a set of character vectors this function tries
#' to gess the language of the imported file. This allows to
#' evaluate exams from OpenOLAT in different languages.
#' Used by \code{\link[c403]{olat_eval}} to rename the columns
#' to make the evaluation independent from the language used when
#' exporting the results via OLAT.
#'
#' @param x character vector with column names
#' @return Returns the language name (\code{"en"}, \code{"de"}) if
#' the function is able to guess the language. Else the script will stop.
#'
#' @author Reto
olat_eval_guess_lang <- function(x) {
    stopifnot(inherits(x, "character"))

    # Check if language is English
    check_lang <- function(find, x, fn)
        return(fn(sapply(find, function(find, x) any(grepl(find, x)), x = x)))

    if (check_lang(c("^Score$"), x, all)) {
        lang <- "en"
    } else if (check_lang(c("^Punkte$", "^Laufnummer$"), x, any)) {
        lang <- "de"
    } else {
        print(x)
        check_lang(c("^Punkte$", "^Laufnummer$"), x)
        browser()
        stop("Not able to guess the language of the file. Stop")
    }
    return(lang)
}


#' Adjust language of variables/columns
#'
#' Modifies the names of the variables in the \code{dat.frame}
#' as read from the xlsx file (OpenOLAT). Converts the variable
#' names to English such that we do no longer have to care about
#' language in all other methods/functions.
#'
#' @param x \code{data.frame} read from the xlsx file
#'
#' @details Input 'x' is the data.frame as read from the xlsx file
#' which contains user meta information and the detailed information
#' about the individual questions of the test.
#' Problem: depending on the user language settings of OLAT the names
#' and order of the columns differs. This function takes input 'x' and
#' manipulates the variable or column names in a way that the rest
#' of the code (\code{\link{olat_eval}}) is not language dependent anymore.
#'
#' \itemize{
#'    \item{tries to guess the language by calling \code{\link{olat_eval_guess_lang}}}
#'    \item{loads the search-replace-data.frame (internally)}
#'    \item{search and replace variable names}
#'    \item{return input object \code{x} with new varaible names}
#' }
#'
#' Note: Even English to English will rename some of the variables.
#'
#' The function uses the data set \code{olat_eval_lang} which is shipped
#' with the package (see \code{data("olat_eval_lang")}).
#'
#' @return Returns the same \code{data.frame} (same dimension and data)
#' with adjusted names.
#'
#' @author Reto
olat_eval_adjust_lang <- function(x) {
    stopifnot(inherits(x, "data.frame"))
    # Guess current language
    lang <- olat_eval_guess_lang(names(x))

    # Load and subset the language search and replace
    # file, subset current language, replace names
    load(file.path(system.file(package = "c403"), "data", "olat_eval_lang.rda"))
    olat_eval_lang <- olat_eval_lang[olat_eval_lang$lang == lang, ]

    # Search and replace
    if (nrow(olat_eval_lang) > 0L) {
        for (i in 1:nrow(olat_eval_lang)) {
            names(x) <- gsub(olat_eval_lang$find[i],
                             olat_eval_lang$replace[i],
                             names(x), perl = TRUE)
        }
    }
    names(x) <- gsub("..s.", "", names(x), fixed = TRUE)
    names(x) <- gsub(".(s)", "", names(x), fixed = TRUE)

    # Return renamed data.frame 'x'
    return(x)
}


#' Olat eval export
#'
#' Takes the results from \code{\link[c403]{read_olat_results}} and the information
#' from the \code{rds} file with the individual questions/answers to generate a
#' zip archive file with individual test results (html file). This zip file
#' can be used to upload to OLAT.
#'
#' @param results data.frame,  results from \code{\link[c403]{read_olat_results}}
#' @param xexam list the object loaded from the rds file which contains the
#'        individual questions/answers. The length of the list corresponds to the
#'        number of randomized tests, each list element contains N elements (N =
#'        number of questions) with all the information required to generate the
#'        output.
#' @param file character, name of the zip flie, the final archive file where to
#'        store the exported html files
#' @param html character, name of the output files (html files)
#' @param col character vector of length \code{4L} with hex colors, default
#'        is \code{hcl(c(0, 0, 60, 120), c(70, 0, 70, 70), 90)}
#'
#' @importFrom exams string2mchoice
#' @return Return of the \code{zip()} call.
olat_eval_export <- function(results, xexam, file = "olat_eval.zip", html = "Testergebnisse.html",
  col = hcl(c(0, 0, 60, 120), c(70, 0, 70, 70), 90))
{

  ## Sanity check
  stopifnot(inherits(results, "data.frame"))
  stopifnot(inherits(xexam, "list"))

  ## Check if we have the required columns
  ## username: the c-number (unique student identifier)
  ## firstname/lastname: name of the participant
  ## registrationnumber: registration or matrikulation number
  ## score: points in the test (total)
  vars_req <- c("username", "firstname", "lastname", "registrationnumber", "score")
  stopifnot(all(vars_req %in% names(results)))

  ## results and exam
  if(is.character(results)) results <- read.csv2(results, colClasses = "character")
  if(is.character(xexam)) xexam <- readRDS(xexam)

  ## dimensions
  k <- length(grep("answer.", colnames(results), fixed = TRUE))
  n <- length(xexam)

  ## HTML template
  name <- gsub("\\/", "-", html)

  html <- paste(
  '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"',
  '"http://www.w3.org/TR/html4/strict.dtd">',
  sprintf('<meta http-equiv="content-type" content="text/html; charset=%s">', "UTF-8"),
  '<html>',
  '',
  '<head>',
  '<title>Testergebnisse</title>',
  '<style type="text/css">',
  'body{font-family:Arial;}',
  '</style>',
  '</head>',
  '',
  '<body>',
  '<h3>Testergebnisse</h3>',
  '<table>',
  '<tr>',
  '  <td>Name:</td><td>%s</td>',
  '</tr>',
  '<tr>',
  '  <td>Matrikelnummer:</td><td>%s</td>',
  '</tr>',
  '<tr>',
  '  <td>Punkte:</td><td>%s</td>',
  '</tr>',
  '</table>',
  '',
  '<h3>Auswertung</h3>',
  '<table border="1" bgcolor="#000000" cellspacing="1" cellpadding="5">',
  '<tr valign="top" bgcolor="#FFFFFF"><td align="right">Frage</td><td align="right">Punkte</td><td>Gegebene Antwort</td><td>Richtige Antwort</td></tr>',
  '%s',
  '</table>',
  '',
  '<h3>Aufgaben</h3>',
  '<ol>',
  '%s',
  '</ol>',
  '',
  '</body>',
  '</html>', sep = "\n")

  ## convenience functions
  format_mchoice1 <- function(mc) {
    if(is.na(mc) | mc == "") return("n/a")
    mc <- string2mchoice(mc)
    paste(ifelse(mc, letters[seq_along(mc)], "_"), collapse = "")
  }
  format_num1 <- function(x) {
    if(is.na(x) | x == "") return("n/a") else return(x)
  }

  
  ## directories
  odir <- getwd()
  dir <- tempfile()
  dir.create(dir)
  setwd(dir)
  on.exit(setwd(odir))

  ## process each participant
  for(i in 1:nrow(results)) {


    ## directory
    dir.create(file.path(dir, results$username[i]))

    ## collect results
    id <- as.numeric(results[i, paste("id", 1L:k, sep = ".")])
    id <- 1L + (id - 1L) %% n
    typ <- sapply(1L:k, function(j) xexam[[id[[j]]]][[j]]$metainfo$type)
    mch <- typ %in% c("schoice", "mchoice")
    pts <- as.numeric(results[i, paste("points", 1L:k, sep = ".")])
    chk <- as.numeric(results[i, paste("check", 1L:k, sep = ".")])
    ans <- as.character(results[i, paste("answer", 1L:k, sep = ".")])
    sol <- as.character(results[i, paste("solution", 1L:k, sep = ".")])    

    ## format individual answers
    if(any(mch)) {
      ans[mch] <- sapply(ans[mch], format_mchoice1)
      sol[mch] <- sapply(sol[mch], format_mchoice1)
    }
    if(any(typ == "num")) {
      sol[typ == "num"] <- sapply(sol[typ == "num"], format_num1)
    }
    pts[is.na(pts)] <- 0

    ## collect question block
    que <- sapply(1L:k, function(j) {
      exj <- xexam[[id[[j]]]][[j]]
      if(mch[j]) {
        paste0(paste(exj$question, collapse = "\n"),
      "<br/>\n<ol type=\"a\">\n",
      paste("<li>", exj$questionlist, "</li>", sep = "", collapse = "\n"),
      "</ol><br/>\n<b>Richtige Antwort:</b> ", sol[j], ".<br/>&nbsp;")
        
      } else {
        paste0(paste(exj$question, collapse = "\n"),
      "<br/>\n<b>Richtige Antwort:</b> ", sol[j], ".<br/>&nbsp;")
      }
    })
    que <- paste("<li><b>Frage:</b> ", que, "</li>", sep = "", collapse = "\n")

    ## collect results
    res <- paste(sprintf(
      '<tr valign="top" bgcolor="%s"><td align="right">%s</td><td align="right">%s</td><td>%s</td><td>%s</td></tr>',
      as.character(cut(chk, breaks = c(-Inf, -0.00001, 0.00001, 0.99999, Inf), labels = col)),
      1:k,
      pts,
      ans,
      sol
    ), collapse = "\n")
    
    html_i <- sprintf(html, paste(results$firstname[i], results$lastname[i]),
                      results$registrationnumber[i], as.numeric(results$score[i]),
                      res, que)
    writeLines(html_i, file.path(dir, results$username[i], name))
  }

  setwd(dir)
  invisible(zip(file.path(odir, file), results$username))

}