Related
I'm trying to generate a Word document with figures. I use {officedown} and {officer} packages. I need to do it dynamically, in a loop since I don't know how many figures there will be. This is my Rmarkdown code:
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
```
```{r}
block_toc(seq_id = "fig")
```
```{r results='asis'}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- lapply(seq_len(length(ttp)), function(i) {
fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]],
external_img(src = tmps[[i]], width = 6, height = 5)
)
})
do.call(block_list, fpars)
```
The problem is when I generate the table of figures in the rendered document. It looks like this:
An entry is kept together with the image itself, I don't know why.
I save temporary png files to be able to use them inside fpar function. Using plot function directly inside fpar causes bad effects. Maybe there's another/better way?
I found this construction useful, but unfortunately it puts captions under the figures by default. My goal is figure captions behave more like table captions, i.e. a caption is above a figure.
```{r fig.cap=unlist(titles)}
plot(iris[1:10, 1:2])
```
How can I generate the plots with captions dynamically with {officedown} or {officer} packages?
The only issue is about the last lapply, you need to put the image in a separate paragraph, so a for loop will be easier to stack 2 paragraphs into a list instead of 1 for each iteration.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- list()
for (i in seq_along(ttp)) {
fpars[[length(fpars)+1]] <- fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]]
)
fpars[[length(fpars)+1]] <- fpar(
external_img(src = tmps[[i]], width = 6, height = 5)
)
}
do.call(block_list, fpars)
```
This is an answer for "how to do it with officer" from scratch.
But the following is much more simple. There is an option fig.topcaption that do the same thing.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r fig.cap = "miaou", fig.topcaption=TRUE}
plot(cars)
```
```{r fig.cap = "ouaf", fig.topcaption=TRUE}
plot(cars)
```
No solution offered yet and cross-posted to RStudio community:
https://community.rstudio.com/t/rmarkdown-does-not-render-pdfs-as-batch/136316
I have a rmarkdown file that renders well in RStudio with the Knitr button or with rmarkdown() but does not render when rendered as part of a batch with purrr::walk() and being passed a parameter. The batch issue only occurs when fig.show="hold", out.width="50%" is included in a section of the rmarkdown file.
library(purrr)
library(tinytex)
SurveySet <- c(20,19,68,79,30,18,42)
purrr::walk(
.x = SurveySet,
~ rmarkdown::render(
input = "Test.Rmd",
output_file = glue::glue("REPORTS/Report Fails {.x}.pdf"),
params = list(Unit = {.x})
)
)
purrr::walk(
.x = SurveySet,
~ rmarkdown::render(
input = "TestWorks.Rmd",
output_file = glue::glue("REPORTS/Report Works {.x}.pdf"),
params = list(Unit = {.x})
)
)
Test.Rmd as
---
title: "`r params$Unit`"
output: pdf_document
params:
Unit: 68
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
## R Markdown
This Document renders with RStudio Knitr button but not with batch
```{r figures-side, fig.show="hold", out.width="50%"}
par(mar = c(4, 4, .1, .1))
plot(cars)
plot(mpg ~ hp, data = mtcars, pch = 19)
```
TestWorks.Rmd as
---
title: "`r params$Unit`"
output: pdf_document
params:
Unit: 68
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
## R Markdown
Without fig.show="hold", out.width="50%" this document renders individually and as batch
```{r figures}
par(mar = c(4, 4, .1, .1))
plot(cars)
plot(mpg ~ hp, data = mtcars, pch = 19)
```
Is there a way to include an absolute panel like in this example (https://shiny.rstudio.com/gallery/superzip-example.html) to a flexdashboard (on a leaflet) ?
The idea would be to have a mobile panel dedicated to the leaflet output instead of a sidebar panel.
The absolute panel example here based on a shiny example (with ui and server parts)
library(shiny)
ui <- shinyUI(bootstrapPage(
absolutePanel(
id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
HTML('<button data-toggle="collapse" data-target="#demo">Collapsible</button>'),
tags$div(id = 'demo',
checkboxInput('input_draw_point', 'Draw point', FALSE ),
verbatimTextOutput('summary')))
))
server <- shinyServer(function(input, output, session) {
output$summary <- renderPrint(print(cars))
})
shinyApp(ui = ui, server = server)
a code example below for the Flexdashboard part :
---
title: "Waste Lands - America's forgotten nuclear legacy"
author: Philipp Ottolinger
output:
flexdashboard::flex_dashboard:
theme: journal
social: menu
source_code: embed
---
```{r setup, include = FALSE}
library(flexdashboard)
library(shiny)
library(jsonlite)
library(maptools)
library(ggplot2)
library(tidyr)
library(dplyr)
library(purrr)
library(leaflet)
library(plotly)
sites <- fromJSON(flatten=TRUE,
"https://raw.githubusercontent.com/ottlngr/2016-15/ottlngr/ottlngr/sites.json")
sites$locations <- map(sites$locations, function(x) {
if (nrow(x) == 0) {
data_frame(latitude=NA, longitude=NA, postal_code=NA, name=NA, street_address=NA)
} else {
x
}
})
sites <- unnest(sites)
sites <- sites[complete.cases(sites[,c("longitude", "latitude")]),]
sites$ratingcol <- ifelse(sites$site.rating == 0, "orange",
ifelse(sites$site.rating == 1, "green",
ifelse(sites$site.rating == 2, "red", "black")))
sites$ratingf <- factor(sites$site.rating,
levels=c(3:0),
labels=c("Remote or no potential for radioactive contamination.",
"No authority to clean up or status unclear.",
"Cleanup declared complete.",
"Cleanup in progress."))
sites$campus <- ifelse(grepl("University", sites$site.name) |
grepl("University", pattern = sites$street_address) |
grepl("Campus", sites$street_address), 1, 0)
sites$campuscol <- ifelse(sites$campus == 1, "red", "black")
```
Column {data-width=650}
-----------------------------------------------------------------------
### All sites and their current status
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites$longitude,
sites$latitude,
color = sites$ratingcol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites$site.city,
sites$site.name,
sep = "")) %>%
addLegend("bottomleft",
colors = c("orange","green", "red", "black"),
labels = c("Cleanup in progress.",
"Cleanup complete.",
"Status unclear.",
"No potential for radioactive contamination."),
opacity = 0.8)
```
Column {data-width=350}
-----------------------------------------------------------------------
### Number of sites
```{r}
sites %>%
count(ratingf) %>%
plot_ly(type = "bar",
x = ratingf,
y = n,
color = ratingf,
text = paste(n,ratingf,sep=""),
hoverinfo = "text") %>%
layout(xaxis = list(showline = F,
showticklabels = F,
fixedrange = T,
title = ""),
yaxis = list(fixedrange = T,
title = ""))
```
### Sites on campus
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites[sites$campus == 1, ]$longitude,
sites[sites$campus == 1, ]$latitude,
color = sites[sites$campus == 1, ]$campuscol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites[sites$campus == 1, ]$site.city,
sites[sites$campus == 1, ]$site.name,
sep = ""))
```
Thanks
Try this.
---
title: "haha"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
editor_options:
chunk_output_type: console
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flexdashboard)
library(shiny)
library(leaflet)
```
# without container-fluid
### Sites on campus
```{r}
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
renderLeaflet(mapfunction())
```
```{r}
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto',
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
```
### server
```{r}
mapfunction <- reactive({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
```
# with container-fluid
```{r}
shinyApp(
fluidPage(
leafletOutput(outputId = "somemap"),
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto', fixed = TRUE,
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
),
server = function(input, output, session){
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
output$somemap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
}
)
```
If you need to use interactive components from shiny, like XXinput, you need to specify runtime: shiny on the top, otherwise, you can delete this line.
I use reactive as the simplest server part. If you want to use a more complex server (logic), e.g. several components interact together, you need to write the actual server function. I would suggest just write a shiny app instead of a flexdashboard.
unfortunately, components in flexdash are not inside container-fluid class which with this can allow you to drag the panel. There may be a way to work around, you can search for it. Look at the last chunck, I inserted a actual shiny app and the panel is draggable. You should see two tabs when you run the doc, watch the difference. So, if you really want to drag this panel, you should write a "real" shiny app.
So I've been struggling with this line of code. My uiOutput function seems to kill everything underneath it.
When I run the document, nothing appears underneath my uiOutput("SELECT_STAGE_1")
However, when I delete this line, the rest of the code gets rendered and when I put it back, my uiOutput("SELECT_STAGE_1") appears but nothing else afterwards.
Did I do something wrong on my "renderUI" line in the setup?
---
title: "ALICE"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(leaflet)
STAGES <- read_csv2("20191122_STAGES.csv")
STATIONS <- read_csv2("20191122_STATIONS.csv")
TRAJETS <- read_csv2("20191122_TRAJETS.csv")
output$SELECT_STAGE_1 <- renderUI({
liste_stage_1 <- STAGES$ETABLISSEMENT[STAGES$DEPT == input$DEPT_1]
selectInput("SELECT_STAGE_1",
label = NULL,
choices = liste_stage_1,
selected = NULL)
})
Column {data-width=1000}
Hello
selectInput("DEPT_1",
label = NULL,
choices = sort(unique(STAGES$DEPT)),
selected = "AUCUN")
uiOutput("SELECT_STAGE_1")
sliderInput("WANTED_TIME", "Wanted time", 5, 90, 10)
checkboxInput("UNAUTRE", label = "I need a second entry", value = FALSE)
conditionalPanel(
condition = "input.UNAUTRE == true",
selectInput("DEPT_2",
label = NULL,
choices = sort(unique(STAGES$DEPT)),
selected = "AUCUN"))
Thanks for your help !
I want to produce slide dynamically in my Rmarkdown presentation with shiny
Here below the code works.
But as soon as I uncomment the for loop it doesn't.
---
title: "dynamic_plots"
output: ioslides_presentation
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
```{r, echo = FALSE, results = "asis"}
number_of_bins_selected <- c(20,30)
i <- 1 # If for loop commented
#for (i in 1:length(number_of_bins_selected)) {
cat("## New slide \n")
input1_id <- paste(i, "nbreaks", sep = "_")
input2_id <- paste(i, "bw_adjust", sep = "_")
inputPanel(
selectInput(input1_id, label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = number_of_bins_selected[i]),
sliderInput(input2_id, label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input[[input1_id]]),
xlab = "Duration (minutes)", main = "Geyser eruption duration")
dens <- density(faithful$eruptions, adjust = input[[input2_id]])
lines(dens, col = "blue")
})
cat(" \n\n") # End the slide
#}
```
Isn't it possible to create slides on a for loop ?