Nothing
### XKCD styled plots
#require(xkcd)
#vignette("xkcd-intro")
### Histogram with dots
# http://stackoverflow.com/questions/16216312/how-to-plot-stacked-point-histograms-in-ggplot2-in-r
### Note: this is necessary to prevent Rcmd CHECK from throwing a note;
### otherwise it think these variables weren't defined yet.
# utils::globalVariables(c("y_density", "yMaxFromY"));
### Theme used for the plots
#' @rdname dlvPlot
#' @export dlvTheme
dlvTheme <- function(base_size = 11,
base_family = "",
...) {
ggplot2::"%+replace%"(ggplot2::theme_bw(base_size = base_size, base_family = base_family),
ggplot2::theme(# axis.title = element_blank(),
# axis.text = element_text(colour="#000000", size = rel(0.8)),
# axis.ticks = element_line(colour = "black"),
# axis.title = element_blank(),
# legend.text = element_text(size = rel(0.6)),
# legend.key = element_rect(colour = "grey80"),
# legend.position = "top",
# legend.direction = "horizontal",
# legend.key.size = unit(6, "mm"),
# panel.background = element_rect(fill = "white", colour = NA),
# panel.border = element_rect(fill = NA, colour = "grey50"),
# panel.grid.major = element_line(colour = "grey90", size = 0.2),
# panel.grid.minor = element_line(colour = "grey98", size = 0.5),
# panel.margin = unit(c(.5), "cm"),
...))
}
#' dlvPlot
#'
#' The dlvPlot function produces a dot-violin-line plot, and dlvTheme is the
#' default theme.
#'
#' This function creates Dot Violin Line plots. One image says more than a
#' thousand words; I suggest you run the example :-)
#'
#' @aliases dlvPlot dlvTheme
#' @param dat The dataframe containing x, y and z.
#' @param x Character value with the name of the predictor ('independent')
#' variable, must refer to a categorical variable (i.e. a factor).
#' @param y Character value with the name of the critetion ('dependent')
#' variable, must refer to a continuous variable (i.e. a numeric vector).
#' @param z Character value with the name of the moderator variable, must refer
#' to a categorical variable (i.e. a factor).
#' @param conf.level Confidence of confidence intervals.
#' @param jitter Logical value (i.e. TRUE or FALSE) whether or not to jitter
#' individual datapoints. Note that jitter cannot be combined with posDodge
#' (see below).
#' @param binnedDots Logical value indicating whether to use binning to display
#' the dots. Overrides jitter and dotsize.
#' @param binwidth Numeric value indicating how broadly to bin (larger values
#' is more binning, i.e. combining more dots into one big dot).
#' @param error Character value: "none", "lines" or "whiskers"; indicates
#' whether to show the confidence interval as lines with (whiskers) or without
#' (lines) horizontal whiskers or not at all (none)
#' @param dotsize Character value: "density" or "normal"; when "density", the
#' size of each dot corresponds to the density of the distribution at that
#' point.
#' @param singleColor The color to use when drawing one or more univariate
#' distributions (i.e. when no \code{z} is specified.
#' @param comparisonColors The colors to use when a \code{z} is specified. This
#' should be at least as many colors as \code{z} has levels. By default,
#' palette \code{Set1} from `RColorBrewer` is used.
#' @param densityDotBaseSize Numeric value indicating base size of dots when
#' their size corresponds to the density (bigger = larger dots).
#' @param normalDotBaseSize Numeric value indicating base size of dots when
#' their size is fixed (bigger = larger dots).
#' @param violinAlpha Numeric value indicating alpha value of violin layer (0 =
#' completely transparent, 1 = completely opaque).
#' @param dotAlpha Numeric value indicating alpha value of dot layer (0 =
#' completely transparent, 1 = completely opaque).
#' @param lineAlpha Numeric value indicating alpha value of the confidence
#' interval line layer (0 = completely transparent, 1 = completely opaque).
#' @param connectingLineAlpha Numeric value indicating alpha value of the layer
#' with the lines connecting the means (0 = completely transparent, 1 =
#' completely opaque).
#' @param meanDotSize Numeric value indicating the size of the dot used to
#' indicate the mean in the line layer.
#' @param posDodge Numeric value indicating the distance to dodge positions (0
#' for complete overlap).
#' @param errorType If the error is shown using lines, this argument indicates
#' Whether the errorbars should show the confidence interval
#' (\code{errorType='ci'}), the standard errors (\code{errorType='se'}), or
#' both (\code{errorType='both'}). In this last case, the standard error will
#' be wider than the confidence interval.
#' @param outputFile A file to which to save the plot.
#' @param outputWidth,outputHeight Width and height of saved plot (specified in
#' centimeters by default, see \code{ggsaveParams}).
#' @param ggsaveParams Parameters to pass to ggsave when saving the plot.
#' @param base_size,base_family,... Passed on to the ggplot theme_grey()
#' function.
#' @return The behavior of this function depends on the arguments.
#'
#' If no x and z are provided and y is a character value, dlvPlot produces a
#' univariate plot for the numerical y variable.
#'
#' If no x and z are provided, and y is c character vector, dlvPlot produces
#' multiple Univariate plots, with variable names determining categories on
#' x-axis and with numerical y variables on y-axis
#'
#' If both x and y are a character value, and no z is provided, dlvPlot
#' produces a bivariate plot where factor x determines categories on x-axis
#' with numerical variable y on the y-axis (roughly a line plot with a single
#' line)
#'
#' Finally, if x, y and z are each a character value, dlvPlot produces
#' multivariate plot where factor x determines categories on x-axis, factor z
#' determines the different lines, and with the numerical y variable on the
#' y-axis
#'
#' An object is returned with the following elements: \item{dat.raw}{Raw
#' datafile provided when calling dlvPlot} \item{dat}{Transformed (long)
#' datafile dlvPlot uses} \item{descr}{Dataframe with extracted descriptives
#' used to plot the mean and confidence intervals} \item{yRange}{The range of
#' the Y variable used to construct the plot} \item{plot}{The plot itself}
#' @keywords utilities
#' @rdname dlvPlot
#' @examples
#'
#' ### Note: the 'not run' is simply because running takes a lot of time,
#' ### but these examples are all safe to run!
#' \dontrun{
#' ### Create simple dataset
#' dat <- data.frame(x1 = factor(rep(c(0,1), 20)),
#' x2 = factor(c(rep(0, 20), rep(1, 20))),
#' y=rep(c(4,5), 20) + rnorm(40));
#' ### Generate a simple dlvPlot of y
#' dlvPlot(dat, y='y');
#' ### Now add a predictor
#' dlvPlot(dat, x='x1', y='y');
#' ### And finally also a moderator:
#' dlvPlot(dat, x='x1', y='y', z='x2');
#' ### The number of datapoints might be a bit clearer if we jitter
#' dlvPlot(dat, x='x1', y='y', z='x2', jitter=TRUE);
#' ### Although just dodging the density-sized dots might work better
#' dlvPlot(dat, x='x1', y='y', z='x2', posDodge=.3);
#' }
#'
#' @export dlvPlot
dlvPlot <- function(dat,
x = NULL,
y,
z = NULL,
conf.level = .95,
jitter = "FALSE",
binnedDots = TRUE,
binwidth = NULL,
error = "lines",
dotsize = "density",
singleColor = "black",
comparisonColors = rosetta::opts$get('dlvPlotCompCols'),
densityDotBaseSize = 3,
normalDotBaseSize = 1,
violinAlpha = .2,
dotAlpha = .4,
lineAlpha = 1,
connectingLineAlpha = 1,
meanDotSize = 5,
posDodge = 0.2,
errorType = "both",
outputFile = NULL,
outputWidth = 10,
outputHeight = 10,
ggsaveParams = list(units = 'cm',
dpi = 300,
type = "cairo")) {
### This function constructs a dot-line-violin plot.
### Create object to return results
res <- list()
### Store data
res$dat.raw <- dat
### Remove irrelevant variables
res$dat <- dat <- data.frame(dat[, c(x, y, z)])
### Remove incomplete cases
res$dat <- data.frame(dat[stats::complete.cases(dat),])
### Replace names again
names(dat) <- names(res$dat) <- c(x, y, z)
if (!is.null(x) & !(is.factor(dat[, x]))) {
warning(
"Error: variable x (', x,') is not of type factor. X must be a categorical ",
"variable with a limited number of categories. If this is the case, but it's ",
"simply stored as a numerical vector, use the 'factor' function to convert ",
"it (see '?factor'). Trying to convert x myself now."
)
res$dat[[x]] <- factor(res$dat[[x]])
}
if (!is.null(z) & !(is.factor(dat[, z]))) {
warning(
"Error: variable z (', z,') is not of type factor. Z must be a categorical ",
"variable with a limited number of categories. If this is the case, but it's ",
"simply stored as a numerical vector, use the 'factor' function to convert ",
"it (see '?factor'). Trying to convert z myself now."
)
res$dat[[z]] <- factor(res$dat[[z]])
}
if (is.null(x)) {
### We have no predictor variable - this means we construct univariate plots.
### Now check whether we have to construct one or several.
if (length(y) == 1) {
###############################################################
### Constructing one univariate plot ###
###############################################################
### Store variable name in dataframe
if (is.null(res$dat$variable)) {
res$dat$variable <- y
xVarName <- 'variable'
}
else {
res$dat$variable_dlvPlot <- y
xVarName <- 'variable_dlvPlot'
}
### Store density at y value
dens <- stats::density(res$dat[[y]], na.rm = TRUE)
res$dat$y_density <-
stats::approx(dens$x, dens$y, xout = res$dat[[y]])$y
### Multiply so that points at average density have size 1
res$dat$y_density <- res$dat$y_density *
(densityDotBaseSize / mean(res$dat$y_density, na.rm = TRUE))
### Construct dataframe with confidence interval info
n <- nrow(res$dat)
mean <- mean(res$dat[, y])
sd <- stats::sd(res$dat[, y])
se <- sd / sqrt(nrow(res$dat))
criticalValue <- stats::qt(1 - ((1 - conf.level) / 2), df = n - 1)
ci.lo <- mean - criticalValue * se
ci.hi <- mean + criticalValue * se
meanMinSE <- mean - se
meanPlusSE <- mean + se
res$descr <- data.frame(
y = y,
n = n,
mean = mean,
sd = sd,
se = se,
ci.lo = ci.lo,
ci.hi = ci.hi,
meanMinSE = meanMinSE,
meanPlusSE = meanPlusSE
)
res$yRange = c(min(res$dat[[y]][!is.na(res$dat[[y]])]),
max(res$dat[[y]][!is.na(res$dat[[y]])]))
### Generate plot
res$plot <- ggplot2::ggplot(data = res$dat,
ggplot2::aes_string(x = xVarName, y =
y))
res$plot <- res$plot +
dlvTheme()
res$plot <- res$plot +
ggplot2::geom_violin(
trim = FALSE,
alpha = violinAlpha,
fill = singleColor,
linetype = "blank"
)
if (jitter) {
res$plot <- res$plot +
ggplot2::geom_jitter(
position = ggplot2::position_jitter(width = .1, height = .01),
alpha = dotAlpha
)
}
else {
if (binnedDots) {
tempBinwidth <-
ifelse(is.null(binwidth),
(res$yRange[2] - res$yRange[1]) / 30,
binwidth)
res$plot <- res$plot +
ggplot2::geom_dotplot(
alpha = dotAlpha,
show.legend = FALSE,
binaxis = "y",
binwidth = tempBinwidth,
dotsize = normalDotBaseSize,
stackdir = "center",
color = singleColor,
fill = singleColor,
position = ggplot2::position_dodge(width =
posDodge)
)
}
else if (dotsize == "density") {
res$plot <- res$plot +
ggplot2::geom_point(
ggplot2::aes_string(size = 'y_density'),
color = singleColor,
alpha = dotAlpha,
show.legend = FALSE
)
}
else {
res$plot <- res$plot +
ggplot2::geom_point(alpha = dotAlpha, dotsize = normalDotBaseSize)
}
}
if (error == "lines") {
if (errorType == "ci") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'y',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
color = singleColor,
size = 1,
alpha = lineAlpha
)
} else if (errorType == "se") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'y',
y = 'mean',
ymin = 'meanMinSE',
ymax = 'meanPlusSE'
),
color = singleColor,
size = 1,
alpha = lineAlpha
)
} else if (errorType == "both") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'y',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
size = 1,
alpha = lineAlpha
)
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = 'y',
ymin = 'meanMinSE',
ymax = 'meanPlusSE'
),
color = singleColor,
size = 2,
alpha = lineAlpha,
width = 0,
inherit.aes = FALSE
)
}
}
else if (error == "whiskers") {
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = 'y',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
color = singleColor,
size = 1,
width = .1,
alpha = lineAlpha
)
}
res$plot <- res$plot +
ggplot2::geom_point(
data = res$descr,
color = singleColor,
ggplot2::aes_string(x = 'y', y = 'mean'),
size = meanDotSize,
alpha = lineAlpha
)
}
else {
###############################################################
### Constructing several univariate plots ###
###############################################################
### Apparently, we have to construct several plots.
### First generate a dataframe where the variables names
### are stored in another variable that we can use to
### make categories on the x axis
### Store original dataframe
res$dat.original <- res$dat
res$dat <- data.frame()
### Create empty descriptives dataframe
res$descr <- data.frame()
### Loop through original dataframe and construct new one
for (currentVar in y) {
tempDf <- data.frame(y = res$dat.original[, currentVar])
tempDf$x <- currentVar
### Store density for at y value
dens <- stats::density(tempDf$y, na.rm = TRUE)
tempDf$y_density <-
stats::approx(dens$x, dens$y, xout = tempDf$y)$y
tempDf$y_density <- tempDf$y_density *
(densityDotBaseSize / mean(tempDf$y_density, na.rm = TRUE))
### Store y values and name of y variable in res$dat dataframe
res$dat <- rbind(res$dat, tempDf)
### Get mean and confidence interval for descriptives table
n <- nrow(tempDf)
mean <- mean(tempDf$y)
sd <- stats::sd(tempDf$y)
se <- sd / sqrt(nrow(tempDf))
criticalValue <- stats::qt(1 - ((1 - conf.level) / 2), df = n -
1)
ci.lo <- mean - criticalValue * se
ci.hi <- mean + criticalValue * se
meanMinSE <- mean - se
meanPlusSE <- mean + se
### Add descriptives
res$descr <- rbind(
res$descr,
data.frame(
y = currentVar,
n = n,
mean = mean,
sd = sd,
se = se,
ci.lo = ci.lo,
ci.hi = ci.hi,
meanMinSE = meanMinSE,
meanPlusSE = meanPlusSE
)
)
}
res$yRange = c(min(res$dat[['y']][!is.na(res$dat[['y']])]),
max(res$dat[['y']][!is.na(res$dat[['y']])]))
res$plot <- ggplot2::ggplot(data = res$dat, ggplot2::aes(x = x, y = y))
res$plot <- res$plot + dlvTheme()
res$plot <- res$plot +
ggplot2::geom_violin(
trim = FALSE,
alpha = violinAlpha,
fill = singleColor,
linetype = "blank"
)
if (jitter) {
res$plot <- res$plot +
ggplot2::geom_jitter(
position = ggplot2::position_jitter(width = .1, height = .01),
color = singleColor,
alpha = dotAlpha
)
}
else {
if (binnedDots) {
tempBinwidth <-
ifelse(is.null(binwidth),
(res$yRange[2] - res$yRange[1]) / 30,
binwidth)
res$plot <- res$plot +
ggplot2::geom_dotplot(
alpha = dotAlpha,
show.legend = FALSE,
binaxis = "y",
binwidth = tempBinwidth,
dotsize = normalDotBaseSize,
color = singleColor,
fill = singleColor,
stackdir = "center",
position = ggplot2::position_dodge(width = posDodge)
)
}
else if (dotsize == "density") {
res$plot <- res$plot +
ggplot2::geom_point(
ggplot2::aes_string(size = 'y_density'),
color = singleColor,
alpha = dotAlpha,
show.legend = FALSE
)
}
else {
res$plot <- res$plot +
ggplot2::geom_point(alpha = dotAlpha,
color = singleColor,
dotsize = normalDotBaseSize)
}
}
if (error == "lines") {
if (errorType == "ci") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
color = singleColor,
size = 1,
alpha = lineAlpha
)
} else if (errorType == "se") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = y,
y = 'mean',
ymin = 'meanMinSE',
ymax = 'meanPlusSE'
),
color = singleColor,
size = 1,
alpha = lineAlpha
)
} else if (errorType == "both") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = y,
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
color = singleColor,
size = 1,
alpha = lineAlpha
)
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = y,
y = 'mean',
ymin = 'meanMinSE',
ymax = 'meanPlusSE'
),
color = singleColor,
size = 2,
alpha = lineAlpha,
width = 0
)
}
}
else if (error == "whiskers") {
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes(
x = y,
y = mean,
ymin = ci.lo,
ymax = ci.hi
),
color = singleColor,
size = 1,
width = .1,
alpha = lineAlpha
)
}
res$plot <- res$plot +
ggplot2::geom_point(
data = res$descr,
ggplot2::aes(x = y, y = mean),
color = singleColor,
size = meanDotSize,
alpha = lineAlpha
)
}
}
else {
### We have a predictor variable, so check whether we have a moderator
if (is.null(z)) {
###############################################################
### Constructing multivariate plot without moderator ###
###############################################################
### Construct dataframe with confidence interval info
res$descr <-
plyr::ddply(
.data = res$dat,
.variables = c(x),
.fun = function (dat, conf.level) {
dat <- dat[stats::complete.cases(dat),]
n <- nrow(dat)
mean <- mean(dat[, y])
sd <- stats::sd(dat[, y])
se <- sd / sqrt(nrow(dat))
criticalValue <-
stats::qt(1 - ((1 - conf.level) / 2), df = n - 1)
ci.lo <- mean - criticalValue * se
ci.hi <- mean + criticalValue * se
meanMinSE <- mean - se
meanPlusSE <- mean + se
rslt <- data.frame(
x = dat[1, x],
y = y,
n = nrow(dat),
mean = mean,
sd = sd,
se = se,
ci.lo = ci.lo,
ci.hi = ci.hi,
meanMinSE = meanMinSE,
meanPlusSE = meanPlusSE,
numericX = as.numeric(dat[1, x])
)
rslt <- rslt[stats::complete.cases(rslt),]
return(rslt)
},
conf.level = conf.level
)
### Store densities; must be done for each group (value of x)
### separately
res$dat <- plyr::ddply(
.data = res$dat,
.variables = c(x),
.fun = function (dat) {
### Store density for at y value
dens <-
stats::density(dat[[y]], na.rm = TRUE)
dat$y_density <-
stats::approx(dens$x, dens$y, xout = dat[[y]])$y
### Multiply with densityDotBaseSize / mean (this allows
### control over the size of the dots)
dat$y_density <- dat$y_density *
(densityDotBaseSize / mean(dat$y_density, na.rm =
TRUE))
return(dat)
}
)
res$yRange = c(min(res$dat[[y]][!is.na(res$dat[[y]])]),
max(res$dat[[y]][!is.na(res$dat[[y]])]))
res$plot <- ggplot2::ggplot(data = res$dat,
ggplot2::aes_string(x = x, y = y))
res$plot <- res$plot + dlvTheme()
res$plot <- res$plot +
ggplot2::geom_violin(
trim = FALSE,
alpha = violinAlpha,
fill = singleColor,
linetype = "blank",
position = ggplot2::position_dodge(width =
posDodge)
)
if (jitter) {
res$plot <- res$plot +
ggplot2::geom_jitter(
position = ggplot2::position_jitter(width = .1, height = .01),
color = singleColor,
alpha = dotAlpha
)
}
else {
if (binnedDots) {
tempBinwidth <-
ifelse(is.null(binwidth),
(res$yRange[2] - res$yRange[1]) / 30,
binwidth)
res$plot <- res$plot +
ggplot2::geom_dotplot(
alpha = dotAlpha,
show.legend = FALSE,
binaxis = "y",
binwidth = tempBinwidth,
dotsize = normalDotBaseSize,
color = singleColor,
fill = singleColor,
stackdir = "center",
position = ggplot2::position_dodge(width =
posDodge)
)
}
else if (dotsize == "density") {
res$plot <- res$plot +
ggplot2::geom_point(
ggplot2::aes_string(size = 'y_density'),
color = singleColor,
alpha = dotAlpha,
show.legend = FALSE
)
}
else {
res$plot <- res$plot +
ggplot2::geom_point(alpha = dotAlpha,
color = singleColor,
dotsize = normalDotBaseSize)
}
}
if (error == "lines") {
if (errorType == "ci") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
size = 1,
alpha = lineAlpha,
color = singleColor,
inherit.aes = FALSE
)
} else if (errorType == "se") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'meanMinSE',
ymax = 'meanPlusSE'
),
size = 1,
alpha = lineAlpha,
color = singleColor,
inherit.aes = FALSE
)
} else if (errorType == "both") {
res$plot <- res$plot +
ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
size = 1,
alpha = lineAlpha,
color = singleColor,
inherit.aes = FALSE
)
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(x = 'x',
ymin =
'meanMinSE',
ymax = 'meanPlusSE'),
size = 2,
alpha = lineAlpha,
width = 0,
color = singleColor,
inherit.aes = FALSE
)
}
}
else if (error == "whiskers") {
res$plot <- res$plot +
ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi'
),
size = 1,
width = .1,
alpha = lineAlpha,
color = singleColor,
inherit.aes = FALSE
)
}
res$plot <- res$plot + ggplot2::stat_summary(
fun = mean,
geom = "point",
size = meanDotSize,
color = singleColor,
alpha = lineAlpha
)
res$plot <- res$plot + ggplot2::geom_line(
data = res$descr,
ggplot2::aes_string(x = 'x', y = 'mean', group =
NA),
color = singleColor,
size = 1,
alpha = connectingLineAlpha
)
}
else {
###############################################################
### Constructing multivariate plot with moderator ###
###############################################################
### Construct dataframe with confidence interval info
res$descr <- plyr::ddply(
.data = res$dat,
.variables = c(x, z),
.fun = function (dat, conf.level) {
dat <- dat[stats::complete.cases(dat),]
n <- nrow(dat)
mean <- mean(dat[, y])
sd <- stats::sd(dat[, y])
se <- sd / sqrt(nrow(dat))
criticalValue <-
stats::qt(1 - ((1 - conf.level) / 2), df = n - 1)
ci.lo <- mean - criticalValue * se
ci.hi <- mean + criticalValue * se
meanMinSE <- mean - se
meanPlusSE <- mean + se
res <- data.frame(
x = dat[1, x],
y = y,
z = dat[1, z],
n = nrow(dat),
mean = mean,
sd = sd,
se = se,
ci.lo = ci.lo,
ci.hi = ci.hi,
meanMinSE = meanMinSE,
meanPlusSE = meanPlusSE,
numericX = as.numeric(dat[1, x])
)
return(res[stats::complete.cases(res),])
},
conf.level = conf.level
)
### Store densities; must be done for each group (value of x)
### separately
res$dat <- plyr::ddply(
.data = res$dat,
.variables = c(x, z),
.fun = function (dat) {
### Store density for at y value
dens <- stats::density(dat[[y]], na.rm = TRUE)
dat$y_density <-
stats::approx(dens$x, dens$y, xout = dat[[y]])$y
### Multiply with densityDotBaseSize / mean (this allows
### control over the size of the dots)
dat$y_density <- dat$y_density *
(densityDotBaseSize / mean(dat$y_density, na.rm =
TRUE))
return(dat)
}
)
res$yRange = c(min(res$dat[[y]][!is.na(res$dat[[y]])]),
max(res$dat[[y]][!is.na(res$dat[[y]])]))
res$plot <-
ggplot2::ggplot(data = res$dat,
ggplot2::aes_string(
x = x,
y = y,
z = z,
colour = z,
fill = z,
group = paste0(x, ":", z)
))
res$plot <- res$plot + dlvTheme()
res$plot <-
res$plot + ggplot2::geom_violin(
data = res$dat,
ggplot2::aes_string(fill = z),
alpha = violinAlpha,
trim = FALSE,
linetype = "blank",
position = ggplot2::position_dodge(width =
posDodge)
)
if (jitter) {
res$plot <-
res$plot + ggplot2::geom_jitter(position = ggplot2::position_jitter(width = .1, height =
.01),
alpha = dotAlpha)
}
else {
if (binnedDots) {
tempBinwidth <- ifelse(is.null(binwidth),
(res$yRange[2] - res$yRange[1]) / 30,
binwidth)
res$plot <-
res$plot + ggplot2::geom_dotplot(
alpha = dotAlpha,
show.legend = FALSE,
ggplot2::aes_string(fill = z),
binaxis = "y",
binwidth = tempBinwidth,
dotsize = normalDotBaseSize,
stackdir = "center",
position = ggplot2::position_dodge(width =
posDodge)
)
}
else if (dotsize == "density") {
res$plot <- res$plot + ggplot2::geom_point(
ggplot2::aes_string(size = 'y_density'),
alpha = dotAlpha,
show.legend = FALSE,
position = ggplot2::position_dodge(width =
posDodge)
)
}
else {
res$plot <-
res$plot + ggplot2::geom_point(
alpha = dotAlpha,
dotsize = normalDotBaseSize,
position = ggplot2::position_dodge(width =
posDodge)
)
}
}
if (error == "lines") {
if (errorType == "ci") {
res$plot <- res$plot + ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi',
group = 'z',
color = 'z'
),
size = 1,
alpha = lineAlpha,
position = ggplot2::position_dodge(width = posDodge),
inherit.aes = FALSE
)
} else if (errorType == "se") {
res$plot <- res$plot + ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'meanMinSE',
ymax = 'meanPlusSE',
group = 'z',
color = 'z'
),
size = 1,
alpha = lineAlpha,
position = ggplot2::position_dodge(width =
posDodge),
inherit.aes = FALSE
)
} else if (errorType == "both") {
res$plot <- res$plot + ggplot2::geom_pointrange(
data = res$descr,
ggplot2::aes_string(
x = 'x',
y = 'mean',
ymin = 'ci.lo',
ymax = 'ci.hi',
group = 'z',
color = 'z'
),
size = 1,
alpha = lineAlpha,
position = ggplot2::position_dodge(width =
posDodge),
inherit.aes = FALSE
)
res$plot <- res$plot + ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = 'x',
ymin = 'meanMinSE',
ymax = 'meanPlusSE',
group = 'z',
color = 'z'
),
size = 2,
alpha = lineAlpha,
width = 0,
position = ggplot2::position_dodge(width =
posDodge),
inherit.aes = FALSE
)
}
}
else if (error == "whiskers") {
res$plot <- res$plot + ggplot2::geom_errorbar(
data = res$descr,
ggplot2::aes_string(
x = 'x',
ymin = 'ci.lo',
ymax = 'ci.hi',
group = 'z',
color = 'z'
),
size = 1,
width = .1,
alpha = lineAlpha,
position = ggplot2::position_dodge(width =
posDodge),
inherit.aes = FALSE
)
}
res$plot <-
res$plot + ggplot2::stat_summary(
fun = mean,
geom = "point",
size = meanDotSize,
position = ggplot2::position_dodge(width = posDodge)
)
res$plot <-
res$plot + ggplot2::geom_line(
data = res$descr,
ggplot2::aes_string(x = 'x', y = 'mean', group = 'z'),
size = 1,
alpha = connectingLineAlpha,
position = ggplot2::position_dodge(width = posDodge)
)
### Add fill and color scales
res$plot <-
res$plot + ggplot2::scale_fill_manual(values = comparisonColors,
name = z,
labels = sort(unique(res$descr$z))) +
ggplot2::scale_color_manual(values = comparisonColors,
name = z,
labels = sort(unique(res$descr$z)))
}
}
assign('yMaxFromY', max(res$plot$data[, res$plot$labels$y]), envir = res$plot$plot_env)
res$plot <- res$plot + ggplot2::aes_string(ymax = 'yMaxFromY')
### Set class of result
class(res) <- c('dlvPlot')
### Save to a file, if desired
if (!is.null(outputFile)) {
ggsaveParameters <- c(
list(
filename = outputFile,
plot = res$plot,
width = outputWidth,
height = outputHeight
),
ggsaveParams
)
do.call(ggplot2::ggsave, ggsaveParameters)
}
### Return result
return(res)
}
#' @rdname dlvPlot
#' @method print dlvPlot
#' @export
print.dlvPlot <- function(x, ...) {
print(x$plot, ...)
invisible()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.