Nothing
barPlot = function(data, x = NULL, y, group = NULL,
semFlag = TRUE,
xFlag = FALSE,
bar.width = 0.5, dodge.width = 0.8,
jitter = FALSE, jitter.alpha = 0.7, jitter.width = 0.1,
line = NULL, line.color = 'black',
xlab = x, ylab = line, theme_classic = TRUE,
group.lab = group, title = "bar plots",
xLevel = NULL, addThemeFlag = TRUE, ...) {
# main function of error bar
# x: variable on x axis
# y: variable on y axis
# group: error bar color
# bar.width: error bar width
# dodge.width: dodge width for error bar and jitter (prevent overlapping)
# jitter: logical, plot jitter or not, default TRUE
# jitter.alpha: jitter transparency
# jitter.width: jitter width in error bar
# line: line connect error bar, default uses mean, can be set as 'median', NULL (no line)
# line.color: connection line color, only available when group = NULL
# xlab: x axis label
# ylab: y axis label
# theme_classic: Use classic background without grids (default: FALSE)
# group.lab: label of group variable
# title: title of plot
if(xFlag == FALSE && !is.factor(data[, c(x)]))
{
data[, c(x)]=factor(data[, c(x)])
if(!is.null(x) && !is.null(xLevel))
{
data[, c(x)] = factor(data[, c(x)],
levels = xLevel,
ordered = TRUE)
}
} else {
data[, c(x)]=as.numeric(data[, c(x)])
}
mu = NULL
myse = NULL
# standard error function
se = function(s, na.rm = TRUE, semFlag = TRUE) {
if (na.rm) {
s = s[!is.na(s)]
}
res = sd(s)
if(semFlag)
{
res = res/sqrt(length(s))
}
return(res)
}
# calculate mean and standard error by group
if (!is.null(group) & !is.null(x)) {
data.mu.se = data %>% group_by_(group, x)
} else if (!is.null(group) & is.null(x)) {
data.mu.se = data %>% group_by_(group)
} else if (is.null(group) & !is.null(x)) {
data.mu.se = data %>% group_by_(x)
} else {
data.mu.se = data
}
# QWL: rename 'se' as 'myse' to distinguish it with 'se' function
# defined previously
data.mu.se = data.mu.se %>%
summarise_(mu = paste0('mean(', y, ', na.rm = TRUE)'),
myse = paste0('se(', y, ', na.rm = TRUE', ', semFlag=', semFlag, ")"))
# merge mu/se summary data with original data to plot error bar with jitter
# if (!is.null(group)) {
data.plot = full_join(data.mu.se, data)
# } else {
# data.plot = data.frame(data, data.mu.se)
# }
# create error bar layer
if (is.null(x)) {
if (!is.null(group)) {
x = group
g = ggplot( data.mu.se, aes_string(x = ifelse(is.null(x), 1, x), 'mu', fill = group)) +
geom_bar(stat="identity", color='grey',
position=position_dodge())+
geom_errorbar(
aes(ymin = mu - myse, ymax = mu + myse),
width = bar.width
) +
labs(title = title, color = group.lab) + xlab(label=xlab) + ylab(label=ylab)
#labs(x = xlab, y = ylab, title = title)
}
} else {
g = ggplot( data.mu.se, aes_string(x, 'mu', fill = group)) +
geom_bar(stat="identity", color='grey',
position=position_dodge())+
geom_errorbar(
aes(ymin = mu - myse, ymax = mu + myse),
position = position_dodge(width = dodge.width),
width = bar.width
) +
labs(title = title, color = group.lab) + xlab(label=xlab) + ylab(label=ylab)
#labs(x = xlab, y = ylab, color = group.lab, title = title)
}
# add jitter layer
if (jitter) {
if (!is.null(group)) {
g = g + geom_jitter(
aes_string(color = group),
position = position_jitterdodge( # set up dodge position for jitters
dodge.width = dodge.width, # dodge width between jitters
jitter.width = jitter.width # jitter width in error bar
),
alpha = jitter.alpha
)
} else {
g = g + geom_jitter(
aes_string(color = group),
width = jitter.width, # jitter width in error bar plot
alpha = jitter.alpha
)
}
}
# add connect line
if (is.null(x) & is.null(group)) line = NULL
if (!is.null(line)) {
if (!is.null(group)) {
if (group != x) {
g = g + stat_summary(fun.y = line, geom = 'line',
aes_string(group = group, color = group),
position = position_dodge(dodge.width))
} else {
g = g + stat_summary(fun.y = line, geom = 'line',
aes_string(group = 1), color = line.color)
}
} else {
g = g + stat_summary(fun.y = line, geom = 'line',
aes_string(group = 1), color = line.color)
}
}
# classical theme
if (theme_classic) {
g = g + theme_classic()
}
# add facet & theme arguments from ...
dots = list(...)
FACET_args_names = FACET %>% formals %>% names
FACET_args = dots[names(dots) %in% FACET_args_names]
THEME_args_names = THEME %>% formals %>% names
THEME_args = dots[names(dots) %in% THEME_args_names]
# add facet
if (length(FACET_args) != 0) {
g = do.call(FACET, c(list(g = g), FACET_args))
}
# axis label position
g = do.call(THEME, c(list(g = g), THEME_args))
if(addThemeFlag)
{
g = addTheme(g)
}
# return plot
g
}
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.