Skip to content

Commit 6228d2b

Browse files
gaelsogaelso
committed
Done output a document with analysis table and graph current state
1 parent b32603c commit 6228d2b

4 files changed

Lines changed: 207 additions & 27 deletions

File tree

‎DESCRIPTION‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,9 @@ Imports:
1616
ggplot2,
1717
htmltools,
1818
jsonlite,
19+
knitr,
1920
purrr,
21+
quarto,
2022
rlang,
2123
scales,
2224
shiny,

‎R/mod_tool_UI2.R‎

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -456,15 +456,36 @@ mod_tool_UI2 <- function(id, i18n, .tr){
456456
card(
457457
full_screen = TRUE,
458458
card_header("Means (per ha)"),
459-
plotOutput(ns("analysis_plot_means"), height = "400px")
459+
plotOutput(ns("analysis_plot_means"), height = "400px"),
460+
br(),
461+
downloadButton(ns("analysis_plot_means_download"), "Download means plot (PNG)")
460462
),
461463

462464
## -- TOTALS plot -------------------------------------------------
463465
card(
464466
full_screen = TRUE,
465467
card_header("Totals"),
466-
plotOutput(ns("analysis_plot_totals"), height = "400px")
468+
plotOutput(ns("analysis_plot_totals"), height = "400px"),
469+
br(),
470+
downloadButton(ns("analysis_plot_totals_download"), "Download totals plot (PNG)")
471+
),
472+
473+
## ++ ##
474+
card(
475+
card_header("Export report"),
476+
layout_column_wrap(
477+
width = "220px",
478+
fill = FALSE,
479+
selectInput(
480+
ns("analysis_report_format"),
481+
"Report format",
482+
choices = c("HTML" = "html", "Word" = "docx"),
483+
selected = "html"
484+
)
485+
),
486+
downloadButton(ns("analysis_report_download"), "Download report")
467487
)
488+
## ++ ##
468489

469490
))
470491
## ++ ##

‎R/mod_tool_server2.R‎

Lines changed: 135 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1003,13 +1003,17 @@ mod_tool_server2 <- function(id, rv) {
10031003
}
10041004
## $$$
10051005

1006-
## . + MEANS bar plot ----------------------------------------------------
1007-
output$analysis_plot_means <- renderPlot({
1008-
req(rv$analysis$result, input$plot_dim, input$plot_measure)
1006+
## ++ ##
1007+
build_analysis_plot <- function(source = c("MEANS", "TOTALS")) {
1008+
source <- match.arg(source)
1009+
10091010
validation <- get_plot_validation()
1010-
validate(need(validation$ok, validation$message))
1011+
if (!isTRUE(validation$ok)) {
1012+
stop(validation$message, call. = FALSE)
1013+
}
1014+
10111015
make_bar_plot(
1012-
df = filtered_analysis_df("MEANS"),
1016+
df = filtered_analysis_df(source),
10131017
x_dim = input$plot_dim,
10141018
measure = input$plot_measure,
10151019
fill_col = input$plot_fill,
@@ -1020,36 +1024,142 @@ mod_tool_server2 <- function(id, rv) {
10201024
hide_legend = isTRUE(input$plot_hide_legend),
10211025
dim_meta = rv$analysis$dim_meta,
10221026
measures_meta = rv$analysis$measures_meta,
1023-
## $$$
1024-
extra_filter_vals = get_filter_vals()
1025-
## $$$
1027+
extra_filter_vals = get_filter_vals(),
1028+
comma_y = identical(source, "TOTALS")
10261029
)
1030+
}
1031+
1032+
analysis_report_table <- function() {
1033+
req(input$analysis_table_source)
1034+
table_display_df(input$analysis_table_source)
1035+
}
1036+
1037+
safe_file_stub <- function(x) {
1038+
x |>
1039+
stringr::str_replace_all("[^A-Za-z0-9]+", "_") |>
1040+
stringr::str_replace_all("^_+|_+$", "") |>
1041+
tolower()
1042+
}
1043+
## ++ ##
1044+
1045+
## . + MEANS bar plot ----------------------------------------------------
1046+
output$analysis_plot_means <- renderPlot({
1047+
req(rv$analysis$result, input$plot_dim, input$plot_measure)
1048+
validation <- get_plot_validation()
1049+
validate(need(validation$ok, validation$message))
1050+
build_analysis_plot("MEANS")
10271051
})
10281052

10291053
## . + TOTALS bar plot ---------------------------------------------------
10301054
output$analysis_plot_totals <- renderPlot({
10311055
req(rv$analysis$result, input$plot_dim, input$plot_measure)
10321056
validation <- get_plot_validation()
10331057
validate(need(validation$ok, validation$message))
1034-
make_bar_plot(
1035-
df = filtered_analysis_df("TOTALS"),
1036-
x_dim = input$plot_dim,
1037-
measure = input$plot_measure,
1038-
fill_col = input$plot_fill,
1039-
facet_col = input$plot_facet,
1040-
show_errbar = isTRUE(input$plot_errbar),
1041-
flip_coords = isTRUE(input$plot_flip),
1042-
wrap_labels = isTRUE(input$plot_wrap_labels),
1043-
hide_legend = isTRUE(input$plot_hide_legend),
1044-
dim_meta = rv$analysis$dim_meta,
1045-
measures_meta = rv$analysis$measures_meta,
1046-
## $$$
1047-
extra_filter_vals = get_filter_vals(),
1048-
comma_y = TRUE
1049-
## $$$
1050-
)
1058+
build_analysis_plot("TOTALS")
10511059
})
10521060

1061+
## ++ ##
1062+
output$analysis_plot_means_download <- downloadHandler(
1063+
filename = function() {
1064+
paste0("means_plot_", safe_file_stub(input$plot_measure %||% "measure"), ".png")
1065+
},
1066+
content = function(file) {
1067+
ggplot2::ggsave(
1068+
filename = file,
1069+
plot = build_analysis_plot("MEANS"),
1070+
width = 10,
1071+
height = 6,
1072+
dpi = 300
1073+
)
1074+
}
1075+
)
1076+
1077+
output$analysis_plot_totals_download <- downloadHandler(
1078+
filename = function() {
1079+
paste0("totals_plot_", safe_file_stub(input$plot_measure %||% "measure"), ".png")
1080+
},
1081+
content = function(file) {
1082+
ggplot2::ggsave(
1083+
filename = file,
1084+
plot = build_analysis_plot("TOTALS"),
1085+
width = 10,
1086+
height = 6,
1087+
dpi = 300
1088+
)
1089+
}
1090+
)
1091+
1092+
output$analysis_report_download <- downloadHandler(
1093+
filename = function() {
1094+
req(rv$inputs$data, input$analysis_report_format)
1095+
survey_stub <- safe_file_stub(rv$inputs$data$chain_summary$surveyLabel %||% "survey")
1096+
ext <- if (identical(input$analysis_report_format, "docx")) "docx" else "html"
1097+
paste0("analysis_report_", survey_stub, ".", ext)
1098+
},
1099+
contentType = "application/octet-stream",
1100+
content = function(file) {
1101+
req(rv$analysis$result, rv$inputs$data, input$analysis_report_format)
1102+
1103+
report_dir <- tempfile(pattern = "arenalytics-report-")
1104+
dir.create(report_dir, recursive = TRUE, showWarnings = FALSE)
1105+
1106+
means_plot_file <- file.path(report_dir, "means-plot.png")
1107+
totals_plot_file <- file.path(report_dir, "totals-plot.png")
1108+
table_file <- file.path(report_dir, "analysis-table.csv")
1109+
qmd_template <- system.file("quarto", "analysis-report.qmd", package = "arenalytics.dev")
1110+
qmd_file <- file.path(report_dir, "analysis-report.qmd")
1111+
1112+
if (!nzchar(qmd_template)) {
1113+
stop("Report template not found.", call. = FALSE)
1114+
}
1115+
1116+
ok_copy <- file.copy(qmd_template, qmd_file, overwrite = TRUE)
1117+
if (!isTRUE(ok_copy)) {
1118+
stop("Could not prepare the report template.", call. = FALSE)
1119+
}
1120+
1121+
ggplot2::ggsave(means_plot_file, plot = build_analysis_plot("MEANS"), width = 10, height = 6, dpi = 300)
1122+
ggplot2::ggsave(totals_plot_file, plot = build_analysis_plot("TOTALS"), width = 10, height = 6, dpi = 300)
1123+
utils::write.csv(analysis_report_table(), table_file, row.names = FALSE)
1124+
1125+
rendered_file <- file.path(
1126+
report_dir,
1127+
paste0("analysis-report.", if (identical(input$analysis_report_format, "docx")) "docx" else "html")
1128+
)
1129+
rendered_name <- basename(rendered_file)
1130+
1131+
quarto::quarto_render(
1132+
input = qmd_file,
1133+
output_format = input$analysis_report_format,
1134+
execute_params = list(
1135+
survey_title = paste(
1136+
rv$inputs$data$chain_summary$surveyName,
1137+
rv$inputs$data$chain_summary$surveyLabel,
1138+
sep = " - "
1139+
),
1140+
analysis_entity = input$analysis_sel_entity,
1141+
analysis_type = if (identical(input$analysis_mode, "area")) "Area" else "Other measures",
1142+
table_title = if (identical(input$analysis_table_source, "TOTALS")) "Totals" else "Means (per ha)",
1143+
table_csv = table_file,
1144+
means_plot = means_plot_file,
1145+
totals_plot = totals_plot_file
1146+
),
1147+
output_file = rendered_name,
1148+
quiet = FALSE
1149+
)
1150+
1151+
if (!file.exists(rendered_file)) {
1152+
stop("Report generation failed.", call. = FALSE)
1153+
}
1154+
1155+
ok_out <- file.copy(rendered_file, file, overwrite = TRUE)
1156+
if (!isTRUE(ok_out)) {
1157+
stop("Could not copy the rendered report to the download target.", call. = FALSE)
1158+
}
1159+
}
1160+
)
1161+
## ++ ##
1162+
10531163
## $$$
10541164

10551165
})

‎inst/quarto/analysis-report.qmd‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
---
2+
title: "`r params$survey_title`"
3+
format:
4+
html:
5+
embed-resources: true
6+
toc: false
7+
docx: default
8+
params:
9+
survey_title: "Survey"
10+
analysis_entity: ""
11+
analysis_type: ""
12+
table_title: "Analysis table"
13+
table_csv: ""
14+
means_plot: ""
15+
totals_plot: ""
16+
execute:
17+
echo: false
18+
warning: false
19+
message: false
20+
---
21+
22+
```{r}
23+
table_df <- utils::read.csv(params$table_csv, check.names = FALSE)
24+
```
25+
26+
## Analysis summary
27+
28+
**Entity:** `r params$analysis_entity`
29+
**Analysis type:** `r params$analysis_type`
30+
31+
## `r params$table_title`
32+
33+
```{r}
34+
knitr::kable(table_df, format = "pipe")
35+
```
36+
37+
## Means plot
38+
39+
```{r}
40+
knitr::include_graphics(params$means_plot)
41+
```
42+
43+
## Totals plot
44+
45+
```{r}
46+
knitr::include_graphics(params$totals_plot)
47+
```

0 commit comments

Comments
 (0)