R/RMarkdown.R

In JuliaCall: Seamless Integration Between R and 'Julia'

check_rmd <- function(){
    isTRUE(getOption("knitr.in.progress"))
}

check_notebook <- function(){
    isTRUE(options()[['rstudio.notebook.executing']])
}

## This function is used at the beginning of the julia_call interface
## to eraze the previous outputs
output_reset <- function(){
    julia$current_text <- NULL
    julia$current_plot <- NULL
    julia$current_stdout <- NULL
}

## This function is used at the end of the julia_call interface
## to return the current output.
output_return <- function(){
    out <- NULL
    if (!is.null(julia$current_plot)) out <- julia$current_plot
    if (!is.null(julia$current_text)) out <- julia$current_text
    stdout <- julia$current_stdout

    structure(list(stdout = stdout, out = out), class = "JuliaOutput")
}

#' @importFrom knitr knit_print
#' @export
knit_print.JuliaOutput = function(x, ...) {
    wrap <- function(x) knitr::sew(x, options = knitr::opts_current$get())
    knitr::asis_output(paste(c(wrap(x$stdout), wrap(x$out)),
                             collapse = "\n"))
}

## This function is used at the beginning of Julia plot_display function
## we generate a figure name and return it to Julia,
## which could be later be used by Julia to save the plot.
## After saving the plot, Julia will call the finish_plot function.
begin_plot <- function(){
    options <- knitr::opts_current$get()
    if (is.null(options$Jfig.cur)) {
        number <- 1L
    }
    else {
        number <- options$Jfig.cur
    }
    if (is.null(options$dev)) options$dev <- "png"
    path <- knitr::fig_chunk(label = options$label,
                             ext = options$dev, number = paste0("J", number))
    .julia$pending_plot <- knitr::include_graphics(path, error = FALSE)
    .julia$pending_plot_number <- number
    path
}

## This function is used by Julia plot_display function
finish_plot <- function(){
    knitr::opts_current$set(Jfig.cur = .julia$pending_plot_number + 1L)
    julia$current_plot <- .julia$pending_plot
}

## This function is used by Julia text_display function
## x will be the text representation of the Julia result.
text_display <- function(x, options = knitr::opts_current$get()){
    if (nchar(x) > 0) {
        julia$current_text <- paste0(x, "\n")
    }
    else {
        julia$current_text <- x
    }
}

## This function is used by Julia @capture_out1
## x will be the stdout from Julia.
stdout_display <- function(x, options = knitr::opts_current$get()){
    julia$current_stdout <- x
}

## The idea of the engine is quite simple,
## we parse the Julia code line by line to see if it is a complete
## Julia command, if it is, evaluate it using julia_command function.
## then we will wrap the result into the document.
## Note that the result here is actually
## generated by function finish_plot or text_display and
## returned by output_return

#' Julia language engine in R Markdown
#'
#' Julia language engine in R Markdown
#'
#' @param options a list of chunk options
#'
#' @examples
#'
#' knitr::knit_engines$set(julia = JuliaCall::eng_juliacall)
#'
#' @export
eng_juliacall <- function(options) {
    code <- options$code

    if (!options$eval) {
        return(knitr::engine_output(options, paste(code, collapse = "\n"), ""))
    }

    if (!.julia$initialized) {
        engine.path <- if (is.list(options[["engine.path"]]))
            options[["engine.path"]][["julia"]]
        else
            options[["engine.path"]]

        if (is.character(engine.path)) {
            julia_setup(JULIA_HOME = engine.path)
        }
        else julia_setup()
    }

    julia_markdown_setup(notebook = check_notebook())

    doc <- list()
    buffer <- character()
    ss <- character()

    for (line in code) {
        buffer <- paste(c(buffer, line), collapse = "\n")
        ss <- paste(c(ss, line), collapse = "\n")

        if (length(buffer) && (!julia_call("JuliaCall.incomplete", buffer))) {

            out <- stdout_capture_command(buffer)

            if (options$results != 'hide' &&
                ((length(out$stdout) > 0 && nchar(out$stdout) > 0) ||
                (length(out$out) > 0) && nchar(out$out) > 0)) {
                if (length(options$echo) > 1L || options$echo) {
                    doc[[length(doc) + 1]] <- structure(list(src = ss), class = "source")
                    ss <- character()
                }
                doc[[length(doc) + 1]] <- out$stdout
                doc[[length(doc) + 1]] <- out$out
            }
            buffer <- character()
        }
    }
    if (length(ss) > 0) {
        if (length(options$echo) > 1L || options$echo) {
            doc[[length(doc) + 1]] <- structure(list(src = ss), class = "source")
            ss <- character()
        }
    }

    # print(doc)

    r <- knitr::engine_output(options, out = doc)

    if (!isTRUE(.julia$notebook)) return(r)
    # paste0(r, collapse = "\n")
    doc
}

stdout_capture_command <- function(buffer){
    buffer <- trimws(buffer, "right")
    ending <- if (endsWith(buffer, ";")) "end;" else "end"
    buffer <- paste(c("JuliaCall.@capture_out1 begin", buffer, ending),
                    collapse = "\n")
    tryCatch(julia_command(buffer),
             warning = function(w) w,
             error = function(e) stop(e))
}

#' Do setup for JuliaCall in RMarkdown documents and notebooks.
#'
#' \code{julia_markdown_setup} does the initial setup for JuliaCall in RMarkdown document and RStudio notebooks.
#'   The function should be invoked automatically most of the case.
#'   It can also be called explicitly in RMarkdown documents or notebooks.
#' @param ... The same arguments accepted by `julia_setup`.
#' @param notebook whether it is in RStudio notebook environment or not.
#'
#' @export
julia_markdown_setup <- function(..., notebook = TRUE){
    julia_setup(...)
    .julia$rmd <- TRUE
    .julia$notebook <- notebook
    julia_command("Base.pushdisplay(JuliaCall.rmd_display);")
}

#' (Deprecated) Do setup for julia chunks in RMarkdown notebooks.
#'
#' \code{julia_notebook_setup} is deprecated,
#'   use \code{julia_markdown_setup(notebook=TRUE)} instead.
#' @param ... The same arguments accepted by `julia_setup`.
#'
#' @export
julia_notebook_setup <- function(...){
    .Deprecated('julia_markdown_setup')
    julia_setup(...)
    .julia$rmd <- TRUE
    .julia$notebook <- TRUE
    julia_command("Base.pushdisplay(JuliaCall.rmd_display);")
}