exercise_3.qmd

---
title: "Exercise 3"
---

Create your custom module!

Create a custom module that does a simple demographic summary table on user specified columns.

- read [`teal::module()`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_modules.html) documentation
- read ["Creating Custom Modules"](https://insightsengineering.github.io/teal/latest-tag/articles/creating-custom-modules.html) vignette
- read [`"qenv"`](https://insightsengineering.github.io/teal.code/latest-tag/articles/qenv.html) article on how to interact with internal `qenv` object - in particular: [`teal.code::within()`](https://insightsengineering.github.io/teal.code/latest-tag/reference/qenv.html) function

### Code

```{r ex, message = FALSE}
library(random.cdisc.data)
library(teal)
library(teal.transform)
library(teal.widgets)
library(tern)
library(dplyr)

modules <- list(
  module(
    label = "Adhoc module",
    server = function(id, data){
      moduleServer(id, function(input, output, session){
        s_summary <- function(x) {
          if (is.numeric(x)) {
            in_rows(
              "n" = rcell(sum(!is.na(x)), format = "xx"),
              "Mean (sd)" = rcell(c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), format = "xx.xx (xx.xx)"),
              "IQR" = rcell(IQR(x, na.rm = TRUE), format = "xx.xx"),
              "min - max" = rcell(range(x, na.rm = TRUE), format = "xx.xx - xx.xx")
            )
          } else if (is.factor(x)) {
            vs <- as.list(table(x))
            do.call(in_rows, lapply(vs, rcell, format = "xx"))
          } else {
            stop("type not supported")
          }
        }

        observe({
          ADSL <- get_var(data(), "ADSL")
          req(ADSL)
          updateSelectInput(
            inputId = "param",
            choices = variable_choices(ADSL),
            selected = c("AGE"),
          )
        })

        table_q <- reactive({
          data() |>
            within(
              {
                s_summary <- my_summary
                summary_lyt <- basic_table() %>%
                  split_cols_by(var = "ARM") %>%
                  analyze(param, afun = s_summary)
                summary_tbl <- build_table(summary_lyt, ADSL)
                summary_tbl
              },
              my_summary = s_summary,
              param = input$param
            )
        })

        output$table = renderUI({
          renderPrint(table_q()[["summary_tbl"]])
        })

      })
    },
    ui = function(id) {
      ns <- NS(id)

      standard_layout(
        output = div(
          fluidRow(
            column(
              width = 12,
              br(), hr(),
              uiOutput(ns("table"))
            )
          )
        ),
        encoding = div(
          br(),
          tags$label('Encodings', class = 'text-primary'),
          helpText('Analysis Data:', tags$code('ADSL')),
          selectInput(
            inputId = ns('param'),
            label = 'Demographic Parameter',
            choices = NULL,
            selected = NULL,
            multiple = TRUE
          )
        )
      )
    },
    datanames = c("ADSL")
  )
)


data <- teal_data()
data <- within(data, {
  ADSL <- radsl(cached = TRUE)
})
datanames(data) <- c("ADSL")

app <- init(
  data = data,
  modules = modules
)

if (Sys.getenv("QUARTO_ROOT") == "") {
  shinyApp(app$ui, app$server)
}
```

```{r save_script, include = FALSE}
code <- paste0(knitr::knit_code$get("ex"), collapse = "\n")
writeLines(code, "scripts/exercise_3.R")
```

### URL

```{r shinylive_url, echo = FALSE, results = 'asis', purl = FALSE}
code <- paste0(knitr::knit_code$get("ex"), collapse = "\n")
url <- roxy.shinylive::create_shinylive_url(code)
cat(sprintf("[Open in Shinylive](%s)\n\n", url))
```

### App

```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', purl = FALSE}
knitr::include_url(url, height = "800px")
```