Fixes Open-Systems-Pharmacology#200 legend options for font and title…

… are better defined

R/atom-plots.R

@@ -36,8 +36,7 @@ initializePlot <- function(plotConfiguration = NULL) {
   plotObject <- setXGrid(plotObject)
   plotObject <- setYGrid(plotObject)
   plotObject <- setPlotLabels(plotObject)
-  plotObject <- setLegendPosition(plotObject)
-  plotObject <- setLegendFont(plotObject)
+  plotObject <- setLegend(plotObject)
 
   return(plotObject)
 }

R/plotconfiguration-legend.R

@@ -7,30 +7,31 @@ LegendConfiguration <- R6::R6Class(
     #' @description Create a new `LegendConfiguration` object
     #' @param position position of the legend as defined by enum `LegendPositions`
     #' @param caption data.frame containing the properties of the legend caption
-    #' @param title character title of the legend caption. A value of `NULL` removes the title.
-    #' @param titleFont `Font` object defining the font of the legend title
+    #' @param title character or `Label` object defining the title of the legend. A value of `NULL` removes the title.
     #' @param font `Font` object defining the font of the legend caption
     #' @param background `BackgroundElement` object defining the background of the legend
     #' @return A new `LegendConfiguration` object
     initialize = function(position = NULL,
                           caption = NULL,
                           title = NULL,
-                          titleFont = NULL,
                           font = NULL,
                           background = NULL) {
       validateIsIncluded(position, LegendPositions, nullAllowed = TRUE)
-      validateIsString(title, nullAllowed = TRUE)
-      validateIsOfType(titleFont, "Font", nullAllowed = TRUE)
+      validateIsOfType(title, c("character", "Label"), nullAllowed = TRUE)
       validateIsOfType(font, "Font", nullAllowed = TRUE)
       validateIsOfType(background, "BackgroundElement", nullAllowed = TRUE)
 
       currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE)
       private$.position <- position %||% currentTheme$background$legendPosition
       private$.font <- font %||% currentTheme$fonts$legend
-      private$.titleFont <- titleFont %||% currentTheme$fonts$legendTitle
       private$.background <- background %||% currentTheme$background$legend
 
-      private$.title <- title
+      # Title properties
+      private$.title <- asLabel(title, font = currentTheme$fonts$legendTitle)
+      if(isOfType(title, "Label")){
+        private$.title <- title
+      }
+
       private$.caption <- caption %||% data.frame()
     },
 
@@ -44,17 +45,14 @@ LegendConfiguration <- R6::R6Class(
         ggplot2::theme(
           legend.background = private$.background$createPlotElement(),
           legend.text = private$.font$createPlotFont(),
-          legend.title = private$.titleFont$createPlotFont(),
+          legend.title = private$.title$createPlotFont(),
           # symbol background same as legend background
           legend.key = private$.background$createPlotElement(linetype = Linetypes$blank)
         )
 
-      # For legend title, if no title, element_blank should be used
-      if (isOfLength(private$.title, 0)) {
-        plotObject <- plotObject + ggplot2::theme(legend.title = ggplot2::element_blank())
-      }
-      # Update legend position
+      # 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),
@@ -93,16 +91,7 @@ LegendConfiguration <- R6::R6Class(
       private$.font <- value %||% currentTheme$fonts$legend
       return(invisible())
     },
-    #' @field titleFont `Font` object defining the font of the legend title
-    titleFont = function(value) {
-      if (missing(value)) {
-        return(private$.titleFont)
-      }
-      validateIsOfType(value, "Font", nullAllowed = TRUE)
-      currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE)
-      private$.titleFont <- value %||% currentTheme$fonts$legendTitle
-      return(invisible())
-    },
+
     #' @field background `Background` object defining the background of the legend
     background = function(value) {
       if (missing(value)) {
@@ -118,15 +107,17 @@ LegendConfiguration <- R6::R6Class(
       if (missing(value)) {
         return(private$.title)
       }
-      validateIsString(value, nullAllowed = TRUE)
-      private$.title <- value
+      validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE)
+      if(isOfType(value, "Label")){
+        private$.title <- asLabel(value)
+      }
+      private$.title <- asLabel(value, font = private$.title$font)
       return(invisible())
     }
   ),
   private = list(
     .position = NULL,
     .title = NULL,
-    .titleFont = NULL,
     .font = NULL,
     .background = NULL,
     .caption = NULL

R/plotconfiguration.R

@@ -16,7 +16,7 @@ PlotConfiguration <- R6::R6Class(
     #' @param xlabel character or `Label` object defining plot xlabel
     #' @param ylabel character or `Label` object defining plot ylabel
     #' @param legend `LegendConfiguration` object defining legend properties
-    #' @param legendTitle character defining legend title
+    #' @param legendTitle character or `Label` object defining legend title
     #' @param legendPosition character defining legend position.
     #' Use Enum `LegendPositions` to get a list of available to legend positions.
     #' @param xAxis `XAxisConfiguration` object defining x-axis properties

R/themes.R

@@ -101,6 +101,7 @@ ThemeFont <- R6::R6Class(
 #' @description R6 class defining theme background properties
 #' @field watermark character defining content of watermark
 #' @field legendPosition character defining where legend should usually be placed
+#' @field legendTitle character defining the content of legend title
 #' @field plot `BackgroundElement` object for plot area properties (outside of panel)
 #' @field panel `BackgroundElement` object for plot area properties (inside of panel)
 #' @field xAxis `BackgroundElement` object for x axis properties
@@ -114,6 +115,7 @@ ThemeBackground <- R6::R6Class(
   public = list(
     watermark = NULL,
     legendPosition = NULL,
+    legendTitle = NULL,
     plot = NULL,
     panel = NULL,
     xAxis = NULL,
@@ -125,20 +127,22 @@ ThemeBackground <- R6::R6Class(
     #' @description Create a new `ThemeBackground` object
     #' @param watermark character defining content of watermark
     #' @param legendPosition character defining where legend should usually be placed
+    #' @param legendTitle character defining the content of legend title
     #' @param plot `BackgroundElement` object or list for plot area properties (outside of panel)
     #' @param panel `BackgroundElement` object or list for plot area properties (inside of panel)
     #' @param xAxis `BackgroundElement` object or list for x axis properties
     #' @param yAxis `BackgroundElement` object or list for y axis properties
     #' @param xGrid `BackgroundElement` object or list for x grid properties
     #' @param yGrid `BackgroundElement` object or list for y grid properties
     #' @param legend `BackgroundElement` object or list for legend area properties
-    #' @param baseFill name of base color fill of undefined background elements. Default is white.
-    #' @param baseColor name of base color of undefined background elements. Default is black.
+    #' @param baseFill name of base color fill of undefined background elements. Default is "white".
+    #' @param baseColor name of base color of undefined background elements. Default is "black".
     #' @param baseSize name of base size of undefined background elements. Default is 0.5.
     #' @param baseLinetype name of base size of undefined background elements. Default is "solid".
-    #' @return A new `ThemeFont` object
+    #' @return A new `ThemeBackground` object
     initialize = function(watermark = NULL,
                           legendPosition = NULL,
+                          legendTitle = NULL,
                           plot = NULL,
                           panel = NULL,
                           xAxis = NULL,
@@ -150,21 +154,34 @@ ThemeBackground <- R6::R6Class(
                           baseColor = "black",
                           baseSize = 0.5,
                           baseLinetype = "solid") {
-      # Validate necessary input
+      # Validate inputs
       validateIsString(baseFill)
       validateIsString(baseColor)
-      validateIsString(baseLinetype)
+      validateIsIncluded(baseLinetype, Linetypes)
       validateIsNumeric(baseSize)
+      validateIsString(watermark, nullAllowed = TRUE)
+      validateIsString(legendTitle, nullAllowed = TRUE)
+      validateIsIncluded(legendPosition, LegendPositions, nullAllowed = TRUE)
 
       self$watermark <- watermark %||% ""
       self$legendPosition <- legendPosition %||% LegendPositions$outsideRight
+      self$legendTitle <- legendTitle
 
       # Create all field properties by parsing and evaluating their expression
       areaFieldNames <- c("plot", "panel", "legend")
       lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid")
 
-      setAreaExpression <- parse(text = paste0("self$", areaFieldNames, " <- BackgroundElement$new(fill = ", areaFieldNames, "$fill %||% baseFill, color = ", areaFieldNames, "$color %||% baseColor, size = ", areaFieldNames, "$size %||% baseSize, linetype = ", areaFieldNames, "$linetype %||% baseLinetype)"))
-      setLineExpression <- parse(text = paste0("self$", lineFieldNames, " <- LineElement$new(color = ", lineFieldNames, "$color %||% baseColor, size = ", lineFieldNames, "$size %||% baseSize, linetype = ", lineFieldNames, "$linetype %||% baseLinetype)"))
+      setAreaExpression <- parse(text = paste0(
+        "self$", areaFieldNames, " <- BackgroundElement$new(",
+        "fill = ", areaFieldNames, "$fill %||% baseFill,",
+        "color = ", areaFieldNames, "$color %||% baseColor,",
+        "size = ", areaFieldNames, "$size %||% baseSize,",
+        "linetype = ", areaFieldNames, "$linetype %||% baseLinetype)"))
+      setLineExpression <- parse(text = paste0(
+        "self$", lineFieldNames, " <- LineElement$new(",
+        "color = ", lineFieldNames, "$color %||% baseColor,",
+        "size = ", lineFieldNames, "$size %||% baseSize,",
+        "linetype = ", lineFieldNames, "$linetype %||% baseLinetype)"))
       eval(setAreaExpression)
       eval(setLineExpression)
     },
@@ -175,18 +192,21 @@ ThemeBackground <- R6::R6Class(
       jsonObject <- list()
       jsonObject$watermark <- self$watermark
       jsonObject$legendPosition <- self$legendPosition
+      jsonObject$legendTitle <- self$legendTitle
       areaFieldNames <- c("plot", "panel", "legend")
       lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid")
 
-      setJsonAreaExpression <- parse(text = paste0("jsonObject$", areaFieldNames, " <- list(
-                                                   fill = self$", areaFieldNames, "$fill,
-                                                   color = self$", areaFieldNames, "$color,
-                                                   size = self$", areaFieldNames, "$size,
-                                                   linetype = self$", areaFieldNames, "$linetype)"))
-      setJsonLineExpression <- parse(text = paste0("jsonObject$", lineFieldNames, " <- list(
-                                                   color = self$", lineFieldNames, "$color,
-                                                   size = self$", lineFieldNames, "$size,
-                                                   linetype = self$", lineFieldNames, "$linetype)"))
+      setJsonAreaExpression <- parse(text = paste0(
+        "jsonObject$", areaFieldNames, " <- list(",
+        "fill = self$", areaFieldNames, "$fill,",
+        "color = self$", areaFieldNames, "$color,",
+        "size = self$", areaFieldNames, "$size,",
+        "linetype = self$", areaFieldNames, "$linetype)"))
+      setJsonLineExpression <- parse(text = paste0(
+        "jsonObject$", lineFieldNames, " <- list(",
+        "color = self$", lineFieldNames, "$color,",
+        "size = self$", lineFieldNames, "$size,",
+        "linetype = self$", lineFieldNames, "$linetype)"))
       eval(setJsonAreaExpression)
       eval(setJsonLineExpression)
       return(jsonObject)

R/utilities-export.R

@@ -195,7 +195,7 @@ exportPlotConfigurationCode <- function(plotConfiguration, name = "plotConfigura
   }
 
   legendCode <- "# Define/Overwrite PlotConfiguration legend properties"
-  for (property in c("position", "title", "background$fill", "background$color", "background$size", "background$linetype", "titleFont$color", "titleFont$size", "titleFont$fontFace", "titleFont$angle", "font$color", "font$size", "font$fontFace", "font$angle")) {
+  for (property in c("position", "background$fill", "background$color", "background$size", "background$linetype", "title$text", "title$font$color", "title$font$size", "title$font$fontFace", "title$font$angle", "font$color", "font$size", "font$fontFace", "font$angle")) {
     legendText <- paste0("plotConfiguration$legend$", property)
     updatedLegendText <- paste0(name, "$legend$", property)
     legendValue <- eval(parse(text = legendText))

R/utilities-legend.R

@@ -29,24 +29,29 @@ setLegend <- function(plotObject,
 
 #' @title setLegendFont
 #' @param plotObject ggplot object
-#' @param color color of legend font
-#' @param size size of legend font
-#' @param fontFace color of legend font
-#' @param color color of legend font
-#' @param angle angle of legend font
+#' @param size numeric defining the size of legend font
+#' @param color character defining the color of legend font
+#' @param fontFamily character defining the family of legend font
+#' @param fontFace character defining the legend font face as defined in helper enum `FontFaces`.
+#' @param angle numeric defining the angle of legend font
+#' @param align character defining the alignment of legend font as defined in helper enum `Alignments`.
 #' @return A ggplot object
 #' @description Set legend font properties
 #' @export
 setLegendFont <- function(plotObject,
                           color = NULL,
                           size = NULL,
+                          fontFamily = NULL,
                           fontFace = NULL,
-                          angle = NULL) {
+                          angle = NULL,
+                          align = NULL) {
   validateIsOfType(plotObject, "ggplot")
+  validateIsString(color, nullAllowed = TRUE)
+  validateIsString(fontFamily, nullAllowed = TRUE)
   validateIsNumeric(size, nullAllowed = TRUE)
   validateIsNumeric(angle, nullAllowed = TRUE)
-  validateIsString(color, nullAllowed = TRUE)
-  validateIsString(fontFace, nullAllowed = TRUE)
+  validateIsIncluded(fontFace, FontFaces, nullAllowed = TRUE)
+  validateIsIncluded(align, Alignments, nullAllowed = TRUE)
 
   # Clone plotConfiguration into a new plot object
   # Prevents update of R6 class being spread to plotObject
@@ -55,53 +60,48 @@ setLegendFont <- function(plotObject,
 
   # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration
   legend <- newPlotObject$plotConfiguration$legend
-  eval(parseVariableToObject("legend$font", c("color", "size", "angle", "fontFace"), keepIfNull = TRUE))
+  eval(parseVariableToObject("legend$font", c("size", "color", "fontFace", "fontFamily", "angle", "align"), keepIfNull = TRUE))
   newPlotObject <- legend$updatePlot(newPlotObject)
   return(newPlotObject)
 }
 
 #' @title setLegendTitle
 #' @param plotObject ggplot object
 #' @param title character or `Label` object
-#' @param color color of legend font
-#' @param size size of legend font
-#' @param fontFace color of legend font
-#' @param color color of legend font
-#' @param angle angle of legend font
+#' @param size numeric defining the size of legend title
+#' @param color character defining the color of legend title
+#' @param fontFamily character defining the family of legend title
+#' @param fontFace character defining the legend title face as defined in helper enum `FontFaces`.
+#' @param angle numeric defining the angle of legend title
+#' @param align character defining the alignment of legend title as defined in helper enum `Alignments`.
 #' @return A ggplot object
 #' @description Set legend title
 #' @export
 setLegendTitle <- function(plotObject,
                            title = NULL,
                            color = NULL,
                            size = NULL,
+                           fontFamily = NULL,
                            fontFace = NULL,
-                           angle = NULL) {
+                           angle = NULL,
+                           align = NULL) {
   validateIsOfType(plotObject, "ggplot")
   validateIsOfType(title, c("character", "Label"), nullAllowed = TRUE)
+  validateIsString(color, nullAllowed = TRUE)
+  validateIsString(fontFamily, nullAllowed = TRUE)
   validateIsNumeric(size, nullAllowed = TRUE)
   validateIsNumeric(angle, nullAllowed = TRUE)
-  validateIsString(color, nullAllowed = TRUE)
-  validateIsString(fontFace, nullAllowed = TRUE)
-
+  validateIsIncluded(fontFace, FontFaces, nullAllowed = TRUE)
+  validateIsIncluded(align, Alignments, nullAllowed = TRUE)
+  
   # Clone plotConfiguration into a new plot object
   # Prevents update of R6 class being spread to plotObject
   newPlotObject <- plotObject
   newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE)
-
-  # If title is`Label`, reconcile its properties with other inputs
-  if (isOfType(title, "Label")) {
-    color <- color %||% title$font$color
-    size <- size %||% title$font$size
-    angle <- angle %||% title$font$angle
-    fontFace <- fontFace %||% title$font$fontFace
-    title <- title$text
-  }
-
-  # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration
   legend <- newPlotObject$plotConfiguration$legend
-  eval(parseVariableToObject("legend$titleFont", c("color", "size", "angle", "fontFace"), keepIfNull = TRUE))
-  legend$title <- title %||% legend$title
+  legend$title <- title
+
+  eval(parseVariableToObject("legend$title$font", c("size", "color", "fontFace", "fontFamily", "angle", "align"), keepIfNull = TRUE))
   newPlotObject <- legend$updatePlot(newPlotObject)
   return(newPlotObject)
 }
@@ -426,7 +426,7 @@ CaptionProperties <- enum(c(
 #' @keywords internal
 createPlotLegendPosition <- function(position) {
   validateIsIncluded(position, LegendPositions)
-
+  
   listOfLegendPositions <- list(
     none = list(xPosition = "none", xJustification = NULL, yPosition = NULL, yJustification = NULL),
     insideTop = list(xPosition = 0.5, xJustification = 0.5, yPosition = 0.975, yJustification = 1),

R/utilities-theme.R

@@ -29,7 +29,7 @@ loadThemeFromJson <- function(jsonFile) {
         eval(propertyExpression)
       }
       inputs <- names(themeContent[[themeProperty]][[propertyField]])
-      if (isOfLength(inputs, 0)) {
+      if (isEmpty(inputs)) {
         next
       }
       # Expressions overwriting the properties:
@@ -43,6 +43,7 @@ loadThemeFromJson <- function(jsonFile) {
     # Some specific cases are missing from the expressions
     background$watermark <- themeContent$background$watermark
     background$legendPosition <- themeContent$background$legendPosition
+    background$legendTitle <- themeContent$background$legendTitle
   }
 
   return(Theme$new(
@@ -64,7 +65,7 @@ saveThemeToJson <- function(jsonFile, theme = NULL) {
   validateIsOfType(theme, "Theme", nullAllowed = TRUE)
   validateIsString(jsonFile)
 
-  if (isOfLength(theme, 0)) {
+  if (isEmpty(theme)) {
     theme <- tlfEnv$currentTheme
   }
   theme$save(jsonFile)