Support out.width|height|extra for office outputs

[atusy]

This PR implments hook_plot_md_pandoc() and adds support for out.width, out.height, and out.extra for office outputs (e.g., rmarkdown::word_document). It will close #1478.

Pandoc supports resizing images via link_attributes extention (https://www.pandoc.org/MANUAL.html#images).

For example,

![](foo.png){width=300 height=300}

will resize "foo.png" to 300 pixels by 300 pixels.

Thus, I decided to assign out.width and out.height to width and height attributes within curly braces {}.

I also decided to put out.extra into curly braces, so that we can use it when Pandoc implements some more features via link_attributes.

fig.align is still not supported and thus is coerced to "default" with warning when specified.

Example

Output Docx

Source Rmd

---
output: word_document
---

```{r}
x <- knitr::include_graphics(system.file("img", "Rlogo.png", package="png"))
x
```

```{r, out.width=100, out.height=100}
x
```

```{r, out.extra="width=200 height=200"}
x
```

[atusy]

Among docx, pptx, rtf, and odt, pptx is the only format that does not support width and height.
Do we need warning when output is pptx and out.width and out.height are specified?

[yihui]

This is great! I have hoped to do this two years ago: #1478. Thanks a lot for the help!

[yihui]

pptx is the only format that does not support width and height.

@jkr Is there a chance that you could support the width and height attributes for images in pptx output? Thank you!

[atusy]

Cancelled the Travis build as I forgot to skip it via commit message.

[cderv]

For reference, there is an open issue in pandoc about attributes for pptx image links. see jgm/pandoc#4586

[irad94]

I don't understand how to include this in my code. I tried to put in inside a code chunk and run it but nothing changes and i need to resize a plot (from ggplot) to an MS output without ruin it.

[atusy]

@irad94

Give me reproducible example to help you.

It works under my environment.

Example Rmd

---
output: word_document
---

```{r}
ggplot2::qplot(1,1)
```


```{r, out.width=100, out.height=100}
ggplot2::last_plot()
```

[irad94]

I was reading yesterday that this has something to be with the hook function from knitr package but i have no idea of how include that in my code. I took your example but it doesn't work in my environment. I don't know if I have to load something or configure anything in my Rstudio.

I tried to put this whole code inside a chunk but it doesn't work:
9cd4903

I took the reference from here: https://yihui.name/knitr/hooks/ but I still dont understand how to include the hooks in my enviroment or something. It has to be put in a chunk or inline or how?

Thanks for the help.

[atusy]

I think requirements are latest knitr on GitHub, and possibly Pandoc version.

You can check the latter by rmarkdown::pandoc_version().

hooks

Is this something you do?

knitr::knit_hooks$set(
  plot = knitr:::hook_plot_md_pandoc
)

[irad94]

I was definitely not doing that. I have pandoc version 2.7.3 and Knitir 1.24

I tried to put your suggestion inside a chunk and it says "object 'hook_plot_md_pandoc' not found".

I'm sorry to bother with this kind of newbie questions but I can't get the whole rmarkdown trick yet. What should I do? Is there somethin that i have to install?

This is simply what I'm trying to do:

---
title: "Untitled"
author: "Irad Olivares Rivas"
date: "28/8/2019"
output: word_document
---
{r configure}
library(knitr)

hook_plot_md = function(x, options) {
  # if not using R Markdown v2 or output is HTML, just return v1 output
  if (is.null(to <- pandoc_to()) || is_html_output(to))
    return(hook_plot_md_base(x, options))
  if ((options$fig.show == 'animate' || is_tikz_dev(options)) && is_latex_output())
    return(hook_plot_tex(x, options))
  office_output = to %in% c('docx', 'pptx', 'rtf', 'odt')
  if (!is.null(options$out.width) || !is.null(options$out.height) ||
      !is.null(options$out.extra) || options$fig.align != 'default' ||
      !is.null(options$fig.subcap) || options$fig.env != 'figure') {
    if (is_latex_output()) {
      # Pandoc < 1.13 does not support \caption[]{} so suppress short caption
      if (is.null(options$fig.scap)) options$fig.scap = NA
      return(hook_plot_tex(x, options))
    }
    if (office_output) {
      if (options$fig.align != 'default') {
        warning('Chunk options fig.align is not supported for ', to, ' output')
        options$fig.align = 'default'
      }
      return(hook_plot_md_pandoc(x, options))
    }
  }
  if (options$fig.show == 'hold' && office_output) {
    warning('The chunk option fig.show="hold" is not supported for ', to, ' output')
    options$fig.show = 'asis'
  }
  hook_plot_md_base(x, options)
}
hook_plot_md_base = function(x, options) {
  if (options$fig.show == 'animate') return(hook_plot_html(x, options))
  base = opts_knit$get('base.url') %n% ''
  cap = .img.cap(options)
  alt = .img.cap(options, alt = TRUE)
  w = options[['out.width']]; h = options[['out.height']]
  s = options$out.extra; a = options$fig.align
  ai = options$fig.show == 'asis'
  lnk = options$fig.link
  pandoc_html = cap != '' && is_html_output()
  in_bookdown = isTRUE(opts_knit$get('bookdown.internal.label'))
  plot1 = ai || options$fig.cur <= 1L
  plot2 = ai || options$fig.cur == options$fig.num
  if (is.null(w) && is.null(h) && is.null(s) && a == 'default' && !(pandoc_html && in_bookdown)) {
    # append <!-- --> to ![]() to prevent the figure environment in these cases
    nocap = cap == '' && !is.null(to <- pandoc_to()) && !grepl('^markdown', to) &&
      (options$fig.num == 1 || ai) && !grepl('-implicit_figures', pandoc_from())
    res = sprintf('![%s](%s%s)', cap, base, .upload.url(x))
    if (!is.null(lnk) && !is.na(lnk)) res = sprintf('[%s](%s)', res, lnk)
    res = paste0(res, if (nocap) '<!-- -->' else '', if (is_latex_output()) ' ' else '')
    return(res)
  }
  add_link = function(x) {
    if (is.null(lnk) || is.na(lnk)) return(x)
    sprintf('<a href="%s" target="_blank">%s</a>', lnk, x)
  }
  # use HTML syntax <img src=...>
  if (pandoc_html) {
    d1 = if (plot1) sprintf('<div class="figure"%s>\n', css_text_align(a))
    d2 = sprintf('<p class="caption">%s</p>', cap)
    img = sprintf(
      '<img src="%s" alt="%s" %s />',
      paste0(opts_knit$get('base.url'), .upload.url(x)), alt, .img.attr(w, h, s)
    )
    img = add_link(img)
    # whether to place figure caption at the top or bottom of a figure
    if (isTRUE(options$fig.topcaption)) {
      paste0(d1, if (ai || options$fig.cur <= 1) d2, img, if (plot2) '</div>')
    } else {
      paste0(d1, img, if (plot2) paste0('\n', d2, '\n</div>'))
    }
  } else add_link(.img.tag(
    .upload.url(x), w, h, alt,
    c(s, sprintf('style="%s"', css_align(a)))
  ))
}
hook_plot_md_pandoc = function(x, options) {
  if (options$fig.show == 'animate') return(hook_plot_html(x, options))
  base = opts_knit$get('base.url') %n% ''
  cap = .img.cap(options)
  at = sprintf(
    "{%s}",
    paste(
      c(
        sprintf("width=%s", options[['out.width']]),
        sprintf("height=%s", options[['out.height']]),
        options[['out.extra']]
      ),
      collapse = " "
    )
  )
  sprintf('![%s](%s%s)%s', cap, base, .upload.url(x), at)
}
css_align = function(align) {
  sprintf('display: block; margin: %s;', switch(
    align, left = 'auto auto auto 0', center = 'auto', right = 'auto 0 auto auto'
  ))
}
css_text_align = function(align) {
  if (align == 'default') '' else sprintf(' style="text-align: %s"', align)
}
# turn a class string "a b" to c(".a", ".b") for Pandoc fenced code blocks
block_class = function(x) {
  if (length(x) > 0) gsub('^[.]*', '.', unlist(strsplit(x, '\\s+')))
}
# concatenate block attributes (including classes) for Pandoc fenced code blocks
block_attr = function(attr, class = NULL, lang = NULL) {
  x = c(block_class(class), attr)
  if (length(x) == 0) return(lang)
  x = c(sprintf('.%s', lang), x)
  paste0('{', paste0(x, collapse = ' '), '}')
}
#' @rdname output_hooks
#' @export
#' @param strict Boolean; whether to use strict markdown or reST syntax. For markdown, if
#'   \code{TRUE}, code blocks will be indented by 4 spaces, otherwise they are
#'   put in fences made by three backticks. For reST, if \code{TRUE}, code is
#'   put under two colons and indented by 4 spaces, otherwise it is put under the
#'   \samp{sourcecode} directive (this is useful for e.g. Sphinx).
#' @param fence_char A single character to be used in the code blocks fence.
#'   This can be e.g. a backtick or a tilde, depending on your Markdown rendering
#'   engine.
render_markdown = function(strict = FALSE, fence_char = '`') {
  set_html_dev()
  opts_knit$set(out.format = 'markdown')
  fence = paste(rep(fence_char, 3), collapse = '')
  # four spaces lead to <pre></pre>
  hook.t = function(x, options, attr = NULL, class = NULL) {
    # this code-block duplicated from hook.t()
    if (strict) {
      paste('\n', indent_block(x), '', sep = '\n')
    } else {
      x = one_string(c('', x))
      r = paste0('\n', fence_char, '{3,}')
      if (grepl(r, x)) {
        l = attr(gregexpr(r, x)[[1]], 'match.length')
        l = max(l)
        if (l >= 4) fence = paste(rep(fence_char, l), collapse = '')
      }
      paste0('\n\n', fence, block_attr(attr, class), x, fence, '\n\n')
    }
  }
  hook.o = function(class) {
    force(class)
    function(x, options) {
      hook.t(x, options, options[[paste0('attr.', class)]], options[[paste0('class.', class)]])
    }
  }
  hook.r = function(x, options) {
    language = tolower(options$engine)
    if (language == 'node') language = 'javascript'
    if (!options$highlight) language = 'text'
    attrs = block_attr(options$attr.source, options$class.source, language)
    paste0('\n\n', fence, attrs, '\n', x, fence, '\n\n')
  }
  hooks = list()
  for (i in c('output', 'warning', 'error', 'message')) hooks[[i]] = hook.o(i)
  knit_hooks$set(hooks)
  knit_hooks$set(
    source = function(x, options) {
      x = hilight_source(x, 'markdown', options)
      (if (strict) hook.t else hook.r)(one_string(c(x, '')), options)
    },
    inline = function(x) {
      if (is_latex_output()) .inline.hook.tex(x) else {
        .inline.hook(format_sci(x, if (length(pandoc_to()) == 1L) 'latex' else 'html'))
      }
    },
    plot = hook_plot_md,
    chunk = function(x, options) {
      x = gsub(paste0('[\n]{2,}(', fence, '|    )'), '\n\n\\1', x)
      x = gsub('[\n]+$', '', x)
      x = gsub('^[\n]+', '\n', x)
      if (isTRUE(options$collapse)) {
        x = gsub(paste0('\n([', fence_char, ']{3,})\n+\\1(', tolower(options$engine), ')?\n'), "\n", x)
      }
      if (is.null(s <- options$indent)) return(x)
      line_prompt(x, prompt = s, continue = s)
    }
  )
}
#' @param highlight Which code highlighting engine to use: if \code{pygments},
#'   the Liquid syntax is used (default approach Jekyll); if \code{prettify},
#'   the output is prepared for the JavaScript library \file{prettify.js}; if
#'   \code{none}, no highlighting engine will be used, and code blocks are simply
#'   indented by 4 spaces).
#' @param extra Extra tags for the highlighting engine. For \code{pygments}, this
#'   can be \code{'linenos'}; for \code{prettify}, it can be \code{'linenums'}.
#' @rdname output_hooks
#' @export
render_jekyll = function(highlight = c('pygments', 'prettify', 'none'), extra = '') {
  hi = match.arg(highlight)
  render_markdown(TRUE)
  if (hi == 'none') return()
  switch(hi, pygments = {
    hook.r = function(x, options) {
      paste0(
        '\n\n{% highlight ', tolower(options$engine), if (extra != '') ' ', extra,
        ' %}\n', x, '\n{% endhighlight %}\n\n'
      )
    }
    hook.t = function(x, options) paste0(
      '\n\n{% highlight text %}\n', x, '{% endhighlight %}\n\n'
    )
  }, prettify = {
    hook.r = function(x, options) {
      paste0(
        '\n\n<pre><code class="prettyprint ', extra, '">', escape_html(x),
        '</code></pre>\n\n'
      )
    }
    hook.t = function(x, options) paste0(
      '\n\n<pre><code>', escape_html(x), '</code></pre>\n\n'
    )
  })
  knit_hooks$set(source = function(x, options) {
    x = one_string(hilight_source(x, 'markdown', options))
    hook.r(x, options)
  }, output = hook.t, warning = hook.t, error = hook.t, message = hook.t)
}

knitr::knit_hooks$set(
  plot = knitr:::hook_plot_md_pandoc
)

{r pressure, echo=FALSE, out.width="50%", out.width="50%"}

plot(pressure)

{r pressure, echo=FALSE}
plot(pressure)

Thanks again for your help.

[cderv]

@irad94 when you want to use a very new feature that has just be added (like this one which just has been merged), you need to install and work with the last development version.

remotes::install_github("yihui/knitr")

Then you can use the feature. As you see in comment above, you just have to use the chunk option to set a size

---
output: word_document
---

```{r}
ggplot2::qplot(1,1)
```


```{r, out.width=100, out.height=100}
ggplot2::last_plot()
```

There is no need here to set some hook. Generally, you can't take some internal from a PR and apply it to your current code with ease.

I would advice to just install the last dev version of knitr and try as @atusy showed you.

Hope it helps

[irad94]

Thank you very much! I didn't know that.

I have no much time since started to learn about all this world and I really thank your advice.

This really worked for me.

Thanks to all of you.