feat, wip: simple DEMO of tlg implementation

NAMESPACE

@@ -9,6 +9,9 @@ export(create_dose)
 export(filter_breaks)
 export(flexible_violinboxplot)
 export(format_data)
+export(g_pkconc_ind)
+export(g_pkconc_ind_lin)
+export(g_pkconc_ind_log)
 export(general_lineplot)
 export(general_meanplot)
 export(geometric_mean)

R/g_pkconc_ind.R

@@ -0,0 +1,30 @@
+#' TODO: Implement actual pkconc plot
+#' @export
+g_pkconc_ind <- function(data, scale = "lin", xlab = "test x lab", ylab = "test y lab") {
+  p <- ggplot2::ggplot(
+    data = data,
+    mapping = aes(x = TIME, y = ADOSEDUR)
+  ) +
+    ggplot2::geom_point() +
+    ggplot2::labs(
+      x = xlab,
+      y = ylab
+    )
+
+  if (scale == "log") {
+    p <- p +
+      ggplot2::scale_y_log10()
+  }
+
+  p
+}
+
+#' @export
+g_pkconc_ind_lin <- function(data, ...) {
+  g_pkconc_ind(data = data, scale = "lin", ...)
+}
+
+#' @export
+g_pkconc_ind_log <- function(data, ...) {
+  g_pkconc_ind(data, scale = "log", ...)
+}

inst/shiny/global.R

@@ -3,3 +3,5 @@ source("modules/tab_data.R")
 source("modules/slope_selector.R")
 
 source("functions/partial_auc_input.R")
+
+source("modules/tlg_plot.R")

inst/shiny/modules/tab_tlg.R

@@ -1,3 +1,5 @@
+.TLG_DEFINITIONS <- yaml::read_yaml(system.file("shiny/tlg.yaml", package = "aNCA"))
+
 tab_tlg_ui <- function(id) {
   ns <- NS(id)
 
@@ -56,29 +58,7 @@ tab_tlg_ui <- function(id) {
         )
       )
     ),
-    tabPanel(
-      "Graphs",
-      fluidRow(
-        column(
-          2,  # Left column for plot selection
-          radioButtons(
-            inputId = ns("buttons_Graphs"),
-            label = "Choose Graph\n",
-            choices = ""
-          )
-        ),
-        column(
-          6,  # Middle column for plot output
-          h4("Graph to display"),
-          plotOutput(ns("plot_Graphs"))
-        ),
-        column(
-          2,  # Right column for plot customization inputs
-          h4("Inputs with selected vals linked to downloadable obj (i.e, tlg_order())"),
-          textInput(ns("footnote_Graphs"), label = "Footnote")
-        )
-      )
-    )
+    tabPanel("Graphs", uiOutput(ns("graphs")))
   )
 }
 
@@ -87,10 +67,33 @@ tab_tlg_server <- function(id, data) {
     ns <- session$ns
 
     # Make available the CSV file with the TLG list and available links to NEST
-    tlg_order <- reactiveVal(
-      read.csv(system.file("www/data/TLG_order_details.csv", package = "aNCA")) %>%
-        mutate(PKid = paste0("<a href='", Catalog_Link, "' target='_blank'>", PKid, "</a>"))
-    )
+    tlg_order <- reactiveVal({
+      tlg_data <- dplyr::tibble(
+        id = character(),
+        Selection = logical(),
+        Type = character(),
+        Dataset = character(),
+        PKid = character(),
+        Description = character(),
+        Footnote = character(),
+        Stratification = character(),
+        Condition = character(),
+        Comment = character()
+      )
+
+      purrr::iwalk(.TLG_DEFINITIONS, function(x, id) {
+        tlg_data <<- dplyr::add_row(
+          tlg_data,
+          id = id,
+          Selection = x$is_default,
+          Type = x$type,
+          Dataset = x$dataset,
+          PKid = paste0("<a href='", x$link, "'>", x$pkid, "</a>"),
+          Description = x$description
+        )
+      })
+      tlg_data
+    })
 
     # Based on the TLG list conditions for data() define the preselected rows in $Selection
     observeEvent(list(tlg_order(), data()), {
@@ -267,19 +270,25 @@ tab_tlg_server <- function(id, data) {
                            choices = "")
       }
 
-      if (sum(tlg_order_filt$Type == "Graph") > 0) {
-        updateRadioButtons(
-          session = session,
-          inputId = "buttons_Graphs",
-          label = "Graph to display",
-          choices = tlg_order_filt$Label[tlg_order_filt$Type == "Graph"]
-        )
-      } else {
-        updateRadioButtons(session = session,
-                           inputId = "buttons_Graphs",
-                           label = "",
-                           choices = "")
-      }
+      tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph")$id
+      panels <- lapply(tlg_order_graphs, function(g_id) {
+        plot_ui <- {
+          g_def <- .TLG_DEFINITIONS[[g_id]]
+
+          if (exists(g_def$fun)) {
+            tlg_plot_server(g_id, get(g_def$fun), g_def$opts, data)
+            tlg_plot_ui(session$ns(g_id))
+          } else {
+            tags$div("Plot not implemented yet")
+          }
+        }
+
+        tabPanel(g_def$label, plot_ui)
+      })
+
+      output$graphs <- renderUI({
+        do.call(navlistPanel, panels)
+      })
     })
   })
 }

inst/shiny/modules/tlg_plot.R

@@ -0,0 +1,37 @@
+tlg_plot_ui <- function(id) {
+  ns <- NS(id)
+
+  fluidRow(
+    column(
+      width = 9,
+      plotOutput(ns("plot"))
+    ),
+    column(
+      width = 3,
+      uiOutput(ns("options"))
+    )
+  )
+}
+
+tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) {
+  moduleServer(id, function(input, output, session) {
+    output$plot <- renderPlot({
+      do.call(render_plot, purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)))
+    })
+
+    opts <- reactiveValues()
+
+    option_widgets <- lapply(options, function(opt_id) {
+      observeEvent(input[[opt_id]], {
+        opts[[opt_id]] <- input[[opt_id]]
+      })
+
+      textInput(
+        session$ns(opt_id),
+        label = opt_id
+      )
+    })
+
+    output$options <- renderUI(option_widgets)
+  })
+}

inst/shiny/tlg.yaml

@@ -0,0 +1,40 @@
+# Configuration file containing TLG definitions. Each TLG should be a separate entry, with unique ID.
+# The TLG entry should have the following format:
+# id:
+#   is_default: # true / false whether TLG should be included as default
+#   type: # Graph / List / Table
+#   dataset: # name of the dataset
+#   pkid: # standarized id of the TLG
+#   label: # short label to display as tab name
+#   description: # longer descriptions, to be displayed in the order table
+#   link: # link to the documentation of the TLG
+#   fun: # name of the function exported by the package, responsible for generating TLG
+#   opts:        # options that can be passed as arguments to the function
+#     - option1  # will generate input widgets for editing
+#     - option2  # TODO: add ability to specify default value and type
+
+g_pkconc_ind_lin:
+  is_default: true
+  type: Graph
+  dataset: ADPC
+  pkid: pkcg01
+  label: pkcg01 - linear
+  description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale"
+  link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html
+  fun: g_pkconc_ind_lin
+  opts:
+    - xlab
+    - ylab
+g_pkconc_ind_log:
+  is_default: true
+  type: Graph
+  dataset: ADPC
+  pkid: pkcg01
+  label: pkcg01 - log
+  description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale"
+  link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html
+  fun: g_pkconc_ind_log
+  opts:
+    - xlab
+    - ylab
+