Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Plotly plot doesn't render within for loop of RMarkdown document

I'm trying to build a report dynamically that requires running a loop, and for each iteration printing some messages, tables, and a plot. I can get everything to work except for the plot.

example.rmd

```{r echo=FALSE, results='asis', fig.keep='all', message = FALSE, warning = FALSE}
library(knitr)
library(plotly)

for(i in 1:4){
  foo <- iris[sample(nrow(iris), 20), ]

  cat("\n")
  cat("# Iteration", i, "\n")

  # Print the first few lines
  print(kable(head(foo)))
  cat("\n")

  # Plot Sepal.Width vs Petal.Length using ggplotly()
  plt <- ggplot(foo, aes(x = Sepal.Width, y = Petal.Length))+geom_point()

  # plot(plt)  # <- this works
  # plot(ggplotly(plt))  # <- this doesn't work
  # ggplotly(plt)  # <- this doesn't work

  cat("\n")
}
```

enter image description here

How can I get the plotly plots to render in my report?

like image 507
Ben Avatar asked Apr 23 '18 22:04

Ben


1 Answers

Following this post on github about basically the same issue, I was able to put together this very hacky solution. Would love to find a better method.

```{r echo=FALSE, results='asis', fig.keep='all', message = FALSE, warning = FALSE}
library(knitr)
library(plotly)

# Build list of outputs
output <- list()
for(i in 1:4){
  foo <- iris[sample(nrow(iris), 20), ]

  # Header for iteration
  txt <- paste0("#Iteration ", i)
  output[[length(output) + 1L]] <- txt

  # Table of the first few lines
  tbl <- kable(head(foo))
  output[[length(output) + 1L]] <- tbl

  # Plot
  plt <- ggplotly(ggplot(foo, aes(x = Sepal.Width, y = Petal.Length))+geom_point())
  output[[length(output) + 1L]] <- plt
}

# Render the outputs
for(j in 1:length(output)){
  x <- output[[j]]

  if(inherits(x, "character")){
    cat("\n")
    cat(x)
  } else if(inherits(x, "knitr_kable")){
    cat("\n")
    print(x)
  }
  else {
    # print the html piece of the htmlwidgets
    cat("\n")
    cat(htmltools::renderTags(as.widget(x))$html)
  }
}
```

```{r echo=FALSE, messages=FALSE, warning=FALSE}
# Attach the Dependencies since they do not get included with renderTags(...)$html
deps <- lapply(
  Filter(f = function(x){inherits(x,"htmlwidget")}, x = output),
  function(hw){
    htmltools::renderTags(hw)$dependencies
  }
)
htmltools::attachDependencies(x = htmltools::tagList(), value = unlist(deps,recursive=FALSE))
```

enter image description here

like image 109
Ben Avatar answered Sep 20 '22 15:09

Ben