Merge pull request #21 from esqLABS/improve-plot

Improve Plot

app/js/Stepper.js

@@ -150,7 +150,7 @@ export default function Stepper({id, initShinyData, ethinicityOptions, metabolis
               unit={shinyData.unit.toLowerCase()}
               measure={shinyData.unit.toLowerCase() == "imperial" ? "lbs" : "kg"}
             />
-            <p className="step-user-input-title">Activity:</p>
+            <p className="step-user-input-title">Metabolism:</p>
             <CategoricalSlider
               options={metabolismOptions}
               initialValue={initShinyData.metabolism}

app/logic/intakes.R

@@ -49,6 +49,9 @@ set_intakes <- function(simulation, intakes) {
     )
   }
 
+  # in case there are 0 enabled_intakes
+  if(is.null(i)) i <- 0
+
   # Set remaining intakes to 0
   for (j in (i + 1):length(dose_paths)) {
     if (j > length(dose_paths)) break

app/logic/plot.R

@@ -1,18 +1,78 @@
 box::use(
   shiny[moduleServer, NS],
-  ospsuite
+  ospsuite,
+  ggplot2[...],
+  scales[breaks_width],
+  gghighlight,
+  stringr[str_detect, regex, str_to_title],
+  lubridate[as_datetime, hm],
+  purrr[map, list_rbind]
 )
 
-get_plot <- function(simulation_results) {
+box::use(
+  app / logic / intakes[convert_time_to_min],
+)
+
+get_plot <- function(app_data) {
   message("Generating time profile plot")
-  dc <- ospsuite::DataCombined$new()
 
-  pc <- ospsuite::DefaultPlotConfiguration$new()
-  pc$xUnit <- "h"
-  pc$legendPosition <- "outsideTopRight"
-  pc$xAxisTicks <- 0:24
+  intakes_df <-
+    map(app_data$intake_data, \(x){
+      data.frame(
+        name = names(x$type),
+        time = as_datetime(hm(x$time))
+      )
+    }) |>
+    list_rbind()
 
-  dc$addSimulationResults(simulation_results[[1]])
+  # p <-
+    ggplot() +
+    geom_line(
+      data = app_data$simulation_results,
+      aes(x = Time, y = simulationValues, color = paths),
+      linewidth = 1.5
+    ) +
+    gghighlight::gghighlight(stringr::str_detect(string = paths, stringr::regex(app_data$active_tab, ignore_case = T)),
+      use_group_by = FALSE,
+      use_direct_label = FALSE,
+      unhighlighted_params = list(colour = NULL, alpha = 0.2)
+    ) +
+    # geom_point_interactive(
+    #   data = intakes_df,
+    #   aes(x = time, tooltip = paste0(format(time, "%H:%M"), ": ", name)),
+    #   y = Inf,
+    #   size = 2,
+    #   hover_nearest = TRUE
+    # ) +
+    scale_color_viridis_d(option = "inferno",begin = 0.2, end = 0.8) +
+    scale_x_datetime(
+      date_labels = "%H:%M", breaks = breaks_width("2 hours"),
+      expand = expansion(c(1 / 24, 0), c(0, 0))
+    ) +
+    scale_y_continuous(expand = expansion(c(0, 0), c(0, 0.05))) +
+    theme_minimal() +
+    theme(
+      axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1),
+      legend.position = "bottom"
+    ) +
+    coord_cartesian(clip = "off") +
+    labs(
+      title = paste("Caffeine Concentration in", str_to_title(app_data$active_tab)),
+      x = "Time (h)",
+      y = "Concentration (mg/L)",
+      color = ""
+    )
 
-  return(ospsuite::plotIndividualTimeProfile(dc, defaultPlotConfiguration = pc))
+  # girafe(
+  #   ggobj = p,
+  #   options = list(
+  #     opts_toolbar(
+  #       saveaspng = FALSE,
+  #       hidden = c("selection", "zoom", "misc")
+  #     ),
+  #     opts_sizing(rescale = TRUE, width = 1),
+  #     opts_hover_inv(css = "opacity:0.1;"),
+  #     opts_hover(css = "stroke-width:2;")
+  #   )
+  # )
 }

app/logic/simulation.R

@@ -1,6 +1,9 @@
 box::use(
   shiny[moduleServer, NS],
-  ospsuite
+  ospsuite,
+  dplyr[mutate, select, filter, row_number, case_when],
+  stringr[str_detect],
+  lubridate[...],
 )
 
 
@@ -18,3 +21,35 @@ load_simulation <- function() {
   )
   return(simulation)
 }
+
+
+get_simulation_results <- function(simulation){
+  results <- ospsuite::runSimulations(simulation)
+
+  df <- ospsuite::simulationResultsToTibble(results[[1]]) |>
+    # Convert µmol/L to mg/L
+    mutate(simulationValues = simulationValues * 10^-6 * molWeight * 10^3) |>
+    select(Time, paths, simulationValues) |>
+    # Transform Paths to a more readable format
+    mutate(paths = factor(
+      case_when(
+      str_detect(paths, ".*PeripheralVenousBlood.*") ~ "Blood",
+      str_detect(paths, ".*Brain.*") ~ "Brain",
+      str_detect(paths, ".*Heart.*") ~ "Heart"
+      ),
+      levels = c("Brain", "Heart", "Blood")
+    ))
+
+  # Remove data before the first non-zero simulationValue (keep last timepoint where simulationValue is 0)
+  start_row <- which(df$simulationValues != 0)[1] - length(unique(df$paths))
+
+  # In case concentration is 0 for whole simulation (no intake enabled)
+  if (is.na(start_row)){
+    start_row <- 1
+  }
+
+  # Subset the data starting from that row
+  df <- filter(df, row_number() >= start_row) |>
+    # Transform minute number to time of the day
+    mutate(Time = as_datetime(Time * 60))
+}

app/main.R

@@ -1,13 +1,12 @@
 box::use(
   bslib[page],
   shiny[moduleServer, NS, observeEvent, reactiveValues, req],
-  ospsuite[runSimulation]
 )
 box::use(
   # Import the component
   app/view/intro_screen,
   app/view/result_screen,
-  app/logic/simulation[load_simulation],
+  app/logic/simulation[load_simulation, get_simulation_results],
   app/logic/individual[set_individual],
   app/logic/intakes[set_intakes]
 )
@@ -30,7 +29,8 @@ server <- function(id) {
       destroy_intro_screen = NULL,
       user_data = NULL,
       intake_data = NULL,
-      simulation_results = NULL
+      simulation_results = NULL,
+      active_tab = "brain"
     )
 
 
@@ -40,12 +40,14 @@ server <- function(id) {
 
     # When user characteristics are received, apply them to the simulation
     observeEvent(app_data$user_data, {
+      app_data$simulation_results <- NULL
       message("1. User data edited!")
       set_individual(simulation, app_data$user_data)
     })
 
     # When user modifies caffeine intakes, update the simulation
     observeEvent(app_data$intake_data, {
+      app_data$simulation_results <- NULL
       message("2. Intake data edited!")
       set_intakes(simulation, app_data$intake_data)
     })
@@ -55,12 +57,11 @@ server <- function(id) {
       req(app_data$intake_data)
       # Indicate calculation start
       message("Running simulation...")
-      app_data$simulation_results <- ospsuite:::runSimulations(simulation)
+      app_data$simulation_results <- get_simulation_results(simulation)
     })
 
     observeEvent(app_data$simulation_results, {
       message("Simulation result received. Destroying intro screen.")
-      # app_data$destroy_intro_screen <- TRUE
       result_screen$server("result_screen", app_data)
     }, once = TRUE)
 

app/view/components/organ_info_tabpanel.R

@@ -92,14 +92,16 @@ ui <- function(id) {
 }
 
 #' @export
-server <- function(id) {
+server <- function(id, app_data) {
   moduleServer(id, function(input, output, session) {
     message("Server started - organ tab")
 
-    observeEvent(input$active_tab, {
-      message("Active tab: ")
-      print(input$active_tab)
-    }, ignoreNULL = FALSE)
-
+    observeEvent(input$active_tab,
+      {
+        message("Active tab changed: ", input$active_tab)
+        app_data$active_tab <- input$active_tab
+      },
+      ignoreNULL = TRUE
+    )
   })
 }

app/view/result_screen.R

@@ -3,6 +3,7 @@ box::use(
   shiny[br, div, h1, h3, img, moduleServer, NS, renderTable, renderUI, renderPlot, plotOutput, tableOutput, tagList, uiOutput, observeEvent],
   shiny.destroy[destroyModule, makeModuleServerDestroyable, makeModuleUIDestroyable],
   htmlwidgets[JS],
+  # ggiraph[girafeOutput, renderGirafe]
 )
 
 box::use(
@@ -18,15 +19,14 @@ ui <- function(id) {
     ns <- NS(id)
     tagList(
       uiOutput(ns("result_screen"))
-
     )
 }
 
 #' @export
 server <- function(id, app_data) {
     moduleServer(id, function(input, output, session) {
       message("Server started - result screen")
-      organ_info_tabpanel$server("organ_info_tabpanel")
+      organ_info_tabpanel$server("organ_info_tabpanel", app_data)
 
       observeEvent(input$edit_characteristics, {
         message("Edit edit_characteristics modal open")
@@ -40,12 +40,16 @@ server <- function(id, app_data) {
         edit_modal_drinks$server("edit_drinks", app_data)
       })
 
+      # output$plot <- renderGirafe({
+      #   app_data$destroy_intro_screen <- TRUE # remove loading screen
+      #   get_plot(app_data)
+      # })
+
       output$plot <- renderPlot({
         app_data$destroy_intro_screen <- TRUE # remove loading screen
-        get_plot(app_data$simulation_results)
+        get_plot(app_data)
       })
 
-
       output$result_screen <- renderUI({
         tagList(
           div(class = "container app-title",
@@ -84,7 +88,10 @@ server <- function(id, app_data) {
                 card(
                   height = 300,
                   full_screen = TRUE,
-                  card_body(plotOutput(session$ns("plot")))
+                  card_body(
+                    # girafeOutput(session$ns("plot"))
+                    plotOutput(session$ns("plot"))
+                    )
                 )
             ),
             div(

dependencies.R

@@ -1,8 +1,12 @@
 # This file allows packrat (used by rsconnect during deployment) to pick up dependencies.
 library(bslib)
+library(gghighlight)
 library(htmlwidgets)
+library(lubridate)
 library(ospsuite)
+library(purrr)
 library(rhino)
+library(scales)
 library(shiny.destroy)
 library(shiny.react)
 library(treesitter)

renv.lock

@@ -543,6 +543,23 @@
       ],
       "Hash": "15e9634c0fcd294799e9b2e929ed1b86"
     },
+    "gghighlight": {
+      "Package": "gghighlight",
+      "Version": "0.4.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "dplyr",
+        "ggplot2",
+        "ggrepel",
+        "lifecycle",
+        "purrr",
+        "rlang",
+        "tibble"
+      ],
+      "Hash": "a8f51a6b707d802a73bcb8920e368a06"
+    },
     "ggplot2": {
       "Package": "ggplot2",
       "Version": "3.5.1",
@@ -568,6 +585,22 @@
       ],
       "Hash": "44c6a2f8202d5b7e878ea274b1092426"
     },
+    "ggrepel": {
+      "Package": "ggrepel",
+      "Version": "0.9.6",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "Rcpp",
+        "ggplot2",
+        "grid",
+        "rlang",
+        "scales",
+        "withr"
+      ],
+      "Hash": "3d4156850acc1161f2f24bc61c9217c1"
+    },
     "ggtext": {
       "Package": "ggtext",
       "Version": "0.1.2",
@@ -849,6 +882,19 @@
       ],
       "Hash": "c145edf05cc128e6ffcfa5d872c46329"
     },
+    "lubridate": {
+      "Package": "lubridate",
+      "Version": "1.9.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "generics",
+        "methods",
+        "timechange"
+      ],
+      "Hash": "680ad542fbcf801442c83a6ac5a2126c"
+    },
     "magrittr": {
       "Package": "magrittr",
       "Version": "2.0.3",
@@ -1681,6 +1727,17 @@
       ],
       "Hash": "829f27b9c4919c16b593794a6344d6c0"
     },
+    "timechange": {
+      "Package": "timechange",
+      "Version": "0.3.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cpp11"
+      ],
+      "Hash": "c5f3c201b931cd6474d17d8700ccb1c8"
+    },
     "tinytex": {
       "Package": "tinytex",
       "Version": "0.54",