Skip to content

Commit

Permalink
Simple - Load Reporter - Inbuild (#251)
Browse files Browse the repository at this point in the history 
closes #81 
continuation of
#177
linked to insightsengineering/teal#1120 Please
install this teal branch when testing the code

I created a new PR from the fork as I am no longer part of the
insightengineering group.
My work is done as a collaboration of UCB company with Roche.
insightengineering developers can edit this PR.

I followed a simple design, which was evaluated positively in [the
discussion](#81).

DONE:

- New modules `report_load_srv` and `report_load_ui`; similar direct
update for Previewer.
- REMOVE the `Archiver` Class as we not need it for this simplified
scenario.
- Improve `to_list` and `from_list` `Reporter` methods
- Add `set_id` and `get_id` `Reporter` methods. Optionally add id to a
Report which will be compared when it is rebuilt from a list. To test it
in the teal example app please download a report and then add a new
module or dataset to the app and try to load it back. The report can be
loaded back to teal app only with the same datasets and modules. The id
is added to the downloaded file name if exists.
- Improve `to_list` and `from_list` `ReportCard` methods (linked with
insightsengineering/teal#1120)
- Both already existing vignette apps are updated automatically.
- `warning(cond)` everywhere to be consistent. We should send the
error/warning to the R console when STH fails.
- Add `testServer` tests for report_load_srv/report_load_ui modules.
- UI tested with all 3 bootstrap versions.

Points to consider:

- The JSON format Report representation seems to be enough, so an
Archiver is unnecessary. The DB solution to save/load seems overcomplex
for the project.
- No update will be required to introduce it into teal modules. Simple
reporter is updated automatically and can be customized with a new
teal.reporter option.
- When reloading, the Report is validated by the "report_" file name
prefix later by the slot name "teal Report" and optionally by ID if it
is non-empty.

Example Teal App (play with bootstrap versions, simple reporter modules,
and add new data/module to confirm the report can not be then reloaded):

```r
library(teal.modules.general)
# one of c("3", "4", "5")
options("teal.bs_theme" = bslib::bs_theme(version = "4"))

data <- teal_data()
data <- within(data, {
  library(nestcolor)
  ADSL <- teal.modules.general::rADSL
})
datanames <- c("ADSL")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.modules.general::tm_a_regression(
      label = "Regression",
      response = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = "BMRKR1",
          selected = "BMRKR1",
          multiple = FALSE,
          fixed = TRUE
        )
      ),
      regressor = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variables:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")),
          selected = "AGE",
          multiple = TRUE,
          fixed = FALSE
        )
      ),
      ggplot2_args = teal.widgets::ggplot2_args(
        labs = list(subtitle = "Plot generated by Regression Module")
      )
    )
  )
)
runApp(app, launch.browser = TRUE)
```

Example general shiny app (play with bootstrap versions, simple reporter
modules):

```r
library(shiny)
library(teal.reporter)
library(ggplot2)
library(rtables)
library(DT)
library(bslib)

ui <- fluidPage(
    # please, specify specific bootstrap version and theme
    theme = bs_theme(version = "4"),
    titlePanel(""),
    tabsetPanel(
        tabPanel(
            "main App",
            tags$br(),
            sidebarLayout(
                sidebarPanel(
                    uiOutput("encoding")
                ),
                mainPanel(
                    tabsetPanel(
                        id = "tabs",
                        tabPanel("Plot", plotOutput("dist_plot")),
                        tabPanel("Table", verbatimTextOutput("table")),
                        tabPanel("Table DataFrame", verbatimTextOutput("table2")),
                        tabPanel("Table DataTable", dataTableOutput("table3"))
                    )
                )
            )
        ),
        ### REPORTER
        tabPanel(
            "Previewer",
            reporter_previewer_ui("prev")
        )
        ###
    )
)
server <- function(input, output, session) {
    output$encoding <- renderUI({
        tagList(
            ### REPORTER
            teal.reporter::simple_reporter_ui("simple_reporter"),
            ###
            if (input$tabs == "Plot") {
                sliderInput(
                    "binwidth",
                    "binwidth",
                    min = 2,
                    max = 10,
                    value = 8
                )
            } else if (input$tabs %in% c("Table", "Table DataFrame", "Table DataTable")) {
                selectInput(
                    "stat",
                    label = "Statistic",
                    choices = c("mean", "median", "sd"),
                    "mean"
                )
            } else {
                NULL
            }
        )
    })
    plot <- reactive({
        req(input$binwidth)
        x <- mtcars$mpg
        ggplot(data = mtcars, aes(x = mpg)) +
            geom_histogram(binwidth = input$binwidth)
    })
    output$dist_plot <- renderPlot(plot())
    
    table <- reactive({
        req(input$stat)
        lyt <- basic_table() %>%
            split_rows_by("Month", label_pos = "visible") %>%
            analyze("Ozone", afun = eval(str2expression(input$stat)))
        build_table(lyt, airquality)
    })
    output$table <- renderPrint(table())
    
    table2 <- reactive({
        req(input$stat)
        data <- aggregate(
            airquality[, c("Ozone"), drop = FALSE], list(Month = airquality$Month), get(input$stat),
            na.rm = TRUE
        )
        colnames(data) <- c("Month", input$stat)
        data
    })
    output$table2 <- renderPrint(print.data.frame(table2()))
    output$table3 <- renderDataTable(table2())
    
    ### REPORTER
    reporter <- Reporter$new()
    card_fun <- function(card = ReportCard$new(), comment) {
        if (input$tabs == "Plot") {
            card$set_name("Plot Module")
            card$append_text("My plot", "header2")
            card$append_plot(plot())
            card$append_rcode(
                paste(
                    c(
                        "x <- mtcars$mpg",
                        "ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) +",
                        paste0("ggplot2::geom_histogram(binwidth = ", input$binwidth, ")")
                    ),
                    collapse = "\n"
                ),
                echo = TRUE,
                eval = FALSE
            )
        } else if (input$tabs == "Table") {
            card$set_name("Table Module rtables")
            card$append_text("My rtables", "header2")
            card$append_table(table())
            card$append_rcode(
                paste(
                    c(
                        "lyt <- rtables::basic_table() %>%",
                        'rtables::split_rows_by("Month", label_pos = "visible") %>%',
                        paste0('rtables::analyze("Ozone", afun = ', input$stat, ")"),
                        "rtables::build_table(lyt, airquality)"
                    ),
                    collapse = "\n"
                ),
                echo = TRUE,
                eval = FALSE
            )
        } else if (input$tabs %in% c("Table DataFrame", "Table DataTable")) {
            card$set_name("Table Module DF")
            card$append_text("My Table DF", "header2")
            card$append_table(table2())
            # Here r code added as a regular verbatim text
            card$append_text(
                paste0(
                    c(
                        'data <- aggregate(airquality[, c("Ozone"), drop = FALSE], list(Month = airquality$Month), ',
                        input$stat,
                        ", na.rm = TRUE)\n",
                        'colnames(data) <- c("Month", ', paste0('"', input$stat, '"'), ")\n",
                        "data"
                    ),
                    collapse = ""
                ), "verbatim"
            )
        }
        if (!comment == "") {
            card$append_text("Comment", "header3")
            card$append_text(comment)
        }
        card
    }
    teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    teal.reporter::reporter_previewer_srv("prev", reporter)
    ###
}

if (interactive()) shinyApp(ui = ui, server = server)
```

---------

Signed-off-by: Maciej Nasinski <[email protected]>
Co-authored-by: Dawid Kałędkowski <[email protected]>
Co-authored-by: Dawid Kałędkowski <[email protected]>
  • Loading branch information
@Polkas @gogonzo
3 people authored Apr 24, 2024
1 parent ad7fd20 commit df1cade
Show file tree
Hide file tree
Showing 27 changed files with 564 additions and 829 deletions.
2 changes: 2 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@ export(add_card_button_ui)
export(as_yaml_auto)
export(download_report_button_srv)
export(download_report_button_ui)
export(report_load_srv)
export(report_load_ui)
export(reporter_previewer_srv)
export(reporter_previewer_ui)
export(reset_report_button_srv)
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
### Enhancements

* Report cards are now included in bookmarks. When using the `shiny` bookmarking mechanism, present report cards will be available in the restored application.
* Report can be loaded back now. The zip file with the report can be loaded back which will restore Previewer state.

# teal.reporter 0.3.1

Expand Down
181 changes: 0 additions & 181 deletions R/Archiver.R
View file

This file was deleted.

37 changes: 35 additions & 2 deletions R/DownloadModule.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,12 @@ download_report_button_srv <- function(id,

output$download_data <- shiny::downloadHandler(
filename = function() {
paste("report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "")
paste0(
"report_",
if (reporter$get_id() == "") NULL else paste0(reporter$get_id(), "_"),
format(Sys.time(), "%y%m%d%H%M%S"),
".zip"
)
},
content = function(file) {
shiny::showNotification("Rendering and Downloading the document.")
Expand Down Expand Up @@ -189,13 +194,15 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file
tryCatch(
renderer$render(reporter$get_blocks(), yaml_header, global_knitr),
warning = function(cond) {
print(cond)
shiny::showNotification(
ui = "Render document warning!",
action = "Please contact app developer",
type = "warning"
)
},
error = function(cond) {
print(cond)
shiny::showNotification(
ui = "Render document error!",
action = "Please contact app developer",
Expand All @@ -204,17 +211,41 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file
}
)

output_dir <- renderer$get_output_dir()

tryCatch(
archiver_dir <- reporter$to_jsondir(output_dir),
warning = function(cond) {
print(cond)
shiny::showNotification(
ui = "Archive document warning!",
action = "Please contact app developer",
type = "warning"
)
},
error = function(cond) {
print(cond)
shiny::showNotification(
ui = "Archive document error!",
action = "Please contact app developer",
type = "error"
)
}
)

temp_zip_file <- tempfile(fileext = ".zip")
tryCatch(
expr = zip::zipr(temp_zip_file, renderer$get_output_dir()),
expr = zip::zipr(temp_zip_file, output_dir),
warning = function(cond) {
print(cond)
shiny::showNotification(
ui = "Zipping folder warning!",
action = "Please contact app developer",
type = "warning"
)
},
error = function(cond) {
print(cond)
shiny::showNotification(
ui = "Zipping folder error!",
action = "Please contact app developer",
Expand All @@ -226,13 +257,15 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file
tryCatch(
expr = file.copy(temp_zip_file, file),
warning = function(cond) {
print(cond)
shiny::showNotification(
ui = "Copying file warning!",
action = "Please contact app developer",
type = "warning"
)
},
error = function(cond) {
print(cond)
shiny::showNotification(
ui = "Copying file error!",
action = "Please contact app developer",
Expand Down
Loading

0 comments on commit df1cade

Please sign in to comment.