R/hooks-latex.R

In knitr: A General-Purpose Package for Dynamic Report Generation in R

#' Default plot hooks for different output formats
#'
#' These hook functions define how to mark up graphics output in different
#' output formats.
#'
#' Depending on the options passed over, `hook_plot_tex` may return the
#' normal `\includegraphics{}` command, or `\input{}` (for tikz
#' files), or `\animategraphics{}` (for animations); it also takes many
#' other options into consideration to align plots and set figure sizes, etc.
#' Similarly, `hook_plot_html`, `hook_plot_md` and
#' `hook_plot_rst` return character strings which are HTML, Markdown, reST
#' code.
#'
#' For animations (i.e. when the chunk option `fig.show` is `'animate'`),
#' `hook_plot_tex` generates `\animategraphics{}` unless a hook function
#' has been provided via the chunk option `animation.hook` or the package option
#' `animation.fun`, in which case that function generates the LaTeX code instead.
#' It is called only once per chunk, with the filename of the last plot. The
#' built-in hooks (e.g. [hook_ffmpeg_html()]) generate HTML, and are
#' ignored for LaTeX output.
#'
#' In most cases we do not need to call these hooks explicitly, and they were
#' designed to be used internally. Sometimes we may not be able to record R
#' plots using [grDevices::recordPlot()], and we can make use of
#' these hooks to insert graphics output in the output document; see
#' [hook_plot_custom()] for details.
#' @param x Filename for the plot (a character string).
#' @param options A list of the current chunk options.
#' @rdname hook_plot
#' @return A character string of code, with plot filenames wrapped.
#' @references <https://yihui.org/knitr/hooks/>
#' @seealso [hook_plot_custom()]
#' @export
#' @examples # this is what happens for a chunk like this
#'
#' # <<foo-bar-plot, dev='pdf', fig.align='right'>>=
#' hook_plot_tex('foo-bar-plot.pdf', opts_chunk$merge(list(fig.align='right')))
#'
#' # <<bar, dev='tikz'>>=
#' hook_plot_tex('bar.tikz', opts_chunk$merge(list(dev='tikz')))
#'
#' # <<foo, dev='pdf', fig.show='animate', interval=.1>>=
#'
#' # 5 plots are generated in this chunk
#' hook_plot_tex('foo5.pdf', opts_chunk$merge(list(fig.show='animate',interval=.1,fig.cur=5, fig.num=5)))
hook_plot_tex = function(x, options) {
  # This function produces the image inclusion code for LaTeX.
  # optionally wrapped in code that resizes it, aligns it, handles it
  # as a subfigure, and/or wraps it in a float. Here is a road map of
  # the intermediate variables this function fills in (or leaves empty,
  # as needed), and an impression of their (possible) contents.
  #
  #     fig1,                   # \begin{...}[...]
  #       align1,               #   {\centering
  #         sub1,               #     \subfloat[...]{
  #           resize1,          #       \resizebox{...}{...}{
  #             tikz code       #         '\\input{chunkname.tikz}'
  #             or animate code #         or '\\animategraphics[size]{1/interval}{chunkname}{1}{fig.num}'
  #             or plain code   #         or '\\includegraphics[size]{chunkname}'
  #           resize2,          #       }
  #         sub2,               #     }
  #       align2,               #   }
  #     fig2                    #   \caption[...]{...\label{...}}
  #                             # \end{...}  % still fig2

  rw = options$resize.width
  rh = options$resize.height
  rc = options$resize.command
  resize1 = resize2 = ''
  if (is.null(rc)) {
    if (!is.null(rw) || !is.null(rh)) {
      resize1 = sprintf('\\resizebox{%s}{%s}{', rw %n% '!', rh %n% '!')
      resize2 = '} '
    }
  } else {
    # users can specify a custom "resize" command (we can use an arbitrary
    # command, e.g., framebox)
    resize1 = paste0('\\', rc, '{')
    resize2 = '} '
  }

  tikz = is_tikz_dev(options)

  a = options$fig.align
  fig.cur = options$fig.cur %n% 1L
  fig.num = options$fig.num %n% 1L
  animate = options$fig.show == 'animate'
  fig.ncol = options$fig.ncol %n% fig.num
  if (is.null(fig.sep <- options$fig.sep)) {
    fig.sep = character(fig.num)
    # add \newline after every fig.ncol figures; if the last figure is not the
    # last on its row, skip adding \newline (not necessary, but may be harmless)
    if (fig.ncol < fig.num)
      fig.sep[seq(fig.ncol, fig.num - (fig.num %% fig.ncol > 0), fig.ncol)] = '\\newline'
  }
  sep.cur = NULL

  # If this is a non-tikz animation, skip to the last fig.
  if (!tikz && animate && fig.cur < fig.num) return('')

  usesub = length(subcap <- options$fig.subcap) && fig.num > 1
  # multiple plots: begin at 1, end at fig.num
  ai = options$fig.show != 'hold'

  # TRUE if this picture is standalone or first in set
  plot1 = ai || fig.cur <= 1L
  # TRUE if this picture is standalone or last in set
  plot2 = ai || fig.cur == fig.num

  # open align code if this picture is standalone/first in set
  align1 = if (plot1)
    switch(a, left = '\n\n', center = '\n\n{\\centering ', right = '\n\n\\hfill{}', '\n')
  # close align code if this picture is standalone/last in set
  align2 = if (plot2)
    switch(a, left = '\\hfill{}\n\n', center = '\n\n}\n\n', right = '\n\n', '')

  # figure environment: caption, short caption, label
  cap = options$fig.cap
  scap = options$fig.scap
  fig1 = fig2 = ''
  mcap = fig.num > 1L && options$fig.show == 'asis' && !length(subcap)
  # initialize subfloat strings
  sub1 = sub2 = ''

  # Wrap in figure environment only if user specifies a caption
  if (length(cap) && !is.na(cap)) {
    lab = paste0(options$fig.lp, options$label)
    # If pic is standalone/first in set: open figure environment
    if (plot1) {
      pos = options$fig.pos
      if (pos != '' && !grepl('^[[{]', pos)) pos = sprintf('[%s]', pos)
      fig1 = sprintf('\\begin{%s}%s', options$fig.env, pos)
    }
    # Add subfloat code if needed
    if (usesub) {
      sub1 = sprintf('\\subfloat[%s%s]{', subcap, create_label(lab, '-', fig.cur, latex = TRUE))
      sub2 = '}'
      sep.cur = fig.sep[fig.cur]
      # when there are more separators than plots, add the first separator
      # before the first plot, then the (i+1)th separator to the i-th plot
      if (length(fig.sep) > fig.num) {
        if (plot1) sub1 = paste0(fig.sep[1], sub1)
        sep.cur = fig.sep[fig.cur + 1]
      }
      if (is.na(sep.cur)) sep.cur = NULL
    }

    # If pic is standalone/last in set:
    # * place caption with label
    # * close figure environment
    if (plot2) {
      if (is.null(scap) && !grepl('[{].*?[:.;].*?[}]', cap)) {
        scap = strsplit(cap, '[:.;]( |\\\\|$)')[[1L]][1L]
      }
      scap = if (is.null(scap) || is.na(scap)) '' else sprintf('[%s]', scap)
      cap = if (cap == '') '' else sprintf(
        '\\caption%s{%s}%s\n', escape_percent(scap), escape_percent(cap),
        create_label(lab, if (mcap) c('-', fig.cur), latex = TRUE)
      )
      note = options$fig.note
      note = if (is.null(note) || is.na(note) || note == '') '' else
        sprintf('%s\\figurenote{%s}\n', define_figurenote(), escape_percent(note))
      fig2 = sprintf('%s%s\\end{%s}\n', cap, note, options$fig.env)
    }
  } else if (pandoc_to(c('latex', 'beamer'))) {
    # use alignment environments for R Markdown latex output (\centering won't work)
    align.env = switch(a, left = 'flushleft', center = 'center', right = 'flushright')
    align1 = if (plot1) if (a == 'default') '\n' else sprintf('\n\n\\begin{%s}', align.env)
    align2 = if (plot2) if (a == 'default') '' else sprintf('\\end{%s}\n\n', align.env)
  }

  ow = options$out.width
  # maxwidth does not work with animations
  if (animate && identical(ow, '\\maxwidth')) ow = NULL
  if (is.numeric(ow)) ow = paste0(ow, 'px')
  size = paste(c(
    sprintf('width=%s', ow), sprintf('height=%s', options$out.height),
    sprintf('alt={%s}', escape_percent(options$fig.alt)), options$out.extra
  ), collapse = ',')

  paste0(
    fig1, align1, sub1, resize1,
    if (tikz) {
      sprintf('\\input{%s}', x)
    } else if (animate) {
      if (!is.null(fun <- animation_hook_tex(options))) fun(x, options) else {
        # \animategraphics{} should be inserted only *once*!
        aniopts = options$aniopts
        aniopts = if (is.na(aniopts)) NULL else gsub(';', ',', aniopts)
        size = paste(c(size, sprintf('%s', aniopts)), collapse = ',')
        if (nzchar(size)) size = sprintf('[%s]', size)
        sprintf('\\animategraphics%s{%s}{%s}{%s}{%s}', size, 1 / options$interval,
                sub(sprintf('%d$', fig.num), '', sans_ext(x)), 1L, fig.num)
      }
    } else {
      if (nzchar(size)) size = sprintf('[%s]', size)
      res = sprintf(
        '\\includegraphics%s{%s} ', size,
        if (getOption('knitr.include_graphics.ext', FALSE)) x else sans_ext(x)
      )
      lnk = options$fig.link
      if (is.null(lnk) || is.na(lnk)) res else sprintf('\\href{%s}{%s}', lnk, res)
    },

    resize2, sub2, sep.cur, align2, fig2
  )
}

# Find the animation hook to be used for LaTeX output. Contrary to
# hook_animation(), this returns NULL unless the user has provided a hook
# function of their own, in which case hook_plot_tex() falls back to
# \animategraphics{}. The built-in hooks generate HTML, and used to be ignored
# for LaTeX output, so they must keep being ignored here.
animation_hook_tex = function(options) {
  fun = options$animation.hook
  if (!is.function(fun)) fun = opts_knit$get('animation.fun')
  if (!is.function(fun)) return()
  for (h in .animation_hooks()) if (identical(fun, h)) return()
  fun
}

# provide a default \figurenote command (for the chunk option fig.note) the
# first time it is needed in a document; \providecommand is a no-op if the user
# has defined \figurenote in the preamble (e.g. via \newcommand), so this both
# works out of the box and stays customizable; emitting it only once avoids
# repeating the long definition before every figure note
define_figurenote = function() {
  if (isTRUE(.knitEnv$fig.note.defined)) return('')
  .knitEnv$fig.note.defined = TRUE
  '\\providecommand{\\figurenote}[1]{\\vspace{2pt}\\par\\raggedright\\footnotesize\\emph{#1}}\n'
}

# % -> \%, but do not touch \%
escape_percent = function(x) gsub('(?<!\\\\)%', '\\\\%', x, perl = TRUE)

.chunk.hook.tex = function(x, options) {
  ai = output_asis(x, options)
  col = if (!ai) paste0(
    color_def(options$background), if (!is_tikz_dev(options)) '\\color{fgcolor}'
  )
  k1 = paste0(col, '\\begin{kframe}\n')
  k2 = '\\end{kframe}'
  x = .rm.empty.envir(paste0(k1, sub('^\n+', '', x), k2))
  size = if (options$size == 'normalsize') '' else sprintf('\\%s', options$size)
  if (!ai) {
    # if the chunk content starts with \n, don't add \n; similarly, if it ends with \n, don't append \n
    n1 = n2 = '\n'
    if (grepl('^\\s*\n', x)) n1 = ''
    if (grepl('\n\\s*$', x)) n2 = ''
    x = sprintf('\\begin{knitrout}%s%s%s%s\\end{knitrout}', size, n1, x, n2)
  }
  if (options$split) {
    name = fig_path('.tex', options, NULL)
    if (!file.exists(dirname(name)))
      dir.create(dirname(name))
    write_utf8(x, name)
    sprintf('\\input{%s}', name)
  } else x
}

# rm empty kframe and verbatim environments
.rm.empty.envir = function(x) {
  x = gsub('\\\\begin\\{(kframe)\\}\\s*\\\\end\\{\\1\\}', '', x)
  gsub('\\\\end\\{(verbatim|alltt)\\}\\s*\\\\begin\\{\\1\\}[\n]?', '', x)
}

# inline hook for tex
.inline.hook.tex = function(x) {
  if (is.numeric(x)) {
    x = format_sci(x, 'latex')
    i = grep('[}]', x)
    x[i] = sprintf('\\ensuremath{%s}', x[i])
    # why \text{}: https://github.com/yihui/knitr/issues/348
    if (getOption('OutDec') != '.') x = sprintf('\\text{%s}', x)
  }
  .inline.hook(x)
}

.verb.hook = function(x)
  one_string(c('\\begin{verbatim}', sub('\n$', '', x), '\\end{verbatim}', ''))
.color.block = function(color1 = '', color2 = '') {
  function(x, options) {
    x = gsub('\n*$', '', x)
    x = escape_latex(x, newlines = TRUE, spaces = TRUE)
    # babel might have problems with "; see http://stackoverflow.com/q/18125539/559676
    x = gsub('"', '"{}', x)
    sprintf('\n\n{\\ttfamily\\noindent%s%s%s}', color1, x, color2)
  }
}

#' Set or get output hooks for different output formats
#'
#' The `render_*()` functions set built-in output hooks for LaTeX, HTML,
#' Markdown, reStructuredText, AsciiDoc, and Textile. The `hooks_*()`
#' functions return a list of the output hooks for the corresponding format.
#'
#' There are three variants of Markdown documents: ordinary Markdown
#' (`render_markdown(strict = TRUE)`, which calls
#' `hooks_markdown(strict = TRUE)`), extended Markdown (e.g., GitHub
#' Flavored Markdown and Pandoc; `render_markdown(strict = FALSE)`, which
#' calls `hooks_markdown(strict = FALSE)`), and Jekyll (a blogging system
#' on GitHub; `render_jekyll()`, which calls `hooks_jekyll()`).
#'
#' For LaTeX output, there are three variants: \pkg{knitr}'s default style
#' (`render_latex()`, which calls `hooks_latex()` and uses the LaTeX
#' \pkg{framed} package), Sweave style (`render_sweave()`, which calls
#' `hooks_sweave()` and uses \file{Sweave.sty}), and listings style
#' (`render_listings()`, which calls `hooks_listings()` and uses LaTeX
#' \pkg{listings} package).
#'
#' Default HTML output hooks are set by `render_html()` (which calls
#' `hooks_html()`); `render_rst()` (which calls `hooks_rst()`) is
#' for reStructuredText; `render_textile()` (which calls
#' `hooks_textile()`) is for Textile, and `render_asciidoc()` (which
#' calls `hooks_asciidoc()`) is AsciiDoc.
#'
#' The `render_*()` functions can be used before `knit()` or in the
#' first chunk of the input document (ideally this chunk has options
#' `include = FALSE` and `cache = FALSE`) so that all the following
#' chunks will be formatted as expected.
#'
#' You can also use \code{\link{knit_hooks}} to set the format's hooks with the
#' `hooks_*()` functions; see references for more info on further
#' customizing output hooks.
#'
#' @rdname output_hooks
#' @return `NULL` for `render_*` functions; corresponding hooks are
#'   set as a side effect. A list of output hooks for `hooks_*()`
#'   functions.
#' @export
#' @references See output hooks in <https://yihui.org/knitr/hooks/>, and
#'   some examples in
#'   <https://pkg.yihui.org/rmarkdown-cookbook/output-hooks.html>
#'
#'   Jekyll and Liquid:
#'   <https://github.com/jekyll/jekyll/wiki/Liquid-Extensions>; prettify.js:
#'   <https://code.google.com/archive/p/google-code-prettify>
#' @examples
#' # below is pretty much what knitr::render_markdown() does:
#' knitr::knit_hooks$set(knitr::hooks_markdown())
#'
#' # you can retrieve a subset of the hooks and set them, e.g.,
#' knitr::knit_hooks$set(knitr::hooks_markdown()["source"])
#'
#' knitr::knit_hooks$restore()
render_latex = function() {
  opts_chunk$set(out.width = '\\maxwidth', dev = 'pdf')
  opts_knit$set(out.format = 'latex')
  h = opts_knit$get('header')
  if (!nzchar(h['framed'])) set_header(framed = .header.framed)
  if (!nzchar(h['highlight'])) set_header(highlight = .header.hi.tex)
  knit_hooks$set(hooks_latex())
}

#' @rdname output_hooks
#' @export
hooks_latex = function() {
  list(
    source = function(x, options) {
      x = hilight_source(x, 'latex', options)
      if (options$highlight) {
        if (options$engine == 'R' || x[1] != '\\noindent') {
          one_string(c('\\begin{alltt}', x, '\\end{alltt}', ''))
        } else {
          if ((n <- length(x)) > 4) x[n - 2] = sub('\\\\\\\\$', '', x[n - 2])
          one_string(c(x, ''))
        }
      } else .verb.hook(x)
    },
    output = function(x, options) {
      if (output_asis(x, options)) {
        paste0('\\end{kframe}', x, '\\begin{kframe}')
      } else .verb.hook(x)
    },
    warning = .color.block('\\color{warningcolor}{', '}'),
    message = .color.block('\\itshape\\color{messagecolor}{', '}'),
    error = .color.block('\\bfseries\\color{errorcolor}{', '}'),
    inline = .inline.hook.tex, chunk = .chunk.hook.tex,
    plot = function(x, options) {
      # escape plot environments from kframe
      paste0('\\end{kframe}', hook_plot_tex(x, options), '\n\\begin{kframe}')
    }
  )
}

#' @rdname output_hooks
#' @export
render_sweave = function() {
  opts_chunk$set(highlight = FALSE, comment = NA, prompt = TRUE) # mimic Sweave settings
  opts_knit$set(out.format = 'sweave')
  test_latex_pkg('Sweave', file.path(R.home('share'), 'texmf', 'tex', 'latex', 'Sweave.sty'))
  set_header(framed = '', highlight = '\\usepackage{Sweave}')
  knit_hooks$set(hooks_sweave())
}

#' @param envirs Names of LaTeX environments for code input, output, and chunk.
#' @rdname output_hooks
#' @export
hooks_sweave = function(envirs = c('Sinput', 'Soutput', 'Schunk')) {
  # wrap source code in the Sinput environment, output in Soutput
  hook.i = function(x, options) one_string(c(
    sprintf('\\begin{%s}', envirs[1]), hilight_source(x, 'sweave', options),
    sprintf('\\end{%s}', envirs[1]), ''
  ))
  hook.s = function(x, options) {
    if (output_asis(x, options)) return(x)
    sprintf('\\begin{%s}\n%s\\end{%s}\n', envirs[2], x, envirs[2])
  }
  hook.c = function(x, options) {
    if (output_asis(x, options)) return(x)
    sprintf('\\begin{%s}\n%s\\end{%s}', envirs[3], x, envirs[3])
  }
  list(
    source = hook.i, output = hook.s, warning = hook.s, message = hook.s,
    error = hook.s, plot = hook_plot_tex, inline = .inline.hook.tex, chunk = hook.c
  )
}

#' @rdname output_hooks
#' @export
render_listings = function() {
  opts_chunk$set(highlight = FALSE, comment = NA, prompt = FALSE) # mimic Sweave settings
  opts_knit$set(out.format = 'listings')
  test_latex_pkg('Sweavel', system.file('misc', 'Sweavel.sty', package = 'knitr'))
  set_header(framed = '', highlight = '\\usepackage{Sweavel}')
  knit_hooks$set(hooks_listings())
}

#' @rdname output_hooks
#' @export
hooks_listings = hooks_sweave

# may add textile, and many other markup languages

#' Some potentially useful document hooks
#'
#' A document hook is a function to post-process the output document.
#'
#' `hook_movecode()` is a document hook to move code chunks out of LaTeX
#' floating environments like `figure` and `table` when the chunks
#' were actually written inside the floats. This function is primarily designed
#' for LyX: we often insert code chunks into floats to generate figures or
#' tables, but in the final output we do not want the code to float with the
#' environments, so we use regular expressions to find out the floating
#' environments, extract the code chunks and move them out. To disable this
#' behavior, use a comment `\% knitr_do_not_move` in the floating
#' environment.
#' @rdname hook_document
#' @param x A character string (the whole output document).
#' @return The post-processed document as a character string.
#' @note These functions are hackish. Also note `hook_movecode()` assumes
#'   you to use the default output hooks for LaTeX (not Sweave or listings), and
#'   every figure/table environment must have a label.
#' @export
#' @references <https://yihui.org/knitr/hooks/>
#' @examples \dontrun{knit_hooks$set(document = hook_movecode)}
#' # see example 103 at https://github.com/yihui/knitr-examples
hook_movecode = function(x) {
  x = split_lines(x)
  res = split(x, cumsum(grepl('^\\\\(begin|end)\\{figure\\}', x)))
  x = split_lines(unlist(lapply(res, function(p) {
    if (length(p) <= 4 || !grepl('^\\\\begin\\{figure\\}', p[1]) ||
          length(grep('% knitr_do_not_move', p)) ||
          !any(grepl('\\\\begin\\{(alltt|kframe)\\}', p))) return(p)
    idx = c(1, grep('\\\\includegraphics', p))
    if (length(idx) <= 1) return(p) # no graphics
    if (length(i <- grep('\\{\\\\centering.*\\\\includegraphics', p))) {
      idx = c(idx, i - 1, j2 <- i + 1)
      for (j in j2) {
        while (p[j] != '}') idx = c(idx, j <- j + 1) # find } for {\\centering
      }
    }
    if (length(i <- grep('\\\\hfill\\{\\}.*\\\\includegraphics', p)))
      idx = c(idx, i - 1, i + 1)
    if (length(i <- grep('\\\\includegraphics.*\\\\hfill\\{\\}', p)))
      idx = c(idx, i - 1, i + 1)
    idx = sort(c(idx, seq(grep('\\\\caption', p), grep('\\\\label', p))))
    idx = unique(idx)
    p = one_string(c(p[-idx], p[idx]))
    gsub('\\\\end\\{(kframe)\\}\\s*\\\\begin\\{\\1\\}', '', p)
  }), use.names = FALSE))

  res = split(x, cumsum(grepl('^\\\\(begin|end)\\{table\\}', x)))
  res = one_string(unlist(lapply(res, function(p) {
    if (length(p) <= 4 || !grepl('^\\\\begin\\{table\\}', p[1]) ||
          length(grep('% knitr_do_not_move', p)) ||
          !any(grepl('\\\\begin\\{(alltt|kframe)\\}', p))) return(p)
    if (!any(grepl('\\\\label\\{.*\\}', p))) return(p)
    idx = c(1, seq(grep('\\\\caption', p), grep('\\\\label', p)))
    i0 = grep('\\\\begin\\{tabular\\}', p); i1 = grep('\\\\end\\{tabular\\}', p)
    for (i in seq_along(i0)) idx = c(idx, i0[i]:i1[i])
    idx = sort(idx)
    p = one_string(c(p[-idx], p[idx]))
    gsub('\\\\end\\{(kframe)\\}\\s*\\\\begin\\{\\1\\}', '', p)
  }), use.names = FALSE))
  .rm.empty.envir(res)
}