restructure sections

[gogonzo]

Part of:

• [Bug]: Downloading report without code keeps Module's Code section teal.reporter#400

Restructured sections-headers. Pleaase check out with

• fix code-chunk class teal.reporter#425
• include teal-slices yaml in the Data filtering section teal#1634

exploratory

pkgload::load_all("teal.reporter")
pkgload::load_all("teal")
pkgload::load_all("teal.modules.general")
options(
  shiny.useragg = FALSE,
  teal.ggplot2_args = teal.widgets::ggplot2_args(labs = list(caption = "NEST PROJECT")),
  shiny.bookmarkStore = "server"
)

## Data reproducible code ----
data <- teal_data()
data <- within(data, {
  library(random.cdisc.data)
  library(dplyr)
  library(tidyr)
  library(ggExtra)
  library(ggpmisc)
  library(ggpp)
  library(goftest)
  library(gridExtra)
  library(htmlwidgets)
  library(jsonlite)
  library(lattice)
  library(MASS)
  library(rlang)
  library(rtables)
  library(nestcolor)
  library(broom)
  library(colourpicker)
  library(sparkline)


  ADSL <- radsl(seed = 1)
  ADRS <- radrs(ADSL, seed = 1)
  ADLB <- radlb(ADSL, seed = 1)
  ADLBPCA <- ADLB %>%
    dplyr::select(USUBJID, STUDYID, SEX, ARMCD, AVAL, AVISIT, PARAMCD) %>%
    tidyr::pivot_wider(
      values_from = "AVAL",
      names_from = c("PARAMCD", "AVISIT"),
      names_sep = " - "
    )
})

join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADRS", "ADLB", "ADLBPCA")]

## Reusable Configuration For Modules
ADSL <- data[["ADSL"]]
ADRS <- data[["ADRS"]]
ADLB <- data[["ADLB"]]
ADLBPCA <- data[["ADLBPCA"]]

adsl_extracted_num <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL),
    selected = "AGE",
    multiple = FALSE,
    fixed = FALSE
  )
)
adsl_extracted_num2 <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL),
    selected = "BMRKR1",
    multiple = FALSE,
    fixed = FALSE
  )
)
adsl_extracted_fct <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL),
    selected = "ARMCD",
    multiple = FALSE,
    fixed = FALSE
  )
)
fact_vars_adsl <- names(Filter(isTRUE, sapply(ADSL, is.factor)))
adsl_extracted_fct2 <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL, subset = fact_vars_adsl),
    selected = "STRATA2",
    multiple = FALSE,
    fixed = FALSE
  )
)
adsl_extracted_fct3 <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL),
    selected = "ARMCD",
    multiple = TRUE,
    fixed = FALSE
  )
)
numeric_vars_adsl <- names(Filter(isTRUE, sapply(ADSL, is.numeric)))
adsl_extracted_numeric <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL, subset = numeric_vars_adsl),
    selected = "BMRKR1",
    multiple = FALSE,
    fixed = FALSE
  )
)
adsl_extracted_factors <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL, subset = fact_vars_adsl),
    selected = NULL,
    multiple = FALSE,
    fixed = FALSE
  )
)

adsl_extracted_multi <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices(ADSL),
    selected = c("AGE", "BMRKR1"),
    multiple = TRUE,
    fixed = FALSE
  )
)

adrs_filters <- filter_spec(
  vars = "PARAMCD",
  sep = " - ",
  choices = value_choices(ADRS, "PARAMCD", "PARAM", c("BESRSPI", "INVET")),
  selected = "BESRSPI",
  multiple = FALSE,
  label = "Choose endpoint"
)

adrs_extracted_response <- data_extract_spec(
  dataname = "ADRS",
  filter = adrs_filters,
  select = select_spec(
    choices = variable_choices(ADRS, c("AVALC", "AVAL")),
    selected = "AVALC",
    multiple = FALSE,
    fixed = FALSE
  )
)

fact_vars_adrs <- names(Filter(isTRUE, sapply(ADRS, is.factor)))
adrs_extracted_response_fct <- data_extract_spec(
  dataname = "ADRS",
  filter = adrs_filters,
  select = select_spec(
    choices = variable_choices(ADRS, subset = fact_vars_adrs),
    selected = "AVALC",
    multiple = FALSE,
    fixed = FALSE
  )
)

adlb_filter_paramcd <- filter_spec(
  vars = "PARAMCD",
  choices = value_choices(ADLB, "PARAMCD", "PARAM"),
  selected = levels(ADLB$PARAMCD)[1],
  multiple = FALSE,
  label = "Select lab:"
)
adlb_filter_paramcd2 <- filter_spec(
  vars = "PARAMCD",
  choices = value_choices(ADLB, "PARAMCD", "PARAM"),
  selected = levels(ADLB$PARAMCD)[2],
  multiple = FALSE,
  label = "Select lab:"
)
adlb_filter_visit <- filter_spec(
  vars = "AVISIT",
  choices = levels(ADLB$AVISIT),
  selected = levels(ADLB$AVISIT)[1],
  multiple = FALSE,
  label = "Select visit:"
)
adlb_extracted_aval <- data_extract_spec(
  dataname = "ADLB",
  select = select_spec(
    choices = variable_choices(ADLB, c("AVAL", "CHG", "PCHG", "ANRIND", "BASE")),
    selected = "AVAL",
    multiple = FALSE,
    fixed = FALSE
  ),
  filter = list(
    adlb_filter_paramcd,
    adlb_filter_visit
  )
)

numeric_vars_adlbpca <- names(Filter(isTRUE, sapply(ADLBPCA, is.numeric)))

distr_filter_spec <- filter_spec(
  vars = choices_selected(
    variable_choices(ADSL, fact_vars_adsl),
    selected = NULL
  ),
  multiple = TRUE
)

## App header and footer ----
nest_logo <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png"
app_source <- "https://github.com/insightsengineering/teal.gallery/tree/main/exploratory"
gh_issues_page <- "https://github.com/insightsengineering/teal.gallery/issues"

header <- tags$span(
  style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;",
  tags$span("My first teal app", style = "font-size: 30px;"),
  tags$span(
    style = "display: flex; align-items: center;",
    tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"),
    tags$span(style = "font-size: 24px;", "NEST @ Roche")
  )
)

footer <- tags$p(
  "This teal app is brought to you by the NEST Team at Roche/Genentech.
        For more information, please visit:",
  tags$a(href = app_source, target = "_blank", "Source Code"), ", ",
  tags$a(href = gh_issues_page, target = "_blank", "Report Issues")
)

app <- init(
  data = data,
  filter = teal_slices(
    count_type = "all",
    teal_slice(dataname = "ADSL", varname = "SEX"),
    teal_slice(dataname = "ADSL", varname = "AGE")
  ),
  modules = modules(
    tm_front_page(
      label = "App Info",
      header_text = c(
        "Info about input data source" =
          "This app uses CDISC ADaM datasets randomly generated by `random.cdisc.data` R packages"
      ),
      tables = list(
        `NEST packages used in this demo app` = data.frame(Packages = c("teal.modules.general", "random.cdisc.data"))
      )
    ),
    tm_file_viewer(
      label = "File viewer",
      input_path = list(
        png = "https://www.r-project.org/logo/Rlogo.png",
        Rmd = "https://raw.githubusercontent.com/tidyverse/dplyr/master/README.Rmd",
        pdf = "https://cran.r-project.org/web/packages/shinyTree/shinyTree.pdf",
        "example directory" = "./packrat/desc/"
      )
    ),
    tm_data_table("Data Table"),
    tm_variable_browser("Variable Browser"),
    tm_missing_data("Missing Data"),
    tm_g_distribution(
      "Distribution",
      dist_var = adsl_extracted_numeric,
      strata_var = data_extract_spec(
        dataname = "ADSL",
        filter = distr_filter_spec
      ),
      group_var = data_extract_spec(
        dataname = "ADSL",
        filter = distr_filter_spec
      )
    ),
    tm_outliers(
      "Outliers",
      outlier_var = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          choices = variable_choices(ADLB, c("AVAL", "CHG", "PCHG", "BASE")),
          selected = "AVAL",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      categorical_var = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          choices = variable_choices(ADLB, c("PARAM", "PARAMCD")),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      )
    ),
    tm_g_association(
      ref = adsl_extracted_num,
      vars = adsl_extracted_fct3
    ),
    tm_g_bivariate(
      x = adsl_extracted_num,
      y = adlb_extracted_aval,
      row_facet = adsl_extracted_factors,
      col_facet = adsl_extracted_factors,
      use_density = FALSE,
      plot_height = c(600L, 200L, 2000L),
      ggtheme = "gray"
    ),
    tm_a_regression(
      label = "Regression",
      response = adsl_extracted_numeric,
      regressor = adrs_extracted_response
    ),
    tm_g_response(
      response = adrs_extracted_response_fct,
      x = adsl_extracted_fct2,
      row_facet = adsl_extracted_factors,
      col_facet = adsl_extracted_factors,
      coord_flip = FALSE
    ),
    tm_g_scatterplotmatrix(
      label = "Scatterplot Matrix",
      variables = adsl_extracted_multi
    ),
    tm_g_scatterplot(
      "Scatterplot",
      x = adsl_extracted_num,
      y = adsl_extracted_num2,
      row_facet = adsl_extracted_factors,
      col_facet = adsl_extracted_factors,
      color_by = adsl_extracted_factors,
      size = 3, alpha = 1,
      plot_height = c(600L, 200L, 2000L)
    ),
    tm_t_crosstable(
      "Table Choices",
      x = adsl_extracted_fct2,
      y = adsl_extracted_fct
    ),
    tm_a_pca(
      "Principal Component Analysis",
      dat = data_extract_spec(
        dataname = "ADLBPCA",
        select = select_spec(
          choices = variable_choices(ADLBPCA, numeric_vars_adlbpca),
          selected = c("ALT - WEEK 5 DAY 36", "CRP - WEEK 5 DAY 36", "IGA - WEEK 5 DAY 36"),
          multiple = TRUE,
          fixed = FALSE,
          label = "Variable"
        ),
      ),
      plot_height = c(600L, 200L, 2000L),
      plot_width = c(600L, 200L, 2000L)
    )
  )
) |>
  modify_title(
    title = "Exploratory Analysis Teal Demo App",
    favicon = nest_logo
  ) |>
  modify_header(header) |>
  modify_footer(footer)

shinyApp(app$ui, app$server, enableBookmarking = "server")

• Module's code -> Module's output(s)
• ## Biplot -> ### Biplot

[github-actions]

Unit Tests Summary

  1 files  23 suites   2s ⏱️
151 tests 36 ✅ 115 💤 0 ❌
194 runs  79 ✅ 115 💤 0 ❌

Results for commit 9bd816c.

♻️ This comment has been updated with latest results.

[github-actions]

Code Coverage Summary

Filename                      Stmts    Miss  Cover    Missing
--------------------------  -------  ------  -------  -------------------------------------------
R/tm_a_pca.R                    866     866  0.00%    141-1134
R/tm_a_regression.R             752     752  0.00%    180-1028
R/tm_data_table.R               200     200  0.00%    100-348
R/tm_file_viewer.R              172     172  0.00%    47-254
R/tm_front_page.R               143     132  7.69%    77-246
R/tm_g_association.R            321     321  0.00%    161-548
R/tm_g_bivariate.R              675     411  39.11%   332-791, 832, 943, 960, 978, 989-1011
R/tm_g_distribution.R          1107    1107  0.00%    154-1403
R/tm_g_response.R               346     346  0.00%    179-595
R/tm_g_scatterplot.R            710     710  0.00%    261-1066
R/tm_g_scatterplotmatrix.R      273     254  6.96%    200-502, 563, 577
R/tm_missing_data.R            1081    1081  0.00%    124-1381
R/tm_outliers.R                1027    1027  0.00%    162-1339
R/tm_t_crosstable.R             264     264  0.00%    177-483
R/tm_variable_browser.R         788     783  0.63%    89-1025, 1063-1246
R/utils.R                       185     120  35.14%   87-249, 278-304, 316-325, 330, 344-363, 452
R/zzz.R                           2       2  0.00%    2-3
TOTAL                          8912    8548  4.08%

Diff against main

Filename      Stmts    Miss  Cover
----------  -------  ------  --------
TOTAL             0       0  +100.00%

Results for commit: 9bd816c

Minimum allowed coverage is 80%

♻️ This comment has been updated with latest results