From 860a6a8ce3ff159b9fb15f10918a2c2037f6401c Mon Sep 17 00:00:00 2001 From: Unknown Date: Fri, 23 Apr 2021 06:28:14 -0400 Subject: [PATCH] Fixes #141 enforce factors for legend and discrete scales of dataMapping --- R/boxwhisker-datamapping.R | 10 ++++++++-- R/datamapping-xygroup.R | 25 +++++++++++++++---------- R/tornado-datamapping.R | 14 ++++++++++++++ man/TornadoDataMapping.Rd | 25 ++++++++++++++++++++++++- 4 files changed, 61 insertions(+), 13 deletions(-) diff --git a/R/boxwhisker-datamapping.R b/R/boxwhisker-datamapping.R index e2928f8a..101a49d7 100644 --- a/R/boxwhisker-datamapping.R +++ b/R/boxwhisker-datamapping.R @@ -57,7 +57,7 @@ BoxWhiskerDataMapping <- R6::R6Class( if (isOfLength(self$x, 0)) { data$legendLabels <- factor("") } - + # Transform names into functions for aggregation summary boxWhiskerLimitsFunctions <- sapply(self$boxWhiskerLimits, match.fun) @@ -75,6 +75,9 @@ BoxWhiskerDataMapping <- R6::R6Class( # Dummy variable for aesthetics boxWhiskerLimits$legendLabels <- factor("") + if(!isOfLength(self$x, 0)){ + boxWhiskerLimits[,self$x] <- as.factor(boxWhiskerLimits[,self$x]) + } return(boxWhiskerLimits) }, @@ -89,7 +92,7 @@ BoxWhiskerDataMapping <- R6::R6Class( if (isOfLength(self$x, 0)) { data$legendLabels <- factor("") } - + # Transform names into functions for aggregation summary outlierLimitsFunctions <- sapply(self$outlierLimits, match.fun) @@ -120,6 +123,9 @@ BoxWhiskerDataMapping <- R6::R6Class( # Dummy variable for aesthetics outliers$legendLabels <- factor("") + if(!isOfLength(self$x, 0)){ + outliers[,self$x] <- as.factor(outliers[,self$x]) + } return(outliers) } diff --git a/R/datamapping-xygroup.R b/R/datamapping-xygroup.R index b3a59c30..c48ad17d 100644 --- a/R/datamapping-xygroup.R +++ b/R/datamapping-xygroup.R @@ -65,7 +65,7 @@ XYGDataMapping <- R6::R6Class( # All possible Groupings are listed in the enum LegendTypes for (groupType in LegendTypes) { - if (!is.null(self$groupMapping[[groupType]]$group)) { + if (isOfLength(self$groupMapping[[groupType]]$group, 0)) {next} grouping <- self$groupMapping[[groupType]] groupVariables <- grouping$group @@ -76,15 +76,20 @@ XYGDataMapping <- R6::R6Class( groupVariables <- utils::head(groupVariables, -1) } validateMapping(groupVariables, data) - self$data[, grouping$label] <- grouping$getCaptions(data, metaData) - # Dummy variable for default aesthetics - # Will be used to define legend labels - self$data$legendLabels <- ifnotnull( - self$data$legendLabels, - paste(self$data$legendLabels, grouping$getCaptions(data, metaData), sep = "-"), - grouping$getCaptions(data, metaData) - ) - } + # Enforce grouping variables to be factors + self$data[, grouping$label] <- as.factor(grouping$getCaptions(data, metaData)) + + # Dummy variable for default aesthetics that will be used to define legend labels + legendLabels <- self$data$legendLabels %||% grouping$getCaptions(data, metaData) + + # Prevent duplication of legend if groupings are the same + if(all(as.character(legendLabels) == as.character(grouping$getCaptions(data, metaData)))){ + self$data$legendLabels <- legendLabels + next + } + self$data$legendLabels <- as.factor(paste(as.character(self$data$legendLabels), + as.character(grouping$getCaptions(data, metaData)), + sep = "-")) } if (is.null(self$data$legendLabels)) { diff --git a/R/tornado-datamapping.R b/R/tornado-datamapping.R index c92cff9d..c53c34fe 100644 --- a/R/tornado-datamapping.R +++ b/R/tornado-datamapping.R @@ -46,6 +46,20 @@ TornadoDataMapping <- R6::R6Class( self$lines <- lines self$sorted <- sorted %||% TRUE + }, + + #' @description Check that \code{data} variables include map variables + #' @param data data.frame to check + #' @param metaData list containing information on \code{data} + #' @return A data.frame with map and \code{defaultAes} variables. + #' Dummy variable \code{defaultAes} is necessary to allow further modification of plots. + checkMapData = function(data, metaData = NULL) { + mapData <- super$checkMapData(data, metaData) + # Enforce y to be a discrete variable preventing crashes from numerical values + if(!isOfLength(self$y, 0)){ + mapData[,self$y] <- as.factor(mapData[,self$y]) + } + return(mapData) } ) ) diff --git a/man/TornadoDataMapping.Rd b/man/TornadoDataMapping.Rd index 620de26d..6c2a6b02 100644 --- a/man/TornadoDataMapping.Rd +++ b/man/TornadoDataMapping.Rd @@ -22,13 +22,13 @@ R6 class for mapping \code{values}, \code{labels} to \code{data} \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{TornadoDataMapping$new()}} +\item \href{#method-checkMapData}{\code{TornadoDataMapping$checkMapData()}} \item \href{#method-clone}{\code{TornadoDataMapping$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/XYGDataMapping.html#method-checkMapData}{\code{tlf::XYGDataMapping$checkMapData()}}\out{} } \out{
} } @@ -67,6 +67,29 @@ A new \code{TornadoDataMapping} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-checkMapData}{}}} +\subsection{Method \code{checkMapData()}}{ +Check that \code{data} variables include map variables +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TornadoDataMapping$checkMapData(data, metaData = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} + +\item{\code{metaData}}{list containing information on \code{data}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame with map and \code{defaultAes} variables. +Dummy variable \code{defaultAes} is necessary to allow further modification of plots. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{