A proposal for HTML Widgets

[RLesur]

Here's a first draft for #58
After hundreds of trials and errors, I'm quite happy with these first results.

I spent most of the time on the HTML/JS implementation: here, the strategy is to use responsive iframes (these are scaled iframes embedded in containers with overflow: hidden). In order to synchronize the rendering process with both Paged.js and chrome_print(), I needed to enhance these responsive iframes with methods/events/promises: HTML Custom Element was the perfect tool. I've not worked on crosstalk but I guess this could be feasible.

I'm not yet satisfied by the R part: I'm not sure to have done the right choices. Since knitr/rmarkdown/htmltools/htmlwidgets is your garden, I let you decide how to implement this part.

I think this proposal could be extended to browsable objects or urls. There are still some features to implement (captions, aspect ratios...). But I would prefer having your review first.

[jjallaire]

FWIW I used iFrame Resizer in Distill and was quite happy with it: http://davidjbradshaw.github.io/iframe-resizer/

[RLesur]

I was unaware of iFrame Resizer. This looks awesome! I will give it a try. Thanks!

[r2evans]

@RLesur, I appreciate the effort you are putting into supporting widgets in rmarkdown. I'm trying this on plotly, and while it is much closer (something actually appears), it is offset and mis-scaled.

report.Rmd:

---
title: Sample `pagedown` Report
output:
  pagedown::html_paged: 
    css: ["default-page", "default"]
    toc: false
    number_sections: false
params:
  dat: !r NULL
  bins: !r NULL
---

```{r setup, echo = FALSE, include = FALSE}
stopifnot(!is.null(params$dat), !is.null(params$bins))
library(plotly)
plot_base <- function(x, b) {
  bins <- seq(min(x), max(x), length.out = b + 1)
  hist(x, breaks = bins, col = 'darkgray', border = 'white')
}
plot_plotly <- function(x, b) {
  bins <- list(start = min(x),
               end = max(x),
               size = (max(x) - min(x)) / b
               )
  plot_ly(x = ~x, type = "histogram", xbins = bins)
}
```

# Inputs

Input data:

- Number of bins: `r params$bins`
- Data sample: `r format(head(params$dat), digits=3)`

# Plots

A base plot:

```{r plot1, echo = FALSE}
plot_base(params$dat, params$bins)
```

A second plot:

```{r plot2, echo = FALSE}
plot_plotly(params$dat, params$bins)
```

On rendering, it shows (opposing pages):

devtools::session_info()

> devtools::session_info()
- Session info ---------------------------------------------------------------
 setting  value                       
 version  R version 3.5.3 (2019-03-11)
 os       Windows 10 x64              
 system   x86_64, mingw32             
 ui       RTerm                       
 language (EN)                        
 collate  English_United States.1252  
 ctype    English_United States.1252  
 tz       America/Los_Angeles         
 date     2019-07-04                  

- Packages -------------------------------------------------------------------
 package     * version date       lib source                          
 assertthat    0.2.0   2017-04-11 [1] CRAN (R 3.5.1)                  
 backports     1.1.2   2017-12-13 [1] CRAN (R 3.5.0)                  
 bookdown      0.11    2019-05-28 [1] CRAN (R 3.5.3)                  
 callr         2.0.4   2018-05-15 [1] CRAN (R 3.5.1)                  
 cli           1.0.1   2018-09-25 [1] CRAN (R 3.5.1)                  
 colorspace    1.3-2   2016-12-14 [1] CRAN (R 3.5.1)                  
 crayon        1.3.4   2017-09-16 [1] CRAN (R 3.5.1)                  
 crosstalk     1.0.0   2016-12-21 [1] CRAN (R 3.5.1)                  
 data.table    1.12.0  2019-01-13 [1] CRAN (R 3.5.2)                  
 desc          1.2.0   2018-05-01 [1] CRAN (R 3.5.1)                  
 devtools      2.0.2   2019-04-08 [1] CRAN (R 3.5.3)                  
 digest        0.6.18  2018-10-10 [1] CRAN (R 3.5.2)                  
 dplyr         0.8.0.1 2019-02-15 [1] CRAN (R 3.5.2)                  
 evaluate      0.14    2019-05-28 [1] CRAN (R 3.5.3)                  
 fs            1.2.6   2018-08-23 [1] CRAN (R 3.5.2)                  
 ggplot2     * 3.2.0   2019-06-16 [1] CRAN (R 3.5.3)                  
 glue          1.3.0   2018-07-17 [1] CRAN (R 3.5.2)                  
 gtable        0.2.0   2016-02-26 [1] CRAN (R 3.5.1)                  
 htmltools     0.3.6   2017-04-28 [1] CRAN (R 3.5.1)                  
 htmlwidgets   1.3     2018-09-30 [1] CRAN (R 3.5.3)                  
 httpuv        1.5.1   2019-04-05 [1] CRAN (R 3.5.3)                  
 httr          1.4.0   2018-12-11 [1] CRAN (R 3.5.2)                  
 jsonlite      1.6     2018-12-07 [1] CRAN (R 3.5.2)                  
 knitr         1.23    2019-05-18 [1] CRAN (R 3.5.3)                  
 labeling      0.3     2014-08-23 [1] CRAN (R 3.5.0)                  
 later         0.8.0   2019-02-11 [1] CRAN (R 3.5.3)                  
 lazyeval      0.2.1   2017-10-29 [1] CRAN (R 3.5.1)                  
 magrittr      1.5     2014-11-22 [1] CRAN (R 3.5.1)                  
 memoise       1.1.0   2017-04-21 [1] CRAN (R 3.5.1)                  
 mime          0.6     2018-10-05 [1] CRAN (R 3.5.2)                  
 munsell       0.5.0   2018-06-12 [1] CRAN (R 3.5.1)                  
 pagedown      0.2.9   2019-07-05 [1] Github (RLesur/pagedown@b703670)
 pillar        1.3.1   2018-12-15 [1] CRAN (R 3.5.2)                  
 pkgbuild      1.0.2   2018-10-16 [1] CRAN (R 3.5.2)                  
 pkgconfig     2.0.2   2018-08-16 [1] CRAN (R 3.5.1)                  
 pkgload       1.0.2   2018-10-29 [1] CRAN (R 3.5.2)                  
 plotly      * 4.8.0   2018-07-20 [1] CRAN (R 3.5.1)                  
 prettyunits   1.0.2   2015-07-13 [1] CRAN (R 3.5.1)                  
 processx      3.3.1   2019-05-08 [1] CRAN (R 3.5.3)                  
 promises      1.0.1   2018-04-13 [1] CRAN (R 3.5.1)                  
 ps            1.3.0   2018-12-21 [1] CRAN (R 3.5.3)                  
 purrr         0.2.5   2018-05-29 [1] CRAN (R 3.5.1)                  
 r2          * 0.9.2   2019-05-29 [1] local                           
 R6            2.4.0   2019-02-14 [1] CRAN (R 3.5.2)                  
 Rcpp          1.0.0   2018-11-07 [1] CRAN (R 3.5.1)                  
 remotes       2.0.2   2018-10-30 [1] CRAN (R 3.5.2)                  
 rlang         0.3.1   2019-01-08 [1] CRAN (R 3.5.2)                  
 rmarkdown   * 1.13    2019-05-22 [1] CRAN (R 3.5.3)                  
 rprojroot     1.3-2   2018-01-03 [1] CRAN (R 3.5.1)                  
 scales        1.0.0   2018-08-09 [1] CRAN (R 3.5.1)                  
 sessioninfo   1.1.1   2018-11-05 [1] CRAN (R 3.5.2)                  
 shiny         1.3.2   2019-04-22 [1] CRAN (R 3.5.3)                  
 stringi       1.3.1   2019-02-13 [1] CRAN (R 3.5.2)                  
 stringr       1.4.0   2019-02-10 [1] CRAN (R 3.5.2)                  
 testthat      2.0.0   2017-12-13 [1] CRAN (R 3.5.1)                  
 tibble        2.1.1   2019-03-16 [1] CRAN (R 3.5.3)                  
 tidyr         0.8.2   2018-10-28 [1] CRAN (R 3.5.2)                  
 tidyselect    0.2.5   2018-10-11 [1] CRAN (R 3.5.1)                  
 usethis       1.4.0   2018-08-14 [1] CRAN (R 3.5.2)                  
 viridisLite   0.3.0   2018-02-01 [1] CRAN (R 3.5.1)                  
 withr         2.1.2   2018-03-15 [1] CRAN (R 3.5.1)                  
 xfun          0.6     2019-04-02 [1] CRAN (R 3.5.3)                  
 xml2          1.2.0   2018-01-24 [1] CRAN (R 3.5.1)                  
 xtable        1.8-2   2016-02-05 [1] CRAN (R 3.5.1)                  
 yaml          2.2.0   2018-07-25 [1] CRAN (R 3.5.1)                  

[1] C:/Users/r2/R/win-library/3.5
[2] c:/R/R-3.5.3/library

[RLesur]

Thank you, @r2evans for your support! I really appreciate because from the beginning of pagedown this feature is the most difficult one (I spent so much hours on that).

In the current state of this PR, there is no default styling for widgets. Your example has highlighted for me the need for such a default styling.

In your example, you can add these chunk options, for instance:

A second plot:

```{r plot2, out.width="4in", out.height="4in", out.extra='style="margin:auto;"', echo = FALSE}
plot_plotly(params$dat, params$bins)
```

[r2evans]

I was hoping that chunk style options might mitigate it, but had not completely investigated it. Those options do in fact get it closer to "norm", now just aesthetic tweaks (e.g., font size).

Thank you!

[RLesur]

@medewitt I've seen (https://github.com/rstudio/pagedown/network) you're improving the branch. Do not hesitate to propose modifications. I'm interested in feedbacks/collaborations on this topic.

[medewitt]

@RLesur will do. We're tweaking the scaling for different htmlwidgets. Your scaling works beautifully for datatable objects. We're trying to customize a bit more the scaling for 'leaflet', 'dygraph', and 'highcharter' objects. If we have anything workable, we'll send a PR. Thanks for all of the work on this package!

[RLesur]

@medewitt Great news! I will resolve the current git conflicts.

[sahirmoosvi]

This is a really cool addition, I hope that it's pulled into the main release soon. Thank you for adding this! I think this has the potential to really transform my workflow. I could create an interactive report that I can share easily and anyone can print it into a nice pdf/printout when then want to.

I had the best luck doing CSS styling outside of the code chunk. But that may be a limitation of my CSS skills :). Here's a MWE in case it benefits anyone.

---
title: "2020W Student Registration"
output:
  html_document: default
  pagedown::html_paged: 
    css: ["default-fonts", "default-page", "default", "style.css"]
    toc: false
    number_sections: false
---

```{r}
library(tidyverse)
library(plotly)
```

<div style='display:inline; float:left; width:50%;'>
sda

sad


asda

</div>

<div style='display:inline; float:right; width:50%;'>
```{r, echo=FALSE, out.width='100%'}
test <- mtcars %>% 
  ggplot() +
  geom_line(aes(mpg, disp))

ggplotly(test)
```

</div>

[GitHunter0]

Hey @RLesur , great proposal, I'm really looking forward to this feature! It would be fantastic to be able to output plots from plotly and tables from DT and then share the static version as PDF, it would be a game changer.

[yihui]

Sorry it took so long to get back to this PR. My main question is about as_html_attrs(). All the rest of suggestions are optional; feel free to accept or discard. Thanks!

[yihui]

That's an interesting hack. Since eventually you'd need a list, perhaps we could document it that out.extra is expected to be a list? So that we don't need to introduce a new dependency or use a hack.

I can also support list values in knitr. It is easier to go from a list to a string than the other way around, e.g., I can generate id="foo" class="bar" from out.extra = list(id = "foo", class = "bar") in knitr.

BTW, what was the use case on your mind for out.extra? If you don't have a significant use case yet, perhaps we can support this option in the future as users request for it.

[sylvainDaubree]

Same as others, this functionnality would really fill a gap for me ! After a few tests with the code below :

• some issue with the scaling, but there's some getaround as listed above
• a problem with encoding (I am on windows, default encoding ISO-8859-1, forced on Rstudio to UTF-8, both files are utf-8
• in some cases (test2 and test3, there's a descending bar on the right on the graph, obviously not functionnal

thanks anyway,

test.R :

library(pagedown)
library(dplyr)
library(plotly)

Sys.setenv("HTTP_PROXY"="")
chrome_print("testPageDown2.Rmd") 

testPageDown2.Rmd :

title: "testPageDown2"
author: "Depp"
date: "01/06/2021"
output:
  pagedown::html_paged: 
    toc: true
    number_sections: false
---

```{r test1,echo=FALSE,message=FALSE}
diamonds %>%
  sample_n(100) %>% 
  plot_ly(x=~carat,y=~price,color=~cut) %>%
  add_markers() %>% 
  layout(xaxis=list(title="test titre àvec accenté plotly"))
```

```{r test2,echo=FALSE,message=FALSE, out.width="4in", out.height="4in", out.extra='style="margin:auto;"'}
diamonds %>%
  sample_n(100) %>% 
  plot_ly(x=~carat,y=~price,color=~cut) %>%
  add_markers() %>% 
  layout(xaxis=list(title="test titre àvec accenté plotly"))
```

```{r test3,echo=FALSE,message=FALSE, out.width="2in", out.height="2in"}
diamonds %>%
  sample_n(100) %>% 
  plot_ly(x=~carat,y=~price,color=~cut) %>%
  add_markers() %>% 
  layout(xaxis=list(title="test titre àvec accenté plotly"))
```


```{r test4,echo=FALSE,message=FALSE}
diamonds %>%
  sample_n(100) %>% 
  ggplot(aes(x=carat,y=price,color=cut)) +
  geom_point()+
  labs(x="test titre àvec accenté ggplot")
```

<div style='display:inline; float:left; width:50%;'>
sda

sad


asda

</div>

<div style='display:inline; float:right; width:50%;'>
```{r test5, echo=FALSE, out.width='100%'}
diamonds %>%
  sample_n(100) %>% 
  plot_ly(x=~carat,y=~price,color=~cut) %>%
  add_markers() %>% 
  layout(xaxis=list(title="test titre àvec accenté plotly"))
```

</div>