R/exams2testvision.R

In exams: Automatic Generation of Exams in R

## create TestVision .xml files which are based on IMS QTI 2.1
## specifications and examples available at:
## http://www.imsglobal.org/question/#version2.0
## https://www.ibm.com/developerworks/library/x-qti/
## https://www.onyx-editor.de/
## http://membervalidator.imsglobal.org/qti/
## https://webapps.ph.ed.ac.uk/qtiworks/anonymous/validator
## http://www.imsglobal.org/question/qtiv2p1/imsqti_implv2p1.html
## http://www.imsglobal.org/question/index.html#version2.0
exams2testvision <- function(file, n = 1L, nsamp = NULL, dir = ".",
  name = NULL, quiet = TRUE, edir = NULL, tdir = NULL, sdir = NULL, verbose = FALSE,
  resolution = 100, width = 4, height = 4, svg = FALSE, encoding  = "UTF-8",
  num = NULL, mchoice = NULL, schoice = mchoice, string = NULL, cloze = NULL,
  template = "testvision",
  stitle = "Exercise", ititle = "Question",
  adescription = "Please solve the following exercises.",
  sdescription = "Please answer the following question.",
  maxattempts = 1,  solutionswitch = TRUE,
  zip = TRUE, points = NULL,
  eval = list(partial = TRUE, negative = FALSE),
  converter = "pandoc", base64 = FALSE, mode = "hex", ...)
{
  ## default converter is "ttm" if all exercises are Rnw, otherwise "pandoc"
  if(is.null(converter)) {
    converter <- if(any(tolower(tools::file_ext(unlist(file))) == "rmd")) "pandoc" else "ttm"
  }
  ## set up .html transformer
  htmltransform <- if(converter %in% c("tth", "ttm")) {
    make_exercise_transform_html(converter = converter, ..., base64 = base64, mode = mode)
  } else {
    make_exercise_transform_html(converter = converter, ..., base64 = base64)
  }

  ## generate the exam
  is.xexam <- FALSE
  if(is.list(file)) {
    if(any(grepl("exam1", names(file))))
      is.xexam <- TRUE
  }
  if(!is.xexam) {
    exm <- xexams(file, n = n, nsamp = nsamp,
      driver = list(
        sweave = list(quiet = quiet, pdf = FALSE, png = !svg, svg = svg,
          resolution = resolution, width = width, height = height,
          encoding = encoding),
        read = NULL, transform = htmltransform, write = NULL),
      dir = dir, edir = edir, tdir = tdir, sdir = sdir, verbose = verbose)
  } else {
    exm <- file
    rm(file)
  }

  ## start .xml assessement creation
  ## get the possible item body functions and options
  itembody <- list(num = num, mchoice = mchoice, schoice = schoice, cloze = cloze, string = string)

  for(i in c("num", "mchoice", "schoice", "cloze", "string")) {
    if(is.null(itembody[[i]])) itembody[[i]] <- list()
    if(is.list(itembody[[i]])) {
      if(is.null(itembody[[i]]$eval))
        itembody[[i]]$eval <- eval
      if(i == "cloze" & is.null(itembody[[i]]$eval$rule))
        itembody[[i]]$eval$rule <- "none"
      itembody[[i]]$solutionswitch <- solutionswitch
      itembody[[i]] <- do.call("make_itembody_testvision", itembody[[i]])
    }
    if(!is.function(itembody[[i]])) stop(sprintf("wrong specification of %s", sQuote(i)))
  }

  ## create a temporary directory
  dir <- path.expand(dir)
  if(is.null(tdir)) {
    dir.create(tdir <- tempfile())
    on.exit(unlink(tdir))
  } else {
    tdir <- path.expand(tdir)
  }
  if(!file.exists(tdir)) dir.create(tdir)

  ## the package directory
  pkg_dir <- find.package("exams")

  ## get the .xml template
  template <- path.expand(template)
  template <- ifelse(
    tolower(substr(template, nchar(template) - 3L, nchar(template))) != ".xml",
    paste(template, ".xml", sep = ""), template)
  template <- ifelse(file.exists(template),
    template, file.path(pkg_dir, "xml", basename(template)))
  if(!all(file.exists(template))) {
    stop(paste("The following files cannot be found: ",
      paste(basename(template)[!file.exists(template)], collapse = ", "), ".", sep = ""))
  }
  xml <- readLines(template[1L])

  ## check template for all necessary tags
  ## extract the template for the assessement, sections and items
#  if(length(start <- grep("<assessmentTest", xml, fixed = TRUE)) != 1L ||
#    length(end <- grep("</assessmentTest>", xml, fixed = TRUE)) != 1L) {
#    stop(paste("The XML template", template,
#      "must contain exactly one opening and closing <assessmentTest> tag!"))
#  }
#  assessment_xml <- xml[start:end]
#
#  if(length(start <- grep("<assessmentSection", xml, fixed = TRUE)) != 1L ||
#    length(end <- grep("</assessmentSection>", xml, fixed = TRUE)) != 1L) {
#    stop(paste("The XML template", template,
#      "must contain exactly one opening and closing <assessmentSection> tag!"))
#  }
#  section_xml <- xml[start:end]

  if(length(start <- grep("<imscp:manifest", xml, fixed = TRUE)) != 1L ||
    length(end <- grep("</imscp:manifest>", xml, fixed = TRUE)) != 1L) {
    stop(paste("The XML template", template,
      "must contain exactly one opening and closing <imscp:manifest> tag!"))
  }
  manifest_xml <- xml[(start - 1L):end]

  if(length(start <- grep("<imscp:resource ", xml, fixed = TRUE)) != 1L ||
    length(end <- grep("</imscp:resource>", xml, fixed = TRUE)) != 1L) {
    stop(paste("The XML template", template,
      "must contain exactly one opening and closing <imscp:resource> tag!"))
  }
  resource_xml <- xml[start:end]

  ## obtain the number of exams and questions
  nx <- length(exm)
  nq <- if(!is.xexam) length(exm[[1L]]) else length(exm)

  ## create a name
  if(is.null(name))
    name <- file_path_sans_ext(basename(template))
  name <- gsub("\\s", "_", name)
  name_base <- if(is_number1(name)) paste0("_", name) else name

  ## function for internal ids
  make_test_ids <- function(n, type = c("test", "section", "item"))
  {
    switch(type,
      "test" = paste(name_base, format(Sys.time(), "%Y%m%d%H%M"), sep = "_"),
      paste(type, formatC(1:n, flag = "0", width = nchar(n)), sep = "_")
    )
  }

  ## generate the test id
  test_id <- make_test_ids(type = "test")

  ## create section ids
  sec_ids <- paste(test_id, make_test_ids(nq, type = "section"), sep = "_")

  ## create section/item titles and section description
  if(is.null(stitle)) stitle <- ""
  stitle <- rep(stitle, length.out = nq)
  if(!is.null(ititle)) ititle <- rep(ititle, length.out = nq)
  if(is.null(adescription)) adescription <- ""
  if(is.null(sdescription) || identical(sdescription, FALSE)) sdescription <- ""
  sdescription <- rep(sdescription, length.out = nq)
  sdescription[sdescription != ""] <- sprintf(
    '<rubricBlock view="candidate"><p>%s</p></rubricBlock>',
    sdescription[sdescription != ""]
  )

  ## points setting
  if(!is.null(points))
    points <- rep(points, length.out = nq)

  ## create the directory where the test is stored
  dir.create(test_dir <- file.path(tdir, name))

  tvo_interactionType <- function(x, item = FALSE) {
    type <- switch(x,
      "mchoice" = "choiceInteraction",
      "schoice" = "choiceInteraction",
      "num" = "extendedTextinteraction",
      "cloze" = "div",
      "string" = "extendedTextinteraction"
    )
    type
  }

  ## cycle through all exams and questions
  ## similar questions are combined in a section,
  ## questions are then sampled from the sections




  items <- items_R <- NULL
  maxscore <- 0
  for(j in 1:nq) {
    ## first, create the section header
#    sec_xml <- c(sec_xml, gsub("##SectionId##", sec_ids[j], section_xml, fixed = TRUE))
#
#    ## insert a section title -> exm[[1]][[j]]$metainfo$name?
#    sec_xml <- gsub("##SectionTitle##", stitle[j], sec_xml, fixed = TRUE)
#
#    ## insert a section description -> exm[[1]][[j]]$metainfo$description?
#    sec_xml <- gsub("##SectionDescription##", sdescription[j], sec_xml, fixed = TRUE)

    ## special handler
    if(is.xexam) nx <- length(exm[[j]])

    ## create item ids
    if(nx == 1)
      item_ids <- paste(test_id, "item", formatC(j, flag = "0", width = nchar(nq)), sep = "_") else
        item_ids <- paste(sec_ids[j], make_test_ids(nx, type = "item"), sep = "_")

    ## now, insert the questions
    for(i in 1:nx) {
      ## special handling of indices
      if(is.xexam) {
        if(i < 2)
          jk <- j
        j <- i
        i <- jk
      }

      ## overule points
      if(!is.null(points)) exm[[i]][[j]]$metainfo$points <- points[[j]]
      if(i < 2) {
        tpts <- if(is.null(exm[[i]][[j]]$metainfo$points)) 1 else exm[[i]][[j]]$metainfo$points
        maxscore <- maxscore + sum(tpts)
      }

      ## get and insert the item body
      type <- exm[[i]][[j]]$metainfo$type

      ## create an id
      iname <- paste(item_ids[if(is.xexam) j else i], type, sep = "_")

      ## attach item id to metainfo
      exm[[i]][[j]]$metainfo$id <- iname

      ## overrule item name
#      if(!is.null(ititle))
#        exm[[i]][[j]]$metainfo$name <- ititle[j]
      ititle <- exm[[i]][[j]]$metainfo$name

      ## switch for debugging
      if(FALSE) {
        exm[[i]][[j]]$question <- "Here is the questiontext..."
        exm[[i]][[j]]$solution <- "This is the solutiontext..."
        exm[[i]][[j]]$solutionlist <- NA
      }

      exm[[i]][[j]]$converter <- converter

      ibody <- fix_tvo_img(itembody[[type]](exm[[i]][[j]]))

      exm[[i]][[j]]$converter <- NULL

      ## copy supplements
      sec_items_R <- NULL
      if(length(exm[[i]][[j]]$supplements)) {
        if(!base64) {
          if(!file.exists(media_dir <- file.path(test_dir, "mediafiles")))
            dir.create(media_dir)
          sj <- 1
          while(file.exists(file.path(media_dir, sup_dir <- paste("supplements", sj, sep = "")))) {
            sj <- sj + 1
          }
          dir.create(ms_dir <- file.path(media_dir, sup_dir))
        }
        for(si in seq_along(exm[[i]][[j]]$supplements)) {
          f <- basename(exm[[i]][[j]]$supplements[si])
          if(base64) {
            replacement <- fileURI(exm[[i]][[j]]$supplements[si])

            if(any(grepl(dirname(exm[[i]][[j]]$supplements[si]), ibody))) {
              ibody <- gsub(dirname(exm[[i]][[j]]$supplements[si]),
                replacement, ibody, fixed = TRUE)
            } else {
              if(any(grepl(f, ibody))) {
                ibody <- gsub(paste(f, '"', sep = ''),
                  paste(replacement, '"', sep = ''), ibody, fixed = TRUE)
              }
            }
          } else {
            file.copy(exm[[i]][[j]]$supplements[si],
              file.path(ms_dir, f))

            fid <- gsub('\\', '', gsub('/', '_', file.path('mediafiles', sup_dir, f), fixed = TRUE), fixed = TRUE)
            fhref <- file.path('mediafiles', sup_dir, f)
            sec_items_R <- c(sec_items_R,
              paste('<imscp:file href="', fhref, '"/>', sep = '')
            )

            if(any(grepl(dirname(exm[[i]][[j]]$supplements[si]), ibody))) {
              ibody <- gsub(dirname(exm[[i]][[j]]$supplements[si]),
                file.path('mediafiles', sup_dir), ibody, fixed = TRUE)
            } else {
              if(any(grepl(f, ibody))) {
                ibody <- gsub(paste(f, '"', sep = ''),
                  paste('mediafiles/', sup_dir, '/', f, '"', sep = ''), ibody, fixed = TRUE)
              }
            }
          }
        }
      }

      ## write the item xml to file
      writeLines(c('<?xml version="1.0" encoding="utf-8" standalone="yes"?>', ibody),
        file.path(test_dir, paste(iname, "xml", sep = ".")))

      ## include resource
      sec_items_R <- c(paste('<imscp:file href="', iname,'.xml" />', sep=""), sec_items_R)

      res_xml <- resource_xml
      res_xml <- gsub('##ItemId##', iname, res_xml, fixed = TRUE)
      res_xml <- gsub('##ItemTitle##', paste(iname, ititle, sep ='_'), res_xml, fixed = TRUE)
      res_xml <- gsub('##QuestionType##', tvo_interactionType(type), res_xml, fixed = TRUE)
      res_xml <- gsub('##FileRefs##', paste(sec_items_R, collapse = '\n'), res_xml, fixed = TRUE)

      items_R <- c(items_R, res_xml)
    }
  }

  manifest_xml <- gsub('##AssessmentId##', test_id, manifest_xml, fixed = TRUE)
  manifest_xml <- gsub('##ManifestItemResources##', paste(items_R, collapse = '\n'), manifest_xml, fixed = TRUE)



  ## write xmls to dir
  writeLines(manifest_xml, file.path(test_dir, "imsmanifest.xml"))

  ## compress
  if(zip) {
    owd <- getwd()
    setwd(test_dir)
    zip(zipfile = zipname <- paste(name, "zip", sep = "."), files = list.files(test_dir))
    setwd(owd)
  } else zipname <- list.files(test_dir)

  ## copy the final .zip file
  file.copy(file.path(test_dir, zipname), dir, recursive = TRUE)

  ## assign test id as an attribute
  attr(exm, "test_id") <- test_id

  invisible(exm)
}



make_itembody_testvision <- function(shuffle = FALSE,
  defaultval = NULL, minvalue = NULL, maxvalue = NULL, enumerate = TRUE,
  digits = NULL, tolerance = is.null(digits), maxchars = 12,
  eval = list(partial = TRUE, negative = FALSE), solutionswitch = TRUE)
{
  function(x) {
    ## how many points?
    points <- if(is.null(x$metainfo$points)) 1 else x$metainfo$points

#    dopbl <- x$converter %in% c("ttm", "tth")

    ## how many questions
    solution <- if(!is.list(x$metainfo$solution)) {
      list(x$metainfo$solution)
    } else x$metainfo$solution
    n <- length(solution)

    questionlist <- if(!is.list(x$questionlist)) {
      if(x$metainfo$type == "cloze") {
        g <- rep(seq_along(x$metainfo$solution), sapply(x$metainfo$solution, length))
        split(x$questionlist, g)
      } else list(x$questionlist)
    } else x$questionlist
    if(length(questionlist) < 1) questionlist <- NULL
    for(i in 1:length(questionlist)) {
      if(length(questionlist[[i]]) < 1)
        questionlist[[i]] <- NA
    }

    tol <- if(!is.list(x$metainfo$tolerance)) {
      if(x$metainfo$type == "cloze") as.list(x$metainfo$tolerance) else list(x$metainfo$tolerance)
    } else x$metainfo$tolerance
    tol <- rep(tol, length.out = n)

    if((length(points) == 1) & (x$metainfo$type == "cloze"))
      points <- points / n

    q_points <- rep(points, length.out = n)
    if(x$metainfo$type == "cloze")
      points <- sum(q_points)

    ## set question type(s)
    type <- x$metainfo$type
    type <- if(type == "cloze") x$metainfo$clozetype else rep(type, length.out = n)

    ## evaluation policy
    if(is.null(eval) || length(eval) < 1L) eval <- exams_eval()
    if(!is.list(eval)) stop("'eval' needs to specify a list of partial/negative/rule")
    eval <- eval[match(c("partial", "negative", "rule"), names(eval), nomatch = 0)]
    if(x$metainfo$type %in% c("num", "string")) eval$partial <- FALSE
    if(x$metainfo$type == "cloze" & is.null(eval$rule)) eval$rule <- "none"
    eval <- do.call("exams_eval", eval) ## always re-call exams_eval

    ## character fields
    maxchars <- if(is.null(x$metainfo$maxchars)) {
        if(length(maxchars) < 2) {
           c(maxchars, NA, NA)
        } else maxchars[1:3]
    } else x$metainfo$maxchars
    if(!is.list(maxchars))
      maxchars <- list(maxchars)
    maxchars <- rep(maxchars, length.out = n)
    for(j in seq_along(maxchars)) {
      if(length(maxchars[[j]]) < 2)
        maxchars[[j]] <- c(maxchars[[j]], NA, NA)
    }

    ## start item presentation
    ## and insert question
    xml <- paste('<assessmentItem identifier="', x$metainfo$id, '" title="', paste(x$metainfo$id, x$metainfo$name, sep = '_'), '" adaptive="false" timeDependent="false" toolName="Testvision Online" toolVersion="39.0.9084" xmlns="http://www.imsglobal.org/xsd/imsqti_v2p1">', sep = '')

    ## cycle trough all questions
    ids <- pv <- mv <- list()
    for(i in 1:n) {
      ## evaluate points for each question
      pv[[i]] <- eval$pointvec(solution[[i]])
      pv[[i]]["pos"] <- pv[[i]]["pos"] * q_points[i]
      pv[[i]]["neg"] <- pv[[i]]["neg"] * q_points[i]
      mv[[i]] <- pv[[i]]["neg"]
    }

    mmatrix <- if(length(i <- grep("matrix", names(x$metainfo)))) {
      x$metainfo[[i]]
    } else NULL

    ## extract solution.
    msol <- x$metainfo$solution
    if(!is.list(msol))
      msol <- list(msol)

    is_essay <- rep(FALSE, n)

    for(i in 1:n) {
      ## get item id
      iid <- x$metainfo$id

      ## generate ids
      if(is.null(mmatrix)) {
#       ids[[i]] <- list("response" = paste(iid, "RESPONSE", make_id(7), sep = "_"),
        ids[[i]] <- list("response" = "RESPONSE",
          "questions" = paste("alt", make_id(6, length(msol[[i]])), sep = "_"), "idcs" = paste("alt", make_id(4), sep = "_"))
      } else {
        qs <- strsplit(x$questionlist, mmatrix, fixed = TRUE)
        mrows <- unique(sapply(qs, function(x) { x[1] }))
        mcols <- unique(sapply(qs, function(x) { x[2] }))
#       ids[[i]] <- list("response" = paste(iid, "RESPONSE", make_id(7), sep = "_"),
        ids[[i]] <- list("response" = "RESPONSE",
          "questions" = paste("alt", make_id(6, length(msol[[i]])), sep = "_"), "idcs" = paste("alt", make_id(4), sep = "_"),
          "mmatrix_matches" = matrix(msol[[i]], nrow = length(mrows), byrow = TRUE)
        )
        ids[[i]]$mmatrix_questions <- list(
          "rows" = paste(iid, make_id(10, length(mrows)), sep = "_"),
          "cols" = paste(iid, make_id(10, length(mcols)), sep = "_")
        )
        rownames(ids[[i]]$mmatrix_matches) <- mrows
        colnames(ids[[i]]$mmatrix_matches) <- mcols
        for(j in seq_along(ids[[i]]$mmatrix_questions$rows)) {
          for(jj in seq_along(ids[[i]]$mmatrix_questions$cols)) {
            ids[[i]]$mmatrix_pairs <- c(ids[[i]]$mmatrix_pairs, paste(ids[[i]]$mmatrix_questions$rows[j], ids[[i]]$mmatrix_questions$cols[jj]))
          }
        }
      }

      ## first iterate through non-cloze items
      if(x$metainfo$type != "cloze"){
       ## insert choice type responses
       if(length(grep("choice", type[i]))) {
         xml <- c(xml,
           paste('<responseDeclaration identifier="', ids[[i]]$response,
             '" cardinality="', if(type[i] == "mchoice") "multiple" else "single",
             if(is.null(mmatrix)) '" baseType="identifier">' else '" baseType="directedPair">', sep = ''),
           '<correctResponse>'
         )
         for(j in seq_along(solution[[i]])) {
           if(solution[[i]][j]) {
             xml <- c(xml,
               paste('<value>', if(is.null(mmatrix)) ids[[i]]$questions[j] else ids[[i]]$mmatrix_pairs[j], '</value>', sep = '')
             )
           }
         }

         xml <- c(xml, if(!sum(solution[[i]])) '<value>all_options_incorrect</value>' else NULL, '</correctResponse>',
           paste('<mapping defaultValue="', if(is.null(defaultval)) 0 else defaultval,
             '" lowerBound="', mv[[i]] <- if(!eval$negative) "0.0" else {
               if(eval$partial) {
                 if(type[i] == "mchoice") pv[[i]]["neg"] * sum(!solution[[i]]) else pv[[i]]["neg"]
               } else pv[[i]]["neg"]
             }, '">', sep = '')
         )
         for(j in seq_along(solution[[i]])) {
           xml <- c(xml,
             paste('<mapEntry mapKey="', if(is.null(mmatrix)) ids[[i]]$questions[j] else ids[[i]]$mmatrix_pairs[j], '" mappedValue="',
               if(eval$partial) {
                 if(solution[[i]][j]) {
                   pv[[i]]["pos"]
                 } else {
                   pv[[i]]["neg"]
                 }
               } else {
                 if(solution[[i]][j]) {
                   if(type[i] == "mchoice") pv[[i]]["pos"] / sum(solution[[i]]) else pv[[i]]["pos"]
                 } else {
                   if(pv[[i]]["neg"] == 0) {
                     -1 * pv[[i]]["pos"]
                   } else {
                     if(type[i] == "mchoice") pv[[i]]["neg"] * length(solution[[i]]) else pv[[i]]["neg"]
                   }
                 }
               }, '"/>', sep = '')
           )
         }
         xml <- c(xml, '</mapping>', '</responseDeclaration>')
       }

       ## numeric responses
       if(type[i] == "num") {
         xml <- c(xml,
           paste('<responseDeclaration identifier="', ids[[i]]$response, '" cardinality="multiple" baseType="float">', sep = ''), #NS: TVO uses multiple here, possibly due to tolerances values
         '<correctResponse>',
           paste('<value>', solution[[i]], '</value>', sep = ''),
           paste('<value>', solution[[i]] - max(tol[[i]]), ';',  solution[[i]] + max(tol[[i]]), '</value>', sep = ''), #NS: TVO specifies lower and upper in responseDeclaration
           '</correctResponse>',
           '</responseDeclaration>'
         )
       }
       ## string responses
       if(type[i] == "string") {
         if((length(maxchars[[i]]) > 1) & sum(!is.na(maxchars[[i]])) == 1) {
           xml <- c(xml,
             paste('<responseDeclaration identifier="', ids[[i]]$response, '" cardinality="single" baseType="string">', sep = ''),
           '<correctResponse>',
             paste('<value>', solution[[i]], '</value>', sep = ''),
             '</correctResponse>',
             paste('<mapping defaultValue="', if(is.null(defaultval)) 0 else defaultval, '">', sep = ''),
             paste('<mapEntry mapKey="', solution[[i]], '" mappedValue="', pv[[i]]["pos"], '" />', sep = ''),
             '</mapping>',
             '</responseDeclaration>'
           )
         } else {
           is_essay[i] <- TRUE
           ## Essay type questions.
           xml <- c(xml,
             paste('<responseDeclaration identifier="', ids[[i]]$response, '" cardinality="single" baseType="string">', sep = ''),
               '<correctResponse>',
#               if(dopbl) process_html_pbl(x$solution) else x$solution,
               paste('<value>', solution[[i]], '</value>', sep = ''),
               '</correctResponse>',
               '</responseDeclaration>'
           )
         }
       }
     } else {
         xml <- c(xml,
           if(i==1){
           paste('<responseDeclaration identifier="', ids[[1]]$response,
             '" cardinality="multiple">', sep = '')} else NULL,
           if(i==1) '<correctResponse>' else NULL
           )

         ##choice responses
         if(length(grep("choice", type[i]))) {
           for(j in seq_along(solution[[i]])) {
             if(solution[[i]][j]) {
               xml <- c(xml,
                 paste('<value fieldIdentifier="', ids[[i]]$idcs, '" baseType="string">',
                 if(is.null(mmatrix)) ids[[i]]$questions[j] else ids[[i]]$mmatrix_pairs[j],
                 '</value>', sep = '')
                 )
             }
           }
         }

         ## numeric responses
         if(type[i] == "num") {
           xml <- c(xml,
             paste('<value fieldIdentifier="', ids[[i]]$idcs, '" baseType="float">',
                 solution[[i]], '</value>', sep = ''),
             paste('<value fieldIdentifier="', ids[[i]]$idcs, '" baseType="float">',
                 solution[[i]] - max(tol[[i]]), ';',  solution[[i]] + max(tol[[i]]), '</value>', sep = '')
           )
         }
         ## string responses
         if(type[i] == "string") {
           if((length(maxchars[[i]]) > 1) & sum(!is.na(maxchars[[i]])) == 1) {
             xml <- c(xml,
               paste('<value fieldIdentifier="', ids[[i]]$idcs, '" baseType="string">',
                solution[[i]], '</value>', sep = '')
             )
           } else {
             is_essay[i] <- TRUE
             ## Essay type questions.
             xml <- c(xml,
                 paste('<value fieldIdentifier="', ids[[i]]$idcs, '" baseType="string">',
                  solution[[i]], '</value>', sep = '')
             )
           }
         }

         xml <- c(xml, if(i==n) {c('</correctResponse>', '<mapping defaultValue="0">')} else NULL
           )
       }
    }

    for(i in 1:n) {
      if(x$metainfo$type == "cloze"){
          xml <- c(xml,
            paste('<mapEntry mapKey="', ids[[i]]$idcs, '" mappedValue="', 1/n, '" />', sep = '')
               )
          xml <- c(xml, if(i==n) {c('</mapping>', '</responseDeclaration>')} else NULL
             )
      }
    }

    if(is.null(minvalue))
      minvalue <- sum(as.numeric(unlist(mv)))

    xml <- c(xml,
      paste('<outcomeDeclaration identifier="SCORE" cardinality="single" baseType="float" ',
        'normalMaximum="', sum(q_points), '" normalMinimum="', minvalue, '" />', sep = ''),
      '<outcomeDeclaration identifier="FEEDBACK" cardinality="single" baseType="identifier" />'
    )

#    if(n > 1){
#      for(i in 1:n) {
#      xml <- c(xml,
#      paste('<outcomeDeclaration identifier="SCORE', i, '" cardinality="single" baseType="float" ',
#        'normalMaximum="', q_points[i], '" normalMinimum="', minvalue, '" />', sep = ''))
#      }
#    }

    ## starting the itembody
#    xml <- c(xml,
#    '<itemBody>', paste('<div id="textBlockId_', make_id(4), '" class="textblock tvblock tvcss_1">', '<div class="textblock tvblock tvcss_1">', sep='')
#    )
#
#    xml <- c(xml, x$question, '</div>', '</div>', if(x$metainfo$type == "cloze") '<div class="interactieblok">' else NULL)
#
    if(ant <- any(grepl("##ANSWER[0-9]+##", x$question))) {
        x$question[rev(grep('<table>', x$question))[1]] <- gsub('<table>', '<div class="interactieblok"><table>',
            x$question[rev(grep('<table>' ,x$question))[1]])
    patterns <- c('align="left"', 'align="right"', 'align="center"') #necessary as long as TVO does not accept standard html
    for(i in seq_along(patterns))
    x$question <- gsub(patterns[i], "", x$question)
    }

    xml <- c(xml, '<itemBody>',  x$question, if(x$metainfo$type == "cloze" & !ant) '<div class="interactieblok">' else NULL)

    for(i in 1:n) {
      ans <- any(grepl(paste0("##ANSWER", i, "##"), xml))
      if(length(grep("choice", type[i]))) {
        if(is.null(mmatrix)) {
          if(x$metainfo$type != "cloze"){
            txml <- paste('<choiceInteraction responseIdentifier="', ids[[i]]$response,
                '" shuffle="', if(shuffle) 'true' else 'false','" maxChoices="',
                if(type[i] == "schoice") "1" else "0", '">', sep = '')
            for(j in seq_along(solution[[i]])) {
              txml <- c(txml, paste('<simpleChoice identifier="', ids[[i]]$questions[j], '">', sep = ''),
                paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep=''),
                paste(if(enumerate & !ans) {
                  paste(letters[if(x$metainfo$type == "cloze") i else j], ".",
                    if(x$metainfo$type == "cloze" && length(solution[[i]]) > 1) paste(j, ".", sep = "") else NULL,
                      sep = "")
                } else NULL, questionlist[[i]][j]),
                '</div>', '</div>',
                '</simpleChoice>'
              )
            }
            txml <- c(txml, '</choiceInteraction>')
            } else {
            txml <- c(paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', letters[i], '.', sep = ''),
            paste('<inlineChoiceInteraction class="multipleinput" id="', ids[[i]]$idcs, '" responseIdentifier="',
                ids[[1]]$response, '" shuffle="', if(shuffle) 'true' else 'false', '" required="true">', sep = '')
                )
            for(j in seq_along(solution[[i]])) {
              txml <- c(txml, paste('<inlineChoice identifier="', ids[[i]]$questions[j], '">',
                paste(if(enumerate & !ans) {
                  paste(if(length(solution[[i]]) > 1) paste(j, '.', sep = '') else NULL, sep = '')
                } else NULL, gsub("<[^>]+>","", questionlist[[i]][j])), ##TVO does not allow for any styling within the html-code of inlineChoice content
                '</inlineChoice>', sep ='')
              )
            }
            txml <- c(txml, '</inlineChoiceInteraction>', '</div>', '</div>')
              }
        } else {
          txml <- c(paste0('<matchInteraction class="match_matrix" responseIdentifier="', ids[[i]]$response,
            '" shuffle="', if(shuffle) 'true' else 'false','" maxAssociations="',
            if(type[i] == "schoice") "1" else "0", '">', sep = ''),
            '<simpleMatchSet>')
          for(j in seq_along(ids[[i]]$mmatrix_questions$rows)) {
            txml <- c(txml,
              paste0('<simpleAssociableChoice identifier="',
                ids[[i]]$mmatrix_questions$rows[j], '" matchMax="1" matchMin="0">'),
              '<p>',
              rownames(ids[[i]]$mmatrix_matches)[j],
              '</p>', '</simpleAssociableChoice>')
          }
          txml <- c(txml, '</simpleMatchSet>', '<simpleMatchSet>')
          for(j in seq_along(ids[[i]]$mmatrix_questions$cols)) {
            txml <- c(txml,
              paste0('<simpleAssociableChoice identifier="',
                ids[[i]]$mmatrix_questions$cols[j], '" matchMax="1" matchMin="0">'),
              '<p>',
              colnames(ids[[i]]$mmatrix_matches)[j],
              '</p>', '</simpleAssociableChoice>')
          }
          txml <- c(txml, '</simpleMatchSet>', '</matchInteraction>')
        }
      }
      if(type[i] == "num") {
        for(j in seq_along(solution[[i]])) {
          txml <- c(
            if(x$metainfo$type == "cloze") paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep = '') else NULL,
              if(!is.null(questionlist[[i]][j])) {
                paste(if(enumerate & n > 1 ) {
                  paste(letters[if(x$metainfo$type == "cloze") i else j], ".",
                    if(x$metainfo$type == "cloze" && length(solution[[i]]) > 1) paste(j, ".", sep = "") else NULL,
                      sep = "")
                } else NULL, if(!is.na(questionlist[[i]][j])) questionlist[[i]][j] else NULL)
              },
            if(x$metainfo$type != "cloze") paste('<extendedTextInteraction responseIdentifier="', ids[[i]]$response, '"/>', sep = '') else
             paste('<textEntryInteraction class="multipleinput" id="', ids[[i]]$idcs, '" responseIdentifier="', ids[[1]]$response, '" expectedLength="12" />', sep = ''),
            if(x$metainfo$type == "cloze") c('</div>', '</div>') else NULL
          )
        }
      }
      if(type[i] == "string") {
        if((length(maxchars[[i]]) > 1) & sum(is.na(maxchars[[i]])) < 1) {
          ## Essay type questions.
          txml <- c(
             if(x$metainfo$type == "cloze") paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep = '') else NULL,
             if(!is.null(questionlist[[i]])) {
                paste(if(enumerate & n > 1) {
                  paste(letters[if(x$metainfo$type == "cloze") i else j], ".",
                    if(x$metainfo$type == "cloze" && length(solution[[i]]) > 1) paste(1, ".", sep = "") else NULL,
                      sep = "")
                } else NULL, if(!is.na(questionlist[[i]])) questionlist[[i]] else NULL)
             },
             paste(if(x$metainfo$type != "cloze") '<extendedTextInteraction responseIdentifier="' else '<textEntryInteraction responseIdentifier="', ids[[i]]$response,
              #'" minStrings="0" ', if(!is.na(maxchars[[i]][1])) {
             '" ', if(!is.na(maxchars[[i]][1])) {
                  paste0(' expectedLength="', maxchars[[i]][1], '"')
                } else NULL, if(!is.na(maxchars[[i]][2])) {
                  paste(' expectedLines="', maxchars[[i]][2], '" ', sep = '')
                } else NULL, if(x$metainfo$type == "cloze") {
                  paste0(' id="', ids[[i]]$idcs, '"')
                } else NULL,
                 '/>', sep = ''),
             if(x$metainfo$type == "cloze") c('</div>', '</div>') else NULL
          )
        } else {
          for(j in seq_along(solution[[i]])) {
            txml <- c(
             if(x$metainfo$type == "cloze") paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep = '') else NULL,
               if(!is.null(questionlist[[i]][j])) {
                  paste(if(enumerate & n > 1) {
                    paste(letters[if(x$metainfo$type == "cloze") i else j], ".",
                      if(x$metainfo$type == "cloze" && length(solution[[i]]) > 1) paste(j, ".", sep = "") else NULL,
                        sep = "")
                  } else NULL, if(!is.na(questionlist[[i]][j])) questionlist[[i]][j] else NULL)
               },
               paste(if(x$metainfo$type != "cloze") '<extendedTextInteraction responseIdentifier="' else '<textEntryInteraction responseIdentifier="', ids[[i]]$response,
                if(!is.na(maxchars[[i]][1])) {
                  paste0('" expectedLength="', maxchars[[i]][1], '"')
                } else NULL, if(!is.na(maxchars[[i]][2])) {
                  paste0('" expectedLines="', maxchars[[i]][2], '"')
                } else NULL,  if(x$metainfo$type == "cloze") {
                  paste0(' id="', ids[[i]]$idcs, '"')
                } else NULL, '/>', sep = ''),
              if(x$metainfo$type == "cloze") c('</div>', '</div>') else NULL
            )
          }
        }
      }
      if(ans) {
        txml <- paste(txml, collapse = '\n')
        if(length(grep("choice", type[i])) & !any(grepl('<table>', xml, fixed = TRUE)))
          txml <- paste0('</p>', txml, '<p>')
        xml <- gsub(paste0("##ANSWER", i, "##"), txml, xml, fixed = TRUE)
      } else {
        xml <- c(xml, txml)
      }
    }

    ## close itembody
    xml <- c(xml, if(x$metainfo$type == "cloze") '</div>' else NULL, '</itemBody>')

    ## response processing
    xml <- c(xml, '<responseProcessing>')

    ## all not answered
    xml <- c(xml,
      '<responseCondition>',
      '<responseIf>'
#      if(n > 1) '<and>' else NULL
    )
#    for(i in 1:n) {
     xml <- c(xml,
     '<isNull>',
     paste('<variable identifier="', ids[[1]]$response, '"/>', sep = ''),
     '</isNull>'
      )
#    }
    xml <- c(xml,
#      if(n > 1) '</and>' else NULL,
      '<setOutcomeValue identifier="SCORE">',
      '<baseValue baseType="float">0.0</baseValue>', ## FIXME: points when not answered?
      '</setOutcomeValue>',
      '<setOutcomeValue identifier="FEEDBACK">',
      '<baseValue baseType="identifier">FAILURE</baseValue>',
      '</setOutcomeValue>',
      '</responseIf>',
      '<responseElse>'
    )

#    ## not answered points single
#    for(i in 1:n) {
#      xml <- c(xml,
#        '<responseCondition>',
#        '<responseIf>',
#        '<isNull>',
#        paste('<variable identifier="', ids[[i]]$response, '"/>', sep = ''),
#        '</isNull>',
#        '<setOutcomeValue identifier="SCORE">',
#        '<sum>',
#        '<baseValue baseType="float">0.0</baseValue>', ## FIXME: points when not answered?
#        '</sum>',
#        '</setOutcomeValue>',
#        '</responseIf>',
#        '</responseCondition>'
#      )
#    }

    ## set the score
    for(i in 1:n) {
      if(x$metainfo$type != "cloze"){
        xml <- c(xml,
          if(type[i] == "num" ){
            c('<responseCondition>',
            '<responseIf>',
            '<match>',
            paste('<variable identifier="', ids[[i]]$response, '"/>', sep = ''),
            paste('<correct identifier="', ids[[i]]$response, '"/>', sep = ''),
            '</match>',
#           paste('<setOutcomeValue identifier="SCORE', ifelse(n > 1, i, ""), '">', sep = ''),
            '<setOutcomeValue identifier="SCORE">',
            paste('<baseValue baseType="float">', pv[[i]]["pos"], '</baseValue>', sep = ''),
            '</setOutcomeValue>',
            '</responseIf>',
            '<responseElse>',
#           paste('<setOutcomeValue identifier="SCORE', ifelse(n > 1, i, ""), '">', sep = ''),	
            '<setOutcomeValue identifier="SCORE">',									
            paste('<baseValue baseType="float">', pv[[i]]["neg"], '</baseValue>', sep = ''),
            '</setOutcomeValue>',
            '</responseElse>',
            '</responseCondition>')
          } else {
            c(
            #paste('<setOutcomeValue identifier="SCORE', ifelse(n > 1, i, ""), '">', sep = ''),
            '<setOutcomeValue identifier="SCORE">',
            switch(if(is_essay[i]) "essay" else type[i],
            "mchoice" =  paste('<mapResponse identifier="', ids[[i]]$response, '"/>', sep = ''),
            "schoice" =  paste('<mapResponse identifier="', ids[[i]]$response, '"/>', sep = ''),
            "string" =   paste('<mapResponse identifier="', ids[[i]]$response, '"/>', sep = ''),
            "essay" = paste('<baseValue baseType="float">0</baseValue>', sep = '')),
            '</setOutcomeValue>')
          }
        )

        ## Adapt points for mchoice.
        ## Case no correct answers.
        if(type[i] == "mchoice") {
          if(sum(solution[[i]]) < 1) {
            warning(sprintf("Exercise '%s' has all options incorrect, and can therefore not be handled by TestVision", x$metainfo$file))
            xml <- c(xml,
              '<responseCondition>',
              '<responseIf>',
              '<isNull>',
              paste('<variable identifier="', ids[[i]]$response, '"/>', sep = ''),
              '</isNull>',
              '<setOutcomeValue identifier="SCORE">',
              paste('<baseValue baseType="float">', q_points[i], '</baseValue>', sep = ''),
              '</setOutcomeValue>',
              '</responseIf>',
              '</responseCondition>'
            )
          }
        }
      }
        ## Deal with cloze items and case maximum points with rounding errors in cloze.
         else {
          xml <- c(xml,
            if(i==1){
              c('<setOutcomeValue identifier="SCORE">',
              paste('<mapResponse identifier="', ids[[i]]$response, '"/>', sep = ''),
              '</setOutcomeValue>',
              '<responseCondition>',
              '<responseIf>',
              '<equal toleranceMode="relative" tolerance="0.001">',
              '<variable identifier="SCORE"/>',
              '<variable identifier="MAXSCORE"/>',
              '</equal>',
              '<setOutcomeValue identifier="SCORE">',
              paste('<baseValue baseType="float">', sum(q_points), '</baseValue>', sep = ''),
              '</setOutcomeValue>',
              '</responseIf>',
              '</responseCondition>'
              )
            } else NULL
          )
        }
      }
#    if(x$metainfo$type == "cloze"){
#      xml <- c(xml,
#        '<setOutcomeValue identifier="SCORE">',
#        '<sum>',
#        paste('<variable identifier="SCORE', 1:n , '"/>', sep = ''),
#        '</sum>',
#        '</setOutcomeValue>'
#        )
#    }

    xml <- c(xml,
        '<responseCondition>',
        '<responseIf>',
        '<equal toleranceMode="relative" tolerance="0.001">',
        '<variable identifier="SCORE"/>',
        '<variable identifier="MAXSCORE"/>',
        '</equal>',
        '<setOutcomeValue identifier="FEEDBACK">',
        '<baseValue baseType="identifier">ANSWER_CORRECT</baseValue>',
        '</setOutcomeValue>',
        '</responseIf>',
        '<responseElse>',
        '<setOutcomeValue identifier="FEEDBACK">',
        '<baseValue baseType="identifier">FAILURE</baseValue>',
        '</setOutcomeValue>',
        '</responseElse>',
        '</responseCondition>',
        '</responseElse>',
        '</responseCondition>')

    ## show solution when answered and wrong
#    xml <- c(xml,
#      '<responseCondition>',
#      '<responseIf>',
#      if(type[i] != "num") {
#        c('<equal toleranceMode="relative" tolerance="0.001">',
#          '<variable identifier="SCORE"/>',
#          '<variable identifier="MAXSCORE"/>',
#          '</equal>')
#      } else {
#        c(
#          paste('<equal toleranceMode="absolute" tolerance="', max(tol[[i]]), ' ',
#            max(tol[[i]]),'" includeLowerBound="true" includeUpperBound="true">', sep = ''),
#          paste('<variable identifier="', ids[[i]]$response, '"/>', sep = ''),
#          paste('<correct identifier="', ids[[i]]$response, '"/>', sep = ''),
#          '</equal>'
#        )
#      },
#      '<setOutcomeValue identifier="FEEDBACK">',
#      '<baseValue baseType="identifier">correct</baseValue>',
#      '</setOutcomeValue>',
#      '</responseIf>',
#      '<responseElse>',
#      '<setOutcomeValue identifier="FEEDBACK">',
#      '<baseValue baseType="identifier">incorrect</baseValue>',
#      '</setOutcomeValue>',
#      if(!eval$partial) {
#        c('<setOutcomeValue identifier="SCORE">',
#          paste('<baseValue baseType="float">', minvalue, '</baseValue>', sep = ''),
#          '</setOutcomeValue>')
#      } else NULL,
#      '</responseElse>',
#      '</responseCondition>'
#    )

    ## set the minimum points
#    if(!is.null(minvalue)) {
#      xml <- c(xml,
#        '<responseCondition>',
#        '<responseIf>',
#        '<and>',
#        '<match>',
#        '<baseValue baseType="identifier">incorrect</baseValue>',
#        '<variable identifier="FEEDBACKBASIC"/>',
#        '</match>',
#        '<not>',
#        '<gte>',
#        '<variable identifier="SCORE"/>',
#        '<variable identifier="MINSCORE"/>',
#        '</gte>',
#        '</not>',
#        '</and>',
#        '<setOutcomeValue identifier="SCORE">',
#        paste('<baseValue baseType="float">', minvalue, '</baseValue>', sep = ''),
#        '</setOutcomeValue>',
#        '</responseIf>',
#        '</responseCondition>'
#      )
#    }

    if(solutionswitch) {
#      fid <- make_id(9, 1)
#      xml <- c(xml,
#        '<responseCondition>',
#        '<responseIf>',
#        '<and>',
#        '<match>',
#        '<baseValue baseType="identifier">incorrect</baseValue>',
#        '<variable identifier="FEEDBACKBASIC"/>',
#        '</match>',
#        '</and>',
#        '<setOutcomeValue identifier="FEEDBACKMODAL">',
#        '<multiple>',
#        '<variable identifier="FEEDBACKMODAL"/>',
#        paste('<baseValue baseType="identifier">Feedback', fid, '</baseValue>', sep = ''),
#        '</multiple>',
#        '</setOutcomeValue>',
#        '</responseIf>',
#        '</responseCondition>'
#      )

      ## create solution
      xsolution <- fix_tvo_img(x$solution)
      if(!is.null(x$solutionlist)) {
        if(!all(is.na(x$solutionlist))) {
          xsolution <- c(xsolution, if(length(xsolution)) "<br />" else NULL)
          if(enumerate) xsolution <- c(xsolution, '<ol>')
          if(x$metainfo$type == "cloze") {
            g <- rep(seq_along(x$metainfo$solution), sapply(x$metainfo$solution, length))
            ql <- sapply(split(x$questionlist, g), paste, collapse = " / ")
            sl <- sapply(split(x$solutionlist, g), paste, collapse = " / ")
          } else {
            ql <- x$questionlist
            sl <- x$solutionlist
          }
          nsol <- length(ql)
          xsolution <- c(xsolution, paste(if(enumerate) rep('<li>', nsol) else NULL,
            ql, if(length(x$solutionlist)) "<br />" else NULL,
            sl, if(enumerate) rep('</li>', nsol) else NULL))
          if(enumerate) xsolution <- c(xsolution, '</ol>')
        }
      }
    }

    xml <- c(xml, '</responseProcessing>')

    ## solution when wrong
    if(solutionswitch) {
      xml <- c(xml,
        paste('<modalFeedback identifier="FAILURE" outcomeIdentifier="FEEDBACK" showHide="show">', sep = ''),
        paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep=''),
        xsolution, '</div>', '</div>',
        '</modalFeedback>'
      )
    }

    ## solution when correct
    if(solutionswitch) {
      xml <- c(xml,
        paste('<modalFeedback identifier="ANSWER_CORRECT" outcomeIdentifier="FEEDBACK" showHide="show">', sep = ''),
        paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep=''),
        xsolution, '</div>', '</div>',
        '</modalFeedback>'
      )
    }

    ## solution when partially correct (cloze and mchoice)
    if(solutionswitch) {
      xml <- c(xml,
        paste('<modalFeedback identifier="PARTIAL_CORRECT" outcomeIdentifier="FEEDBACK" showHide="show">', sep = ''),
        paste('<div class="textblock tvblock tvcss_1">', '<div class="rte_zone tveditor1">', sep=''),
        xsolution, '</div>', '</div>',
        '</modalFeedback>'
      )
    }

    xml <- c(xml, '</assessmentItem>')

    xml
  }
}


## Function to check for block-level elements and <p> tags.
process_html_pbl <- function(x)
{
  ## List of block-level elements from
  ## https://www.w3schools.com/html/html_blocks.asp
  ble <- c(
    "address",
    "article",
    "aside",
    "blockquote",
    "canvas",
    "dd",
    "div",
    "dl",
    "dt",
    "fieldset",
    "figcaption",
    "figure",
    "footer",
    "form",
    "h1",
    "h2",
    "h3",
    "h4",
    "h5",
    "h6",
    "header",
    "hr",
    ## "li",
    "main",
    "nav",
    "noscript",
    "ol",
    "output",
    ## "p",
    "pre",
    "section",
    "table",
    "tfoot",
    "ul",
    "video"
  )
  ble <- paste0("<", ble)

  x <- x[x != '<div class="p"><!----></div>']
  x <- gsub('<div class="p"><!----></div>', '', x, fixed = TRUE)

  if(any(grepl("table>", x))) {
    if(!any(grepl("tbody>", x))) {
      patterns <- c('<\\s*table[^>]*>', '<\\s*/\\s*table>')
      replacements <- c('<table><tbody>', '</tbody></table>')
      for(i in seq_along(patterns))
        x <- gsub(patterns[i], replacements[i], x)
    }
  }

  tags <- NULL
  for(b in ble) {
    if(any(grepl(b, x, fixed = TRUE)))
      tags <- c(tags, b)
  }

  if(is.null(tags)) {
    x <- c("<p>", x, "</p>")
  } else {
    x <- paste(x, collapse = "\n")
    for(p in tags) {
      p <- gsub("<", "", p, fixed = TRUE)
      pat <- paste0('(<\\s*', p, '[^>]*>)')
      x <- gsub(pat, '</p>\\1', x, perl = TRUE)
      pat <- paste0('(<\\s*/\\s*', p, '>)')
      x <- gsub(pat, '\\1<p>', x, perl = TRUE)
    }
    x <- paste0('<p>', x, '</p>')
    x <- gsub('<p></p>', '', x, fixed = TRUE)
  }

  return(x)
}

## Check if first element of string is a number.
is_number1 <- function(x)
{
  x <- strsplit(x, "")
  x <- sapply(x, function(z) {
    suppressWarnings(!is.na(as.numeric(z[1])))
  })
  return(x)
}

## fix the issue of TVO not allowing for a missing alternate text 'alt=' in img specifations
fix_tvo_img <- function(x){
  img_start <- grep("<img[^>]+>", x)
    if(length(img_start) > 0L) {
      for(i in img_start) {
        if(!grepl("alt=", x[i])){
          x[i] <- gsub("/>", "alt=\"image\"/>", x[i])
        }
      }
    }
  return(x)
}