使用列表图创建一个降价作为轮播,而不是一个一个地相互顶部

问题描述 投票:0回答:2

嗨,我有一个包含绘图列表的 Markdown,我希望将其绘制在可以从左向右滚动的单个区域中。我尝试使用 slickR 但图像是空白的。

这是一个可重现的代码。

---
title: "test"
output: html_document
editor_options: 
  chunk_output_type: console
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(ggplot2)
library(htmlwidgets)
library(slickR)
library(plotly)
library(htmltools)
```

```{r fig=TRUE,fig.width=20, fig.height=14, echo=FALSE, include=TRUE, results='asis' }


ggplot_list <- list(
  ggplot(mtcars, aes(mpg, wt)) + geom_point() + ggtitle("Plot 1"),
  ggplot(mtcars, aes(hp, wt)) + geom_point() + ggtitle("Plot 2"),
  ggplot(mtcars, aes(qsec, wt)) + geom_point() + ggtitle("Plot 3")
)

# Convert ggplots to plotly 
plotly_list <- lapply(ggplot_list, plotly::plotly_build)

# Create a carousel using slickR
carousel_content <- tagList(lapply(plotly_list, function(p) {
  tags$div(style = "width:100%;height:400px;", p)
}))


# simulate loop - imagine if there were two list of plots 
for ( n in 1:2 ) {
slickR::slickR(carousel_content, height = 400)%>%
    print
}

```
r r-markdown
2个回答
1
投票

这是使用 swipeR 包的方法。

---
title: "Untitled"
output: html_document
date: "2023-05-05"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = TRUE)
library(ggplot2)
library(swipeR)
library(htmltools)
library(base64enc)
```

```{r}
g1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + ggtitle("Plot 1")
g2 <- ggplot(mtcars, aes(hp, wt)) + geom_point() + ggtitle("Plot 2")
g3 <- ggplot(mtcars, aes(qsec, wt)) + geom_point() + ggtitle("Plot 3")
ggsave("g1.png", g1)
ggsave("g2.png", g2)
ggsave("g3.png", g3)
g1b64 <- dataURI(file = "g1.png", mime = "image/png")
g2b64 <- dataURI(file = "g2.png", mime = "image/png")
g3b64 <- dataURI(file = "g3.png", mime = "image/png")
```

```{r}
wrapper <- swipeRwrapper(
  tags$img(src = g1b64, style = "width: 500px; margin: auto;"),
  tags$img(src = g2b64, style = "width: 500px; margin: auto;"),
  tags$img(src = g3b64, style = "width: 500px; margin: auto;")
)
swipeR(wrapper, height = "400px", navigationColor = "navy")
```

enter image description here


编辑

我忘了你想要plotly图形。这更容易:

---
title: "Untitled"
output: html_document
date: "2023-05-05"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, collapse = TRUE)
library(plotly)
library(swipeR)
library(htmltools)
```

```{r}
g1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + ggtitle("Plot 1")
g2 <- ggplot(mtcars, aes(hp, wt)) + geom_point() + ggtitle("Plot 2")
g3 <- ggplot(mtcars, aes(qsec, wt)) + geom_point() + ggtitle("Plot 3")
```

```{r}
wrapper <- swipeRwrapper(
  tags$div(style = "width: 500px; margin: auto;", ggplotly(g1)),
  tags$div(style = "width: 500px; margin: auto;", ggplotly(g2)),
  tags$div(style = "width: 500px; margin: auto;", ggplotly(g3))
)
swipeR(wrapper, height = "400px", navigationColor = "navy")
```

enter image description here


0
投票

如果不需要plotly,这可能是一个开始

---
title: "test"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(ggplot2)
library(slickR)
library(svglite)
```

```{r, echo = F }
ggplot_list <- list(
  ggplot(mtcars, aes(mpg, wt)) +
    geom_point() +
    ggtitle("Plot 1"),
  ggplot(mtcars, aes(hp, wt)) +
    geom_point() +
    ggtitle("Plot 2"),
  ggplot(mtcars, aes(qsec, wt)) +
    geom_point() +
    ggtitle("Plot 3")
)

ggplot_list_svg <- lapply(ggplot_list, function(x) {
  xmlSVG(
    {
      print(
        x
      )
    },
    standalone = TRUE
  )
})

suppressWarnings(slickR(ggplot_list_svg,
  slideId = "slick1",
  height = 600,
  width = "50%"
)) +
  settings(slidesToShow = 1, centerMode = TRUE)

```
© www.soinside.com 2019 - 2024. All rights reserved.