Fixes #867 Fixes #866 create appropriate minor and major time ticks (#…

…927)
Open-Systems-Pharmacology · Sep 13, 2022 · 63b5fcb · 63b5fcb
1 parent d949223
commit 63b5fcb
Show file tree

Hide file tree

Showing 10 changed files with 166 additions and 50 deletions.
diff --git a/R/qualification-comparison-time-profile.R b/R/qualification-comparison-time-profile.R
@@ -29,6 +29,10 @@ plotQualificationComparisonTimeProfile <- function(configurationPlan, settings)
       targetUnit = axesProperties$x$unit,
       sourceUnit = timeProfilePlan$TimeUnit
     )
+    axesProperties$x <- c(
+      axesProperties$x,
+      getTimeTicksFromUnit(axesProperties$x$unit, simulationDuration)
+    )
 
     plotConfiguration <- getPlotConfigurationFromPlan(timeProfilePlan[["PlotSettings"]])
     timeProfilePlot <- tlf::initializePlot(plotConfiguration)

diff --git a/R/qualification-time-profile.R b/R/qualification-time-profile.R
@@ -252,6 +252,10 @@ plotQualificationPopulationTimeProfile <- function(simulationAnalysis, observedD
     simulationPathResults$data[, "Time"],
     axesProperties$x$unit
   )
+  axesProperties$x <- c(
+    axesProperties$x,
+    getTimeTicksFromUnit(axesProperties$x$unit, time)
+  )
   outputValues <- ospsuite::toUnit(
     simulationQuantity,
     simulationPathResults$data[, outputPath],

diff --git a/R/utilities-absorption.R b/R/utilities-absorption.R
@@ -222,6 +222,7 @@ plotAbsorptionTimeProfile <- function(data,
     metaData = metaData,
     dataMapping = timeVsFractionDataMapping
   )
+  plotConfiguration <- updatePlotConfigurationTimeTicks(data, metaData, dataMapping, plotConfiguration)
 
   timeVsFractionPlot <- tlf::addLine(
     data = data,

diff --git a/R/utilities-configuration-plan.R b/R/utilities-configuration-plan.R
@@ -136,7 +136,13 @@ updatePlotAxes <- function(plotObject, axesProperties) {
   )
 
   try({
-    plotObject <- tlf::setXAxis(plotObject, scale = axesProperties$x$scale, limits = c(axesProperties$x$min, axesProperties$x$max))
+    plotObject <- tlf::setXAxis(
+      plotObject,
+      scale = axesProperties$x$scale,
+      limits = c(axesProperties$x$min, axesProperties$x$max),
+      ticks = axesProperties$x$ticks,
+      ticklabels = axesProperties$x$ticklabels
+    )
   })
   try({
     plotObject <- tlf::setYAxis(plotObject, scale = axesProperties$y$scale, limits = c(axesProperties$y$min, axesProperties$y$max))

diff --git a/R/utilities-goodness-of-fit.R b/R/utilities-goodness-of-fit.R
@@ -517,28 +517,26 @@ plotMeanTimeProfile <- function(simulatedData,
                                 metaData = NULL,
                                 dataMapping = NULL,
                                 plotConfiguration = NULL) {
+  plotConfiguration <- plotConfiguration %||%
+    TimeProfilePlotConfiguration$new(
+      data = simulatedData,
+      metaData = metaData,
+      dataMapping = dataMapping
+    )
+  plotConfiguration <- updatePlotConfigurationTimeTicks(simulatedData, metaData, dataMapping, plotConfiguration)
+
   timeProfilePlot <- tlf::addLine(
     data = simulatedData,
     metaData = metaData,
     dataMapping = dataMapping,
-    plotConfiguration = plotConfiguration %||%
-      TimeProfilePlotConfiguration$new(
-        data = simulatedData,
-        metaData = metaData,
-        dataMapping = dataMapping
-      )
+    plotConfiguration = plotConfiguration
   )
   if (!isEmpty(observedData)) {
     timeProfilePlot <- tlf::addScatter(
       data = observedData,
       metaData = metaData,
       dataMapping = dataMapping,
-      plotConfiguration = plotConfiguration %||%
-        TimeProfilePlotConfiguration$new(
-          data = simulatedData,
-          metaData = metaData,
-          dataMapping = dataMapping
-        ),
+      plotConfiguration = plotConfiguration,
       plotObject = timeProfilePlot
     )
   }
@@ -547,12 +545,7 @@ plotMeanTimeProfile <- function(simulatedData,
       data = lloqData,
       metaData = metaData,
       dataMapping = dataMapping,
-      plotConfiguration = plotConfiguration %||%
-        TimeProfilePlotConfiguration$new(
-          data = simulatedData,
-          metaData = metaData,
-          dataMapping = dataMapping
-        ),
+      plotConfiguration = plotConfiguration,
       plotObject = timeProfilePlot
     )
   }
@@ -585,54 +578,42 @@ plotPopulationTimeProfile <- function(simulatedData,
   metaData$ymin <- metaData$Concentration
   metaData$ymax <- metaData$Concentration
 
+  plotConfiguration <- plotConfiguration %||%
+    TimeProfilePlotConfiguration$new(
+      data = simulatedData,
+      metaData = metaData,
+      dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
+    )
+  plotConfiguration <- updatePlotConfigurationTimeTicks(simulatedData, metaData, dataMapping, plotConfiguration)
+
   timeProfilePlot <- tlf::addRibbon(
     x = simulatedData$Time,
     ymin = simulatedData$lowPerc,
     ymax = simulatedData$highPerc,
     metaData = metaData,
     caption = simulatedData$legendRange,
-    plotConfiguration = plotConfiguration %||%
-      TimeProfilePlotConfiguration$new(
-        data = simulatedData,
-        metaData = metaData,
-        dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
-      )
+    plotConfiguration = plotConfiguration
   )
   timeProfilePlot <- tlf::addLine(
     x = simulatedData$Time,
     y = simulatedData$median,
     caption = simulatedData$legendMedian,
-    plotConfiguration = plotConfiguration %||%
-      TimeProfilePlotConfiguration$new(
-        data = simulatedData,
-        metaData = metaData,
-        dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
-      ),
+    plotConfiguration = plotConfiguration,
     plotObject = timeProfilePlot
   )
   timeProfilePlot <- tlf::addLine(
     x = simulatedData$Time,
     y = simulatedData$mean,
     caption = simulatedData$legendMean,
-    plotConfiguration = plotConfiguration %||%
-      TimeProfilePlotConfiguration$new(
-        data = simulatedData,
-        metaData = metaData,
-        dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
-      ),
+    plotConfiguration = plotConfiguration,
     plotObject = timeProfilePlot
   )
   if (!isEmpty(observedData)) {
     timeProfilePlot <- tlf::addScatter(
       data = observedData,
       metaData = metaData,
       dataMapping = dataMapping,
-      plotConfiguration = plotConfiguration %||%
-        TimeProfilePlotConfiguration$new(
-          data = simulatedData,
-          metaData = metaData,
-          dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
-        ),
+      plotConfiguration = plotConfiguration,
       plotObject = timeProfilePlot
     )
   }
@@ -641,12 +622,7 @@ plotPopulationTimeProfile <- function(simulatedData,
       data = lloqData,
       metaData = metaData,
       dataMapping = dataMapping,
-      plotConfiguration = plotConfiguration %||%
-        TimeProfilePlotConfiguration$new(
-          data = simulatedData,
-          metaData = metaData,
-          dataMapping = TimeProfileDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax")
-        ),
+      plotConfiguration = plotConfiguration,
       plotObject = timeProfilePlot
     )
   }
@@ -1065,6 +1041,10 @@ getResidualsPlotResults <- function(timeRange, residualsData, metaDataFrame, str
     "Residuals" = list(dimension = residualsLegend, unit = "")
   )
 
+  residualTimeTicks <- getTimeTicksFromUnit(
+    residualsMetaData$Time$unit,
+    timeValues = residualsData$Time
+  )
   goodnessOfFitPlots[["resVsTime"]] <- tlf::plotResVsTime(
     data = residualsData,
     metaData = residualsMetaData,
@@ -1075,6 +1055,11 @@ getResidualsPlotResults <- function(timeRange, residualsData, metaDataFrame, str
     ),
     plotConfiguration = settings$plotConfigurations[["resVsTime"]]
   )
+  goodnessOfFitPlots[["resVsTime"]] <- tlf::setXAxis(
+    plotObject = goodnessOfFitPlots[["resVsTime"]],
+    ticks = residualTimeTicks$ticks,
+    ticklabels = residualTimeTicks$ticklabels
+  )
   goodnessOfFitCaptions[["resVsTime"]] <- getGoodnessOfFitCaptions(structureSet, "resVsTime", residualScale)
 
   goodnessOfFitPlots[["resHisto"]] <- tlf::plotHistogram(

diff --git a/R/utilities-mass-balance.R b/R/utilities-mass-balance.R
@@ -262,6 +262,7 @@ plotMassBalanceTimeProfile <- function(data,
     metaData = metaData,
     dataMapping = timeVsAmountDataMapping
   )
+  plotConfiguration <- updatePlotConfigurationTimeTicks(data, metaData, dataMapping, plotConfiguration)
 
   timeVsAmountPlot <- tlf::initializePlot(plotConfiguration)
 
@@ -303,6 +304,7 @@ plotMassBalanceCumulativeTimeProfile <- function(data,
     metaData = metaData,
     dataMapping = timeVsAmountDataMapping
   )
+  plotConfiguration <- updatePlotConfigurationTimeTicks(data, metaData, dataMapping, plotConfiguration)
 
   timeVsAmountPlot <- tlf::initializePlot(plotConfiguration)
 

diff --git a/R/utilities-plots.R b/R/utilities-plots.R
@@ -79,6 +79,71 @@ autoAxesTicksFromLimits <- function(limits) {
   return(rep(c(1, 2, 5), length(logTicks)) * 10^rep(logTicks, each = 3))
 }
 
+#' @title getTimeTicksFromUnit
+#' @description Defines auto time ticks from time unit and time values
+#' @param unit A time unit as defined in `ospsuite::ospUnits$Time`
+#' @param timeValues Numeric values used by the data
+#' @return List of `ticks` and their `ticklabels`
+#' @keywords internal
+getTimeTicksFromUnit <- function(unit, timeValues = NULL) {
+  if (isEmpty(timeValues)) {
+    return()
+  }
+  minTime <- floor(min(0, as.numeric(timeValues), na.rm = TRUE))
+  maxTime <- ceiling(max(as.numeric(timeValues), na.rm = TRUE))
+  # For undefined ticking of units, assume major tick every 10 units (eg. 10 seconds)
+  majorTickStep <- 10
+  # For undefined ticking of units, assume minor tick every 1 unit (eg. 1 seconds)
+  minorTickStep <- 1
+
+  if (isIncluded(unit, ospsuite::ospUnits$Time$h)) {
+    # Major ticks every 6 hours
+    majorTickStep <- 6
+  }
+  if (isIncluded(unit, ospsuite::ospUnits$Time$`day(s)`)) {
+    # Major ticks every 7 days
+    majorTickStep <- 7
+  }
+  if (isIncluded(unit, ospsuite::ospUnits$Time$`week(s)`)) {
+    # Major ticks every 4 weeks
+    majorTickStep <- 4
+  }
+  if (isIncluded(unit, ospsuite::ospUnits$Time$`month(s)`)) {
+    # Major ticks every 6 months
+    majorTickStep <- 6
+  }
+
+  minorTicks <- seq(minTime, maxTime, minorTickStep)
+  majorTicks <- seq(minTime, maxTime, majorTickStep)
+  ticklabels <- as.character(minorTicks)
+  ticklabels[!(minorTicks %in% majorTicks)] <- ""
+
+  timeTicks <- list(
+    ticks = minorTicks,
+    ticklabels = ticklabels
+  )
+  return(timeTicks)
+}
+
+#' @title updatePlotConfigurationTimeTicks
+#' @description Update time ticks based on selected time unit in `PlotConfiguration` objects
+#' @param data data.frame
+#' @param metaData meta data on `data`
+#' @param dataMapping `XYGDataMapping` R6 class object from `tlf` library
+#' @param plotConfiguration `PlotConfiguration` R6 class object from `tlf` library
+#' @return A `PlotConfiguration` object
+#' @keywords internal
+updatePlotConfigurationTimeTicks <- function(data, metaData, dataMapping, plotConfiguration) {
+  timeValues <- data[, dataMapping$x]
+  timeUnit <- metaData[[dataMapping$x]]$unit
+  timeTicks <- getTimeTicksFromUnit(timeUnit, timeValues)
+
+  plotConfiguration$xAxis$ticks <- timeTicks$ticks
+  plotConfiguration$xAxis$ticklabels <- timeTicks$ticklabels
+
+  return(plotConfiguration)
+}
+
 #' @title getPlotConfigurationFromPlan
 #' @description Get the appropriate `PlotConfiguration` object with scaled dimensions for exporting it
 #' @param plotProperties Plot properties from configuration plan

diff --git a/man/getTimeTicksFromUnit.Rd b/man/getTimeTicksFromUnit.Rd
diff --git a/man/pkDictionaryQualificationOSP.Rd b/man/pkDictionaryQualificationOSP.Rd
diff --git a/man/updatePlotConfigurationTimeTicks.Rd b/man/updatePlotConfigurationTimeTicks.Rd