Merge pull request #521 from Open-Systems-Pharmacology/develop

Release 1.5.170

.github/workflows/update-dev-website.yml

@@ -0,0 +1,16 @@
+name: Update dev website
+on:
+  push: 
+    branches:
+      - develop    
+
+# The action needs permissions to update the branch
+permissions:
+  contents: write
+
+jobs:
+  update_dev_website:
+    uses: Open-Systems-Pharmacology/Workflows/.github/workflows/CreateGitHubPagesForR.yml@main
+    with:
+      pkgdown_mode: 'devel'
+      extra_r_packages: 'github::Open-Systems-Pharmacology/OSPSuite.RUtils'

.github/workflows/update-release-website.yml

@@ -0,0 +1,17 @@
+name: Update release website
+# The action is triggered only when update is push on main branch
+on:
+  push: 
+    branches:
+      - main
+
+# The action needs permissions to update the branch
+permissions:
+  contents: write
+
+jobs:
+  update_release_website:
+    uses: Open-Systems-Pharmacology/Workflows/.github/workflows/CreateGitHubPagesForR.yml@main
+    with:
+      pkgdown_mode: 'release'
+      extra_r_packages: 'github::Open-Systems-Pharmacology/OSPSuite.RUtils'

.gitignore

@@ -4,4 +4,6 @@
 .Ruserdata
 inst/doc
 doc
+docs
 Meta
+Rplots.pdf

DESCRIPTION

@@ -36,13 +36,13 @@ Imports:
     ospsuite.utils (>= 1.4.0),
     patchwork,
     ggtext,
-    stringr,
+    stringr (>= 1.5.0),
     rlang,
     lifecycle
 Depends: 
     R (>= 3.6)
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 Suggests:
     cowplot,
@@ -122,5 +122,7 @@ Collate:
     'utilities-mapping.R'
     'utilities-molecule-plots.R'
     'utilities-theme.R'
+    'utilities-tlf.R'
     'utils.R'
     'zzz.R'
+Config/testthat/edition: 3

NAMESPACE

@@ -131,8 +131,10 @@ export(getPiTickLabels)
 export(getSameLimits)
 export(getSqrtTickLabels)
 export(getSymmetricLimits)
+export(getTLFSettings)
 export(initializePlot)
 export(isBetween)
+export(loadTLFSettings)
 export(loadThemeFromJson)
 export(plotBoxWhisker)
 export(plotCumulativeTimeProfile)
@@ -149,8 +151,10 @@ export(plotResVsTime)
 export(plotSimulatedTimeProfile)
 export(plotTimeProfile)
 export(plotTornado)
+export(resetTLFSettingsToDefault)
 export(runPlotMaker)
 export(runThemeMaker)
+export(saveTLFSettings)
 export(saveThemeToJson)
 export(setBackground)
 export(setBackgroundPanelArea)
@@ -192,6 +196,7 @@ export(setXGrid)
 export(setY2Axis)
 export(setYAxis)
 export(setYGrid)
+export(tlfSettingsNames)
 export(tlfStatFunctions)
 export(updateExportDimensionsForLegend)
 export(updateTimeProfileLegend)

NEWS.md

@@ -4,12 +4,16 @@
 - The `xLimits` and `yLimits` argument in `PlotConfiguration` are renamed `xAxisLimits` and `yAxisLimits`.
   This will crop the axis limits but keep all the data to generate the plot (see `ggplot2::coord_cartesian`).
 - New `xValuesLimits` and `yValuesLimits` argument in `PlotConfiguration` to filter the **data** used to generate the plot. (see `ggplot2::scale_continuous_x`).
-- Groups names are now wraped on several lines if their number of characters is longer than 60.
-- Plots and plotGrids labels (titles, subtitles, caption and axis labels) are now automatically fitting plot's width and wraped on several lines if too long.
+- Groups names are now wrapped on several lines if their number of characters is longer than 60.
+- Plots and plotGrids labels (titles, subtitles, caption and axis labels) are now automatically fitting plot's width and wrapped on several lines if too long.
 - Plot labels texts are now sanitized from any unsupported characters.
 - Plot labels now have margin around them. This can be configured in  `Label`
 objects.
 
+ ## Minor improvements and bug fixes  
+
+ - Error bars cap sized are now drawn only if the error bars are displayed.
+ - Fix a bug where error bars caps were wrongly displayed (#1410)[https://github.com/Open-Systems-Pharmacology/OSPSuite-R/issues/1410]
 
 # tlf 1.5.0
 

R/atom-plots.R

@@ -173,9 +173,9 @@ addScatter <- function(data = NULL,
         x = .data[[mapLabels$x]],
         y = .data[[mapLabels$y]],
         linetype = .data$legendLabels,
-        color = .data$legendLabels,
-        size = .data$legendLabels
+        color = .data$legendLabels
       ),
+      linewidth = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, aesthetic = "size"),
       alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$points$alpha, aesthetic = "alpha"),
       show.legend = TRUE,
       na.rm = TRUE
@@ -312,8 +312,8 @@ addLine <- function(data = NULL,
           yintercept = .data[[mapLabels$y]],
           linetype = .data$legendLabels,
           color = .data$legendLabels,
-          size = .data$legendLabels
         ),
+        linewidth = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, aesthetic = "size"),
         alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE
       ) +
@@ -336,9 +336,9 @@ addLine <- function(data = NULL,
         mapping = ggplot2::aes(
           xintercept = .data[[mapLabels$x]],
           linetype = .data$legendLabels,
-          color = .data$legendLabels,
-          size = .data$legendLabels
+          color = .data$legendLabels
         ),
+        linewidth = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, aesthetic = "size"),
         alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE
       ) +
@@ -378,8 +378,8 @@ addLine <- function(data = NULL,
           y = .data[[mapLabels$y]],
           linetype = .data$legendLabels,
           color = .data$legendLabels,
-          size = .data$legendLabels
         ),
+        linewidth = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, aesthetic = "size"),
         alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE,
         na.rm = TRUE
@@ -662,7 +662,7 @@ addErrorbar <- function(data = NULL,
         color = .data[[mapLabels$color]],
         group = .data[[mapLabels$color]]
       ),
-      size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),
+      linewidth = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),
       linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),
       alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
       color = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "color"),

R/error-checks.R

@@ -64,11 +64,11 @@
 #' @param values numeric values to be validated
 #' @param nullAllowed logical allowing `NULL` as input
 #' @keywords internal
-.validateIsStrictlyPositive <- function(values, nullAllowed = FALSE){
+.validateIsStrictlyPositive <- function(values, nullAllowed = FALSE) {
   validateIsNumeric(values, nullAllowed = nullAllowed)
   # all(NULL > 0) is true
   # validateIsNumeric already took care of values = null but not allowed situation
-  if(all(values > 0)){
+  if (all(values > 0)) {
     return(invisible())
   }
   stop(messages$errorValuesNotStrictlyPositive(values))
@@ -79,11 +79,11 @@
 #'
 #' @inheritParams isBetween
 #' @keywords internal
-.checkIsBetween <- function(x, left, right, strict = FALSE){
+.checkIsBetween <- function(x, left, right, strict = FALSE) {
   validateIsNumeric(x)
   validateIsNumeric(left)
   validateIsNumeric(right)
-  if(all(isBetween(x, left, right, strict))){
+  if (all(isBetween(x, left, right, strict))) {
     return(invisible())
   }
   warning(messages$warningValuesNotWitinRange(x, left, right, strict))
@@ -97,17 +97,19 @@
 #' @param availableAngles available angle for usage og `ggtext`
 #' @import ospsuite.utils
 #' @keywords internal
-.checkIsInAvailableAngles <- function(angle, availableAngles = c(0,90,180,270)){
+.checkIsInAvailableAngles <- function(angle, availableAngles = c(0, 90, 180, 270)) {
   validateIsNumeric(angle)
-  newAngle <- tryCatch({
-    validateIsIncluded(angle, availableAngles)
-    return(angle)
-    }, 
-    error = function(e){
+  newAngle <- tryCatch(
+    {
+      validateIsIncluded(angle, availableAngles)
+      return(angle)
+    },
+    error = function(e) {
       angleDifferences <- abs(angle - availableAngles)
       closestAngle <- head(availableAngles[which(angleDifferences == min(angleDifferences))], 1)
       warning(messages$warningAngleNotIncludedInAvailableAngles(angle, closestAngle))
-    return(closestAngle)
-  })
+      return(closestAngle)
+    }
+  )
   return(newAngle)
-}
+}

R/global-vars.R

@@ -10,7 +10,8 @@ utils::globalVariables(
     "linetypeLength",
     "newPlotObject",
     "shape",
-    "size"
+    "size",
+    "newEnv"
   ),
   package = "tlf",
   add = FALSE

R/plot-cumulative-time-profile.R

@@ -81,7 +81,7 @@ plotCumulativeTimeProfile <- function(data = NULL,
       color = .data[[mapLabels$color]]
     ),
     alpha = aestheticValues$alpha,
-    size = aestheticValues$size,
+    linewidth = aestheticValues$size,
     linetype = aestheticValues$linetype,
     # Cumulative componenent
     position = ggplot2::position_stack(),

R/plot-ddiratio.R

@@ -103,7 +103,7 @@ plotDDIRatio <- function(data,
       color = aestheticValues$color,
       linetype = aestheticValues$linetype,
       alpha = aestheticValues$alpha,
-      size = aestheticValues$size
+      linewidth = aestheticValues$size
     ) +
     ggplot2::geom_path(
       data = guestData,
@@ -112,7 +112,7 @@ plotDDIRatio <- function(data,
       color = aestheticValues$color,
       linetype = aestheticValues$linetype,
       alpha = aestheticValues$alpha,
-      size = aestheticValues$size
+      linewidth = aestheticValues$size
     )
 
   # 2- Error bars

R/plot-histogram.R

@@ -184,7 +184,7 @@ plotHistogram <- function(data = NULL,
           color = .data$legendLabels,
           linetype = .data$legendLabels
         ),
-        size = aestheticValues$size,
+        linewidth = aestheticValues$size,
         alpha = aestheticValues$alpha
       )
   }

R/plot-simulated-time-profile.R

@@ -126,7 +126,7 @@ plotSimulatedTimeProfile <- function(data = NULL,
           color = .data[[mapLabels$color]],
           linetype = .data[[mapLabels$linetype]]
         ),
-        size = aestheticValues$size,
+        linewidth = aestheticValues$size,
         alpha = aestheticValues$alpha,
         na.rm = TRUE,
         show.legend = TRUE,

R/plot-timeprofile.R

@@ -190,7 +190,7 @@ plotTimeProfile <- function(data = NULL,
           color = .data[[mapLabels$color]],
           linetype = .data[[mapLabels$linetype]]
         ),
-        size = aestheticValues$size,
+        linewidth = aestheticValues$size,
         alpha = aestheticValues$alpha,
         na.rm = TRUE,
         show.legend = TRUE,

R/plot-tornado.R

@@ -99,7 +99,7 @@ plotTornado <- function(data = NULL,
         color = .data[[mapLabels$color]]
       ),
       alpha = aestheticValues$alpha,
-      size = aestheticValues$size,
+      linewidth = aestheticValues$size,
       linetype = aestheticValues$linetype,
       position = ggplot2::position_dodge(width = plotConfiguration$dodge),
       na.rm = TRUE

R/plotconfiguration-background.R

@@ -203,7 +203,7 @@ BackgroundElement <- R6::R6Class(
       ggplot2::element_rect(
         fill = fill %||% self$fill,
         colour = color %||% self$color,
-        size = size %||% as.numeric(self$size),
+        linewidth = size %||% as.numeric(self$size),
         linetype = linetype %||% self$linetype
       )
     }
@@ -226,7 +226,7 @@ LineElement <- R6::R6Class(
     createPlotElement = function(color = NULL, size = NULL, linetype = NULL) {
       ggplot2::element_line(
         colour = color %||% self$color,
-        size = size %||% as.numeric(self$size),
+        linewidth = size %||% as.numeric(self$size),
         linetype = linetype %||% self$linetype
       )
     }

R/plotconfiguration-export.R

@@ -97,7 +97,8 @@ ExportConfiguration <- R6::R6Class(
             width = self$width,
             height = self$height,
             units = self$units,
-            dpi = self$dpi
+            dpi = self$dpi,
+            create.dir = TRUE
           )
         },
         error = function(e) {

R/plotconfiguration-legend.R

@@ -67,11 +67,22 @@ LegendConfiguration <- R6::R6Class(
       # Update legend position and alignment
       legendPosition <- .createPlotLegendPosition(private$.position)
 
-      plotObject <- plotObject + ggplot2::theme(
-        legend.position = c(legendPosition$xPosition, legendPosition$yPosition),
-        legend.justification = c(legendPosition$xJustification, legendPosition$yJustification),
-        legend.direction = "vertical"
-      )
+
+      if (is.numeric(c(legendPosition$xPosition, legendPosition$yPosition))) {
+        plotObject <- plotObject + ggplot2::theme(
+          legend.position = "inside",
+          legend.position.inside = c(legendPosition$xPosition, legendPosition$yPosition),
+          legend.justification = c(legendPosition$xJustification, legendPosition$yJustification),
+          legend.direction = "vertical"
+        )
+      } else if (is.character(c(legendPosition$xPosition, legendPosition$yPosition))) {
+        plotObject <- plotObject + ggplot2::theme(
+          legend.position = c(legendPosition$xPosition, legendPosition$yPosition),
+          legend.justification = c(legendPosition$xJustification, legendPosition$yJustification),
+          legend.direction = "vertical"
+        )
+      }
+
       # TO DO: update caption properties before returning plot
       return(plotObject)
     }

R/timeprofile-plotconfiguration.R

@@ -64,10 +64,10 @@ TimeProfilePlotConfiguration <- R6::R6Class(
 
       # On right axis, ggtext mirror angles. This is a workaround to get the
       # correct angle
-      if (private$.labels$y2label$font$angle %% 360 == 180){
+      if (private$.labels$y2label$font$angle %% 360 == 180) {
         private$.labels$y2label$font$angle <- 270
       }
-      if (private$.labels$y2label$font$angle %% 360 == 270){
+      if (private$.labels$y2label$font$angle %% 360 == 270) {
         private$.labels$y2label$font$angle <- 180
       }