## generate exams in TCEXAM XML format
exams2tcexam <- 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 = "", points = NULL,
modulename = name, subjectname = name, subjectdescription = NULL, timer = 0,
fullscreen = FALSE, inlineanswers = FALSE, autonext = FALSE, shuffle = FALSE,
lang = "en", date = Sys.time(), zip = FALSE, converter = NULL, ...)
{
## set up .html transformer
if(any(tolower(tools::file_ext(unlist(file))) == "rmd")) {
if(is.null(converter)) converter <- "pandoc"
} else {
if(is.null(converter)) converter <- "ttm"
}
htmltransform <- make_exercise_transform_html(converter = converter, ..., base64 = TRUE)
## generate the exam
if(encoding == "") encoding <- "UTF-8"
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)
## 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)
## create a name
if(is.null(name)) name <- "tcexam-module"
if(is.null(modulename)) modulename <- name
if(is.null(subjectname)) subjectname <- name
if(is.null(subjectdescription)) subjectdescription <- "tcexam subject generated by R/exams"
## create the directory where the test is stored
dir.create(test_dir <- file.path(tdir, name))
## number of exams and questions
nx <- length(exm)
nq <- length(exm[[1L]])
## points setting
if(!is.null(points))
points <- rep(points, length.out = nq)
## encoding
enc <- gsub("-", "", tolower(encoding), fixed = TRUE)
if(enc %in% c("iso8859", "iso88591")) enc <- "latin1"
if(enc == "iso885915") enc <- "latin9"
charset <- encoding
if(enc == "utf8")
charset <- "UTF-8"
if(enc == "latin1")
charset <- "ISO-8859-1"
if(enc == "latin9")
charset <- "ISO-8859-15"
## header of the .xml file
xml <- c(
sprintf('<?xml version="1.0" encoding="%s" ?>', charset),
'<tcexamquestions version="1.0">\n',
sprintf('<header lang="%s" date="%s">', lang, date),
'</header>\n',
'<body>',
'<module>',
sprintf(' <name>%s</name>', modulename),
' <enabled>true</enabled>\n',
' <subject>\n',
sprintf(' <name>%s</name>', subjectname),
sprintf(' <description>%s</description>', subjectdescription),
' <enabled>true</enabled>\n'
)
## cycle through all questions and samples
tcexamquestion <- make_question_tcexam(timer = timer, fullscreen = fullscreen,
inlineanswers = inlineanswers, autonext = autonext, shuffle = shuffle)
xml <- c(xml, unlist(lapply(1L:nq, function(j)
unlist(lapply(1L:nx, function(i) tcexamquestion(exm[[i]][[j]], position = j, points = points[j])))
)))
## footer of the .xml file
xml <- c(xml,
' </subject>\n',
'</module>',
'</body>\n',
'</tcexamquestions>\n'
)
## write to dir
writeLines(xml, file.path(test_dir, paste(name, "xml", sep = ".")))
## 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)
invisible(exm)
}
fix_html_tcexam <- function(x, collapse = " ")
{
## collapse <pre>-formatted code
pre1 <- grep("<pre>", x, fixed = TRUE)
pre2 <- grep("</pre>", x, fixed = TRUE)
if(length(pre1) != length(pre2)) warning("cannot properly fix <pre> tags")
if(length(pre1) > 0L) {
for(i in length(pre1):1L) {
p1 <- pre1[i]
p2 <- pre2[i]
if(p2 > p1) {
x[p1] <- paste(x[p1:p2], collapse = "\n")
x <- x[-((p1 + 1L):p2)]
}
}
}
## collapse everything else
x <- paste(x, collapse = collapse)
## fix up HTML formatting for TCExam
fix <- rbind(
c("<i>", "[i]"),
c("</i>", "[/i]"),
c("<em>", "[i]"),
c("</em>", "[/i]"),
c("<b>", "[b]"),
c("</b>", "[/b]"),
c("<strong>", "[b]"),
c("</strong>", "[/b]"),
c("<u>", "[u]"),
c("</u>", "[/u]"),
c("<ul>", "[ulist]"),
c("</ul>", "[/ulist]"),
c("<ol>", "[olist]"),
c("</ol>", "[/olist]"),
c("<li>", "[li]"),
c("</li>", "[/li]"),
c("<code>", ""), ## FIXME
c("</code>", ""),
c("<pre>", "[code]"),
c("</pre>", "[/code]"),
c("<table", "[html]<table"),
c("</table>", "</table>[/html]"),
c("<h1>", "[html]<h1>"),
c("</h1>", "</h1>[/html]"),
c("<h2>", "[html]<h2>"),
c("</h2>", "</h2>[/html]"),
c("<h3>", "[html]<h3>"),
c("</h3>", "</h3>[/html]"),
c(" ", " "),
c("<p>", ""),
c("</p>", "\n"),
c("<br/>", "\n"),
c("<br />", "\n"),
c("<math ", "[mathml]<math "),
c("</math>", "</math>[/mathml]"),
c("<img", "[html]<img"),
c("/>", "/>[/html]"),
c("<div class=\"p\"><!----></div>", "\n"),
c("<div style=\"text-align:center\">", "\n"),
c("</div>", ""),
c("<span>", " "),
c("</span>", " "),
c("&", "&"),
c("<", "<"),
c(">", ">"),
c("&#", "&#")
)
for(i in 1:nrow(fix)) x <- gsub(fix[i,1], fix[i,2], x, fixed = TRUE)
return(x)
}
## tcexam question constructor function
make_question_tcexam <- function(timer = 0, fullscreen = FALSE,
inlineanswers = FALSE, autonext = FALSE, shuffle = FALSE)
{
function(x, points = NULL, position = 1L) {
## how many points?
if(is.null(points)) points <- x$metainfo$points
if(is.null(points)) points <- 1L
## match question type
type <- switch(x$metainfo$type,
"num" = "text",
"mchoice" = "multiple",
"schoice" = "single",
"cloze" = "cloze",
"string" = "text"
)
if(type == "cloze") stop("extype 'cloze' is not supported by tcexam")
## start the question xml
xml <- c(
'',
'<question>',
' <enabled>true</enabled>',
sprintf(' <type>%s</type>', type),
sprintf(' <difficulty>%s</difficulty>', points),
sprintf(' <position>%s</position>', position),
sprintf(' <timer>%s</timer>', timer),
sprintf(' <fullscreen>%s</fullscreen>', tolower(as.character(fullscreen))),
sprintf(' <inline_answers>%s</inline_answers>', tolower(as.character(inlineanswers))),
sprintf(' <auto_next>%s</auto_next>', tolower(as.character(autonext))),
sprintf(' <description>%s</description>', fix_html_tcexam(x$question)),
' <explanation></explanation>'
)
## add questionlist (if any)
answer_xml <- function(question, solution, position) c(
'',
' <answer>',
' <enabled>true</enabled>',
sprintf(' <isright>%s</isright>', tolower(as.character(solution))),
sprintf(' <position>%s</position>', position),
' <keyboard_key></keyboard_key>',
sprintf(' <description>%s</description>', question),
' <explanation></explanation>',
' </answer>'
)
if(type %in% c("single", "multiple")) {
answerlist <- lapply(seq_along(x$questionlist), function(i)
answer_xml(question = fix_html_tcexam(x$questionlist[i]), solution = x$metainfo$solution[i], position = if(shuffle) "" else i))
xml <- c(xml, unlist(answerlist))
}
## end the question xml
xml <- c(xml, '</question>\n')
## return with some padding
xml <- paste0(' ', xml)
xml
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.