set.nali.names = function(x, nali) {
restore.point("set.nali.names")
ind = match(names(x), names(nali))
names(x)[!is.na(ind)] = unlist(nali[ind[!is.na(ind)]])
x
}
# update a chunk.ui to the specified mode
update.chunk.ui = function(uk, mode=uk$mode,app=getApp(),dset=TRUE) {
restore.point("update.chunk.ui")
ck = uk$ck
uk$mode = mode
ui = get.chunk.ui(uk)
#cat(as.character(ui))
#if (dset)
# dsetUI(ck$nali$chunkUI, ui)
setUI(ck$nali$chunkUI, ui)
}
# returns the ui for a chunk based on its current mode
# mode can be "input", "output", or "inactive"
get.chunk.ui = function(uk) {
restore.point("get.chunk.ui")
mode = uk$mode
if (mode=="input") {
return(make.chunk.input.ui(uk=uk))
} else if (mode=="output") {
return(make.chunk.output.ui(uk=uk))
} else if (mode=="inactive") {
HTML("You must first solve the earlier chunks...")
} else {
HTML("Not shown")
}
}
make.chunk.input.ui = function(uk, theme="textmate", height=NULL, code.lines=NULL, fontSize=12, console.height=height, opts=rt.opts()) {
restore.point("make.chunk.input.ui")
ck = uk$ck
nali = ck$nali
code = merge.lines(uk$stud.code)
if (is.null(code.lines))
code.lines = max(length(sep.lines(code)), length(sep.lines(ck$sol.txt)))+1
if (is.null(height)) {
height = max((fontSize * 1.25) * code.lines,30)+35
}
if (is.null(console.height)) {
console.code.lines = min(code.lines,10)
console.height = (fontSize * 1.25) * console.code.lines + 50
}
if (uk$solved) {
label = "was already solved"
} else {
label = "not yet solved"
}
solutionBtn = NULL
if (isTRUE(opts$show.solution.btn)) {
solutionBtn=bsButton(nali$solutionBtn, "solution",size="extra-small")
} else {
solutionBtn = NULL
}
if (isTRUE(opts$show.data.exp)) {
dataBtn = bsButton(nali$dataBtn, "data", size="extra-small")
} else {
dataBtn = NULL
}
if (isTRUE(opts$show.save.btn)) {
saveBtn = bsButton(nali$saveBtn, "save",size="extra-small")
} else {
saveBtn = NULL
}
if (!opts$noeval) {
button.row = tagList(
bsButton(nali$checkBtn, "check",size="extra-small"),
bsButton(nali$hintBtn, "hint", size="extra-small"),
bsButton(nali$runBtn, "run chunk",size="extra-small"),
dataBtn,
saveBtn,
solutionBtn
)
keys = list(runLineKey="Ctrl-Enter", helpKey="F1", runKey="Ctrl-R|Ctrl-Shift-Enter", hintKey="Ctrl-H", checkKey = "Ctrl-Alt-R|Ctrl-T")
} else {
button.row = tagList(
bsButton(nali$checkBtn, "check",size="extra-small"),
bsButton(nali$hintBtn, "hint", size="extra-small"),
solutionBtn
)
keys = list(hintKey="Ctrl-H", checkKey = "Ctrl-Alt-R|Ctrl-T")
}
keys = set.nali.names(keys, nali)
edit.row = tagList(
aceEditor(nali$editor, code, mode="r",theme=theme, height=height, fontSize=13,hotkeys = keys, wordWrap=TRUE, debounce=1, showLineNumbers=isTRUE(opts$show.line.numbers)),
aceEditor(nali$console, "", mode="r",theme="clouds", height=console.height, fontSize=13,hotkeys = NULL, wordWrap=TRUE, debounce=1, showLineNumbers=FALSE,highlightActiveLine=FALSE)
)
#aceAutocomplete(nali$editor)
tagList(
button.row,
bsAlert(nali$alertOut),
edit.row
)
}
make.chunk.output.ui = function(uk, opts = rt.opts()) {
restore.point("make.chunk.output.ui")
ck = uk$ck; nali = ck$nali
code = uk$stud.code
if (isTRUE(opts$show.save.btn)) {
saveBtn = bsButton(nali$saveBtn, "save", size="extra-small")
} else {
saveBtn = NULL
}
if (isTRUE(opts$show.data.exp)) {
dataBtn = bsButton(nali$dataBtn, "data", size="extra-small")
} else {
dataBtn = NULL
}
if (!opts$noeval) {
button.row = tagList(
bsButton(nali$editBtn, "edit",size="extra-small"),
dataBtn,
saveBtn
)
} else {
button.row = tagList(
bsButton(nali$editBtn, "edit",size="extra-small")
)
}
solved = uk$solved
mode = uk$mode
if (solved) {
code = code
args = ck$args
preknit =
# noeval will always be preknit
opts$noeval |
# don't preknit special output or if chunk option replace.sol=FALSE
(opts$preknit & !(!is.null(args[["output"]]) | is.false(args$replace.sol)))
if (preknit) {
if (!is.null(args[["output"]])) {
html = HTML("<p> SPECIAL OUTPUT HERE <p>")
} else {
html = HTML(ck$sol.html)
}
} else {
# not preknitted (default)
if (!is.null(args[["output"]])) {
html = chunk.special.output(uk=uk)
} else {
html = chunk.to.html(uk=uk)
html = HTML(html)
}
}
} else {
if ((identical(code, ck$shown.txt) | isTRUE(opts$noeval)) & !is.null(ck$shown.html)) {
# just show precompiled show
html = ck$shown.html
} else {
# compile no solution again
if (opts$noeval) {
uk$stud.code = ck$shown.txt
html = chunk.to.html(uk=uk, eval=FALSE)
} else {
html = chunk.to.html(uk=uk, eval=FALSE)
}
}
html = HTML(html)
}
restore.point("make.chunk.output.ui.2")
tagList(
button.row,
bsAlert(nali$alertOut),
html
)
}
make.global.chunk.hotkey.handlers = function(opts=rt.opts()) {
aceHotkeyHandler("checkKey", shiny.chunk.hotkey)
aceHotkeyHandler("hintKey", shiny.chunk.hotkey)
if (!opts$noeval) {
aceHotkeyHandler("runKey", shiny.chunk.hotkey)
aceHotkeyHandler("runLineKey", shiny.chunk.hotkey)
aceHotkeyHandler("helpKey", shiny.chunk.hotkey)
}
}
shiny.chunk.hotkey = function(keyId,editorId,selection,cursor,text,...,app=getApp(),opts=rt.opts()) {
args = list(...)
restore.point("shiny.chunk.hotkey")
bi = as.numeric(str.between(editorId,"__","__"))
uk = get.ts(bi=bi)
if (is.null(uk)) {
restore.point("shiny.chunk.hotkey.null.uk")
warning("shiny.chunk.hotkey: uk is null")
}
noeval = opts$noeval
if (keyId=="checkKey") {
check.shiny.chunk(uk=uk)
} else if (keyId=="hintKey") {
hint.shiny.chunk(uk = uk,code=text)
} else if (keyId=="runKey" & !noeval) {
run.shiny.chunk(uk=uk,code=text)
} else if (keyId=="runLineKey" & !noeval) {
run.line.shiny.chunk(uk=uk, cursor=cursor, selection=selection, code=text)
} else if (keyId=="helpKey" & !noeval) {
help.shiny.chunk(uk=uk, cursor=cursor, selection=selection, code=text)
}
}
make.chunk.handlers = function(uk, nali= uk$ck$nali, opts=rt.opts()) {
restore.point("make.chunk.handlers")
buttonHandler(nali$checkBtn, check.shiny.chunk, uk=uk)
buttonHandler(nali$hintBtn, hint.shiny.chunk, uk=uk)
if (!opts$noeval) {
buttonHandler(nali$runBtn, run.shiny.chunk, uk=uk)
}
if (isTRUE(opts$show.solution.btn))
buttonHandler(nali$solutionBtn, solution.shiny.chunk, uk=uk)
buttonHandler(nali$editBtn, edit.shiny.chunk, uk=uk)
}
run.shiny.chunk = function(uk, envir = get.task.env(ts=uk), code=getInputValue(uk$ck$nali$editor), opts=rt.opts(),...) {
restore.point("run.shiny.chunk")
if (is.null(code)) code = ""
chunk.is.selected(uk)
ck = uk$ck
if (opts$in.R.console) {
eval.in.console(code, envir=envir)
} else {
eval.in.ace.console(code, envir=envir, consoleId=ck$nali$console)
}
}
run.line.shiny.chunk = function(uk, envir=get.task.env(ts=uk), cursor=NULL, selection=NULL,code=getInputValue(uk$ck$nali$editor),..., app=getApp(), opts=rt.opts()) {
restore.point("run.line.shiny.chunk")
if (is.null(code)) code = ""
uk$stud.code = code
chunk.is.selected(uk)
if (selection == "") {
txt = sep.lines(code)
txt = txt[cursor$row+1]
} else {
txt = selection
}
if (opts$in.R.console) {
eval.in.console(txt, envir=envir)
} else {
eval.in.ace.console(txt, envir=envir, consoleId=uk$ck$nali$console)
}
}
check.shiny.chunk = function(uk, internal=FALSE, max.lines=300, store.output=FALSE, opts=rt.opts(), app=getApp(),...) {
uk$stud.code = getInputValue(uk$ck$nali$editor)
if (is.null(uk$stud.code)) uk$stud.code = ""
chunk.is.selected(uk)
uk$task.env = make.fresh.task.env(ts=uk)
restore.point("check.shiny.chunk")
ck = uk$ck
if (!is.false(opts$catch.errors)) {
ret = tryCatch(check.chunk(uk=uk, store.output=store.output, use.secure.eval=opts$use.secure.eval), error = function(e) {uk$log$failure.message <- as.character(e);return(FALSE)})
} else {
ret = check.chunk(uk=uk,store.output=store.output, use.secure.eval=opts$use.secure.eval)
}
# Don't yet know how we deal with this
# ps$prev.check.chunk.ind = chunk.ind
if (!internal) {
if (!ret) {
txt = merge.lines(c(uk$log$success, uk$log$failure.message,"Press Ctrl-H to get a hint."))
updateAceEditor(app$session, ck$nali$console, value=txt, mode="text")
uk$solved = FALSE
} else {
#restore.point("success test shiny chunk")
if (NROW(uk$log$chunk.console.out)>max.lines) {
txt = merge.lines(
c("You successfully solved the chunk!",
uk$log$chunk.console.out[1:max.lines],
paste0("\n...", NROW(uk$log$chunk.console.out)-max.lines," lines ommited...")))
} else {
txt = merge.lines(c("You successfully solved the chunk!",
uk$log$chunk.console.out))
}
updateAceEditor(app$session, ck$nali$console, value=txt,mode="r")
proceed.with.successfuly.checked.chunk(uk)
}
}
#cat("\nend check.shiny.chunk.ui\n")
return(ret)
}
proceed.with.successfuly.checked.chunk = function(uk,opts=rt.opts()) {
restore.point("proceed.with.successfuly.checked.chunk")
ck = uk$ck
uk$solved = TRUE
# If we have precomp=TRUE, it is often sensible to replace
# user solution with sample solution
# A replace.sol chunk option takes precedence over global problem set option
if (!is.null(ck$args[["replace.sol"]])) {
replace.sol = ck$args[["replace.sol"]]
} else {
replace.sol = isTRUE(opts$replace.sol)
}
if (isTRUE(replace.sol)) {
uk$stud.code = ck$sol.txt
}
# if (is.last.chunk.of.ex(chunk.ind)) {
# ex.ind = ps$cdt$ex.ind[chunk.ind]
# if (!isTRUE(ps$precomp))
# ps$edt$ex.final.env[[ex.ind]] = copy.task.env(ps$task.env)
# }
uk$mode = "output"
update.chunk.ui(uk)
# # set the next chunk to edit mode
# if (chunk.ind < NROW(ps$cdt)) {
# if (ps$cdt$ex.ind[chunk.ind] == ps$cdt$ex.ind[chunk.ind+1] &
# !ps$cdt$is.solved[chunk.ind+1]) {
#
# #cat("update next chunk...")
# ps$cdt$mode[chunk.ind+1] = "input"
# update.chunk.ui(chunk.ind+1)
# }
# }
}
hint.shiny.chunk = function(uk, code=getInputValue(uk$ck$nali$editor), ...,opts=rt.opts(),app=getApp()) {
restore.point("hint.shiny.chunk")
if (is.null(code)) code = ""
uk$stud.code = code
chunk.is.selected(uk)
if (!isTRUE(opts$hint.noeval)) {
if (!identical(uk$stud.code,uk$last.check.code))
check.chunk(uk,opts=opts)
}
txt = tryCatch(merge.lines(
capture.output(run.chunk.hint(uk=uk, opts=opts))
),
error = function(e) {merge.lines(as.character(e))}
)
txt = paste0("Hint: ", txt)
updateAceEditor(app$session, uk$ck$nali$console, value=txt, mode="text")
update.ups.hint.shown(uk)
}
help.shiny.chunk = function(uk, cursor=NULL, selection="",..., app=getApp()) {
chunk.is.selected(uk)
envir=get.task.env(ts=uk); in.R.console=is.null(uk$nali$console)
restore.point("help.shiny.chunk")
if (selection == "") {
txt = sep.lines(ps$code)
txt = txt[cursor$row+1]
txt = word.at.pos(txt, pos=cursor$column+1)
} else {
txt = selection
}
if (is.null(txt) | isTRUE(nchar(txt)==0)) {
updateAceEditor(app$session, uk$ck$nali$console, value="No R command selected to show help for.", mode="text")
return()
}
help = get.help.txt(txt)
# To do: replace special characters in a better manner
help = iconv(help, to='ASCII//TRANSLIT')
#Encoding(help) = "UTF8"
updateAceEditor(app$session, uk$ck$nali$console, value=help, mode="text")
return()
}
restore.shiny.chunk = function(uk,...,app=getApp()) {
restore.point("restore.shiny.chunk")
uk$stud.code = uk$ck$shown.txt
uk$solved = FALSE
updateAceEditor(app$session, uk$ck$nali$editor, value=uk$stud.code, mode="r")
updateAceEditor(app$session, uk$ck$console, value="restored originally shown code...", mode="text")
}
solution.shiny.chunk = function(uk,...,app=getApp()) {
restore.point("solution.shiny.chunk")
uk$stud.code = uk$ck$sol.txt
updateAceEditor(app$session, uk$ck$nali$editor, value = uk$stud.code, mode="r")
updateAceEditor(app$session, uk$ck$nali$console, value = "Sample solution shown", mode="text")
}
# edit button is pressed
edit.shiny.chunk = function(uk, opts = rt.opts(),...) {
restore.point("edit.shiny.chunk")
ck = uk$ck
#browser()
#if (can.chunk.be.edited(ck)) {
if (TRUE) {
update.chunk.ui(uk=uk, mode="input")
} else {
nali = ck$nali
rtutorAlert(session,nali$alertOut,
title = "Cannot edit chunk",
message= uk$log$failure.message,
type = "info", append=FALSE
)
}
}
chunk.to.html = function(uk,txt = uk$stud.code, opts=rt.opts(), envir=get.task.env(ts=uk), eval=TRUE, success.message=isTRUE(uk$solved), echo=TRUE, nali=NULL, quiet=TRUE) {
restore.point("chunk.to.html")
#if (is.null(txt))
# return("")
if (is.null(txt)) txt = ""
ck = uk$ck
# Adapt output text
if (paste0(txt,collapse="\n") == "")
txt = "# Press 'edit' to enter your code."
if (ck$num.e>0) {
if (success.message) {
add = c("# Great, solved correctly!")
if (opts$show.points) {
points = ck$max.points
if (points==1) {
add = paste0(add, " (1 point)")
} else if (points>0) {
add = paste0(add, " (",points, " points)")
}
}
txt = c(add,txt)
} else {
txt = c("# Not yet solved...",txt)
echo = TRUE
}
}
# Get output arguments
args = opts$chunk.out.args
if (length(ck$args)>0) {
args[names(ck$args)] = ck$args
}
args$eval = eval
args$echo = echo
header = paste0("```{r '",ck$id,"'",chunk.opt.list.to.string(args,TRUE),"}")
library(knitr)
library(markdown)
txt = c(header,sep.lines(txt),"```")
#all.parent.env(task.env)
html ="Evaluation error!"
if (opts$use.secure.eval) {
html = try(
RTutor::rtutor.eval.secure(quote(
knitr::knit2html(text=txt, envir=envir,fragment.only = TRUE,quiet = quiet)
), envir=environment())
)
} else {
html = try(
knitr::knit2html(text=txt, envir=envir,fragment.only = TRUE,quiet = quiet)
)
}
if (is(html, "try-error")) {
html = as.character(html)
}
restore.point("chunk.to.html.knit2html")
nali = ck$nali
# Add syntax highlightning
if (!is.null(nali$chunkUI)) {
html = paste0(paste0(html,collapse="\n"),"\n",
"<script>$('#",nali$chunkUI," pre code').each(function(i, e) {hljs.highlightBlock(e)});</script>")
}
html
}
default.chunk.out.args = function(...) {
args = list(fig.width=6.5, fig.height=4.5, fig.align='center', "warning"=FALSE, cache=FALSE, collapse=TRUE, comment=NA)
given = list(...)
args[names(given)] = given
args
}
chunk.is.selected = function(uk, ps = get.ps()) {
ps$task.ind = uk$task.ind
task.is.selected(uk)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.