#' Plot an FemFit object.
#'
#' @description
#' A plot method for "FemFit" objects.
#'
#' @param x An "FemFit" object.
#' @param formula Specifies the response variable and up to two facetting variables. Must not be a variable used in the \code{colorCode} argument.
#' @param colorCode A variable color the pressure traces of the response. Must not be a variable used in the \code{formula} argument.
#' @param subset A conditional expression to subset \code{x$df}.
#' @param timeScale A numeric constant used to divide \code{x$df$time}.
#' @param xlab Label the x-axis.
#' @param ylab Label the y-axis. Defaults to the name of the response variable specified in \code{formula}.
#' @param main Label the title.
#' @param printPlot A logical constant to set whether \code{plot.FemFit} prints the plot. Defaults to \code{TRUE}.
#' @param ... Other arguments not used by this method.
#'
#' @details
#' The \code{formula} has up to three components, \code{y ~ facet_1 + facet_2}. \code{y} is a variable found in \code{x$df} and has special exceptions to grab all sensors when \code{y = prssr_sensor}, \code{y = zeroPrssr}, or \code{y = tmprtr_sensor}.
#'
#' If you do not want to facet, use \code{.} in the RHS of the formula.
#'
#' There is a special keyword, \code{sensor}, which allows the user to facet the pressure traces by sensor number or color the pressure traces by sensor number.
#'
#' \code{xlab} defaults to "Time (s)" if \code{timeScale = 1000} and \code{xlab = "Time (ms)"}.
#'
#' \code{timeScale}, \code{xlab}, \code{ylab}, \code{main}, and \code{printPlot} only uses the first element if there is a vector input.
#'
#' @return
#' \code{plot.FemFit} silently returns a \code{ggplot2} object which can then be edited.
#'
#' @examples
#' # Load in the FemFit dataset
#' session488 = read.FemFit("./Datasets_AukRepeat/2c2cc798481d05da_488_csv.zip")
#'
#' # Plot the FemFit dataset with the default arguments
#' plot(session488)
#'
#' # The absence of the `sensor` keyword in the formula argument simultaneously plots all pressure traces with an opacity value fo 25%
#' plot(session488, formula = prssr_sensor ~ sessionID)
#'
#' # Utilising the `sensor` keyword in the colorCode argument plots all pressure traces with a unique color.
#' plot(session488, formula = prssr_sensor ~ sessionID, colorCode = sensor)
#'
#' # Use subset to plot a portion of the FemFit dataset
#' plot(session488, subset = JSONLabel == "pfmc3x5s_rest30s")
#'
#' # xlab, ylab, and title must be character inputs. So, here is the current work-around to use mathematical symbols for those fields
#' plotObj = plot(session488, formula = zeroPrssr ~ sensor + sessionID, printPlot = FALSE)
#' plotObj = plotObj + labs(y = expression("Zeroed Pressure ("*Delta*"mmHg)"))
#' print(plotObj)
#'
#' @export plot.FemFit
plot.FemFit = function(x, formula = prssr_sensor ~ sensor + sessionID, colorCode = NULL, subset = NULL, timeScale = 1, xlab = "Time (ms)", ylab = NULL, main = NULL, printPlot = TRUE, ...) {
# Define a vector containing variable names for partial matching to plot all eight sensors
partialMatchVector = c("prssr_sensor", "zeroPrssr", "tmprtr_sensor")
# Throw an error if the x argument is not an FemFit object or missing
if (!inherits(x, "FemFit") || is.na(x)) {
stop("The x argument is not an FemFit object.", call. = FALSE)
}
# Throw an error if the FemFit object does not have a `df` element
if (!exists("df", x)) {
stop("The provided FemFit object does not have a `df` element.", call. = FALSE)
}
# Throw an error if formula is not a formula or it has any NAs
if (class(formula) != "formula") {
stop("The provided formula value is not a formula.", call. = FALSE)
}
# Extract the components found in formula into parts
parts = formula %>% all.vars()
# Throw an error if parts has three or more components
if (length(parts) >= 4) {
stop("The provided formula value has four or more components.")
}
# Throw an error if some of the specified variables in parts does not exist in the `df` element
parts.Check = sapply(parts %>% .[!grepl("(\\.|sensor)", .)], function (parts_Child) {
x$df %>%
colnames %>%
grepl(if_else(parts_Child %in% partialMatchVector, parts_Child, paste0("^", parts_Child, "$")), .) %>%
any
})
if (parts.Check %>% all %>% !.) {
stop("The `df` element does not contain some of the specified variables in formula.", call. = FALSE)
}
# Throw an error if the variable specified for colorCode does not exist in the `df` element
colorCode.String = as.character(substitute(colorCode))
if (!is.null(substitute(colorCode))) {
if (!{x$df %>% colnames %>% grepl(paste0("^", colorCode.String, "$"), .) %>% any} & colorCode.String != "sensor") {
stop("The `df` element does not contain the specified colorCode variable.", call. = FALSE)
}
}
# Throw an error if timeScale is not a numeric or it has any NAs
if (!is.numeric(timeScale[1]) || is.na(timeScale[1])) {
stop("The provided timeScale value is not a numeric.", call. = FALSE)
}
# Throw an error if xlab is not a numeric or it has any NAs
if (!is.character(xlab[1]) || is.na(xlab[1])) {
stop("The provided xlab value is not a character.", call. = FALSE)
}
# Automatically update xlab to seconds if timeScale = 1000 and xlab is set to it's default argument
if (timeScale == 1000 && xlab[1] == "Time (ms)") {
xlab[1] = "Time (s)"
}
# Assign a string to ylab if it is set to NULL
if (is.null(ylab[1])) {
ylab[1] = parts[1]
}
# Throw an error if ylab is not a numeric or it has any NAs
if (!is.character(ylab[1]) || is.na(ylab[1])) {
stop("The provided ylab value is not a character.", call. = FALSE)
}
# Throw an error if main is not NULL and is not a character
if (!is.character(main[1]) && !is.null(main[1])) {
stop("The provided main value is not a character.", call. = FALSE)
}
# Throw an error if printPlot is not a numeric or it has any NAs
if (!is.logical(printPlot[1]) || is.na(printPlot[1])) {
stop("The provided printPlot value is not a logical.", call. = FALSE)
}
# Typecast parts into individual variables
parts.1 = parts[1]; parts.2 = dplyr::if_else(is.na(parts[2]), " ", parts[2]); parts.3 = dplyr::if_else(is.na(parts[3]), " ", parts[3])
# Throw an error if any of the parts are used in the colorCode argument
if (!is.null(substitute(colorCode)) && (parts.2 == colorCode.String || parts.3 == colorCode.String)) {
stop("The provided colorCode value specifies a component of the provided formula value.", call. = FALSE)
}
# Filter the data.frame object
subset_quo = dplyr::enquo(subset)
if (length(all.vars(subset_quo)) != 0) {
x$df = filter(x$df, !!subset_quo)
}
# Throw a warning if there is two or more sessionIDs in x$df and it was not specified in the formula
if (x$df$sessionID %>% unique %>% length >= 2 && all(parts.2 != "sessionID", parts.3 != "sessionID", colorCode.String != "sessionID")) {
warning("The provided FemFit object has two or more sessions. Use sessionID in either the formula or colorCode arguments.", call. = FALSE)
}
# Setup the logicals which will control the construction of the eval + parse strings
partialMatch.Switch = parts.1 %in% partialMatchVector
parts.2.Switch = !grepl("(\\.|sensor|[[:space:]])", parts.2)
parts.3.Switch = !grepl("(\\.|sensor|[[:space:]])", parts.3)
colorCode.Switch = !is.null(substitute(colorCode)) && colorCode.String != "sensor"
colorCode.sensor.Switch = ifelse(length(colorCode.String) != 0, colorCode.String == "sensor", FALSE)
overPlot.Switch = dplyr::if_else(partialMatch.Switch, !any(parts.2 == "sensor" || parts.3 == "sensor"), FALSE)
if (colorCode.Switch || colorCode.sensor.Switch) {
# ifelse rather than if_else to prevent if_else's safe evaluation when colorCode.String = "sensor"
colorCode.n = ifelse(colorCode.sensor.Switch, as.integer(8), x$df %>% dplyr::select(colorCode.String) %>% dplyr::pull(colorCode.String) %>% unique %>% length)
}
# Wrangle together a data.frame which has our plotable elements
selectString =
paste0("dplyr::select(",
dplyr::if_else(partialMatch.Switch, "dplyr::contains(parts.1),", "parts.1,"),
dplyr::if_else(parts.2.Switch, "parts.2,", ""),
dplyr::if_else(parts.3.Switch, "parts.3,", ""),
dplyr::if_else(colorCode.Switch, "color = colorCode.String,", ""),
"time)")
gatherString =
paste0("tidyr::gather(sensor, prssr,",
dplyr::if_else(parts.2.Switch, "-parts.2,", ""),
dplyr::if_else(parts.3.Switch, "-parts.3,", ""),
dplyr::if_else(colorCode.Switch, "-color,", ""),
"-time)")
# Note that we're using eval + parse here to effectively reduce the number of if/else statements
work.df = eval(
parse(
text =
paste0(
"x$df %>%",
selectString,
"%>%",
gatherString,
"%>%",
"dplyr::mutate(time = time/timeScale",
dplyr::if_else(colorCode.Switch, ", color = dplyr::if_else(is.na(color), \"NA\", as.character(color))", ""),
", sensor = gsub(paste0(\"(\", paste0(partialMatchVector, collapse = \"|\"), \")([0-9])\"), \"Sensor \\\\2\", sensor)",
")"
)
)
)
# Create a variable to allow line breaks if colorCode is not set to NULL
if (colorCode.Switch) {
work.df$lineBreaks = c(TRUE, work.df$color[2:nrow(work.df)] == work.df$color[1:(nrow(work.df)-1)]) %>%
{c(1, which(. != 1), nrow(work.df)+1)} %>%
{rep(1:length(diff(.)), diff(.))}
}
# Create the ggplot2 object
toReturn = eval(
parse(
text = paste0(
"ggplot2::ggplot(data = work.df, aes(x = time, y = prssr,",
dplyr::if_else(colorCode.Switch, "color = color, group = interaction(lineBreaks, sensor)", "group = sensor"),
dplyr::if_else(colorCode.sensor.Switch, ", color = sensor", ""),
")) +",
"ggplot2::theme_bw() +",
"ggplot2::labs(x = xlab, y = ylab, title = main) +",
"ggplot2::geom_line(",
dplyr::if_else(overPlot.Switch, dplyr::if_else(colorCode.sensor.Switch, "", "alpha = 0.25"), ""),
")",
dplyr::if_else(
parts.3 != " ",
paste0("+ ggplot2::facet_grid(", parts.2, "~", parts.3, ")"),
dplyr::if_else(
parts.2 != ".",
paste0("+ ggplot2::facet_wrap(", "~", parts.2, ")"),
""
)
),
ifelse(
colorCode.Switch || colorCode.sensor.Switch,
paste0(
dplyr::if_else(colorCode.n <= 8,
"+ ggplot2::scale_color_brewer(type = \"qual\", palette = \"Dark2\", name = \"",
"+ ggplot2::scale_color_discrete(name = \""),
colorCode.String,
"\") + guides(colour = guide_legend(override.aes = list(alpha = 1)))"),
"")
)
)
)
# If printPlot is set to TRUE, print the ggplot2 object
if (printPlot[1]) {
print(toReturn)
}
# Return the ggplot2 object
invisible(toReturn)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.