Nothing
# Functions for constructing ggplot command strings
#
# Internals: nothing to export here!
frame_string <- function(data = NULL, x = NULL, y = NULL, aes_pairs = NULL) {
ystring <- ifelse(is.null(y), "", paste0(", y = ", y) )
for (nm in names(aes_pairs))
ystring <- paste0(ystring, ", ", nm, " = ", aes_pairs[[nm]] )
res <- sprintf("ggplot(%s, aes(x = %s%s))", data, x, ystring)
res
}
density_string <- function(data_name = NULL, var_names, type, xframe, position, color, fill, ...){
one <- frame_string(data = data_name, xframe)
two <- layer_string(var_names, geom = type, position = position, color=color, fill=fill, ...)
paste(one, two, sep = "+")
}
map_string <- function(map_name, location, zoom, source, type, extent = "normal", ...) {
map_source <- if (length(map_name) == 0) {
sprintf( "ggmap::get_map(location = '%s', zoom = %d, source = '%s', maptype = '%s', crop=FALSE)",
location, zoom, source, type)
} else {
map_name
}
sprintf("ggmap::ggmap(%s, extent = '%s')", map_source, extent)
}
# variable for facetting as a character string
facet_string <- function(var) {
if (var == "") ""
else sprintf("+ facet_wrap( ~ %s)", var)
}
legend_position_string <- function(where) {
if (where == "") return("")
sprintf("+ theme(legend.position='%s')", where)
}
# The aesthetics for each supported geom
.aesthetics. <- list(
point = list(x = NULL, y=NULL, alpha = NULL, color = NULL, colour = NULL,
fill = NULL, shape = NULL, size = NULL, stroke = NULL),
line = list(x = NULL, y=NULL, alpha=NULL, group = NULL, color = NULL, colour=NULL, linetype=NULL, size=NULL),
path = list(x = NULL, y=NULL, alpha=NULL, group = NULL, color = NULL, colour=NULL, linetype=NULL, size=NULL),
boxplot = list(x = NULL, y=NULL, alpha=NULL, group = NULL, fill = NULL,
color = NULL, colour=NULL, linetype=NULL, size=NULL),
violin = list(x = NULL, y=NULL, alpha=NULL, group = NULL, fill = NULL,
color = NULL, colour=NULL, linetype=NULL, size=NULL),
# single variable plot types
density = list(x = NULL, alpha = NULL, fill = NULL, color = NULL, colour = NULL, position = NULL),
freqpoly = list(x = NULL, alpha = NULL, fill = NULL, color = NULL, colour = NULL, position = NULL),
histogram = list(x = NULL, alpha = NULL, fill = NULL, color = NULL, colour = NULL, position = NULL),
bar = list(x = NULL, y = NULL, alpha = NULL, fill = NULL, color = NULL, colour = NULL, position = NULL)
)
model_string <- function(which) {
res <- switch(which,
none = "",
linear = " + stat_smooth(method=lm, se=FALSE)",
smoother = " + stat_smooth(method=loess, se=FALSE)",
"linear+bands" = " + stat_smooth(method=lm, se=TRUE, level=0.95)",
"smoother+bands" = " + stat_smooth(method=loess, se=TRUE, level=0.95)"
)
res
}
log_axes_string <- function(which = c("none", "both", "x", "y")) {
if (which == "none") return("")
x <- "scale_x_log10()"
y <- "scale_y_log10()"
if (which == "both")
return(paste("", x, y, sep = " + "))
if (which == 'x')
return(paste0(" + ", x))
if (which == "y")
return(paste0(" + ", y))
}
layer_string <- function(var_names, geom = "point", extras = "", details = NULL,
data_name = NULL, formula = NULL, ...) {
map_list <- map_list <- list()
if ( ! is.null(formula)) {
nms <- all.vars(formula)
map_list$x = nms[2]
map_list$y = nms[1]
}
set_list <- list()
if ( ! is.null(data_name)) {
set_list$data = data_name
}
candidates <- list(...)
aes <- .aesthetics.[[geom]]
aes_names <- names(aes)
candidate_names <- names(candidates)
if (length(candidates) > 0) {
for (k in 1:length(candidates)) {
if (candidates[[k]] == "") next # skip it!
if ( ! candidate_names[k] %in% c(aes_names, "data")){
warning("<", candidate_names[k],"> not in geom_", geom)
} else if (candidates[[k]] %in% var_names) {
map_list[candidate_names[k]] <- candidates[[k]]
} else {
# for set_list
val <- candidates[[k]]
as_number <- suppressWarnings(as.numeric(val))
if (is.na(as_number)) { # val should be quoted
val <- paste0("'", val, "'")
} else {
val <- as_number
}
set_list[candidate_names[k]] <-
ifelse(candidate_names[[k]] == "data",
candidates[[k]],
val)
}
}
}
set_list <- c(set_list, details)
set_string <- paste(collapse = ", ",
paste(names(set_list), set_list, sep = " = "))
map_string <- paste0("aes(",
paste( collapse = ", ",
paste(names(map_list), map_list, sep = " = ")
), ")")
res <- paste0("geom_", geom, "(",
ifelse(length(map_list) > 0, map_string, ""),
ifelse(length(map_list) > 0 & length(set_list) != 0, ", ", ""),
ifelse (length(set_list) > 0, set_string, ""),
ifelse (extras == "", "", paste(",", extras)),
")"
)
res
}
capture_extras <- function(...) {
extras <- list(...)
res <- ""
values = list()
if (length(extras) > 0) {
for (k in seq_along(extras)) {
as_number <- suppressWarnings(as.numeric(extras[[k]]))
if (is.na(as_number)) { # val should be quoted
values[k] <- paste0("'", extras[[k]], "'")
} else {
values[k] <- as_number
}
}
res <- paste(paste(names(extras), unlist(values), sep = " = "), collapse = ", ")
}
res
}
# Take a character string of possibilities and prepend it with NA
add_NA <- function(levels) {
res <- as.list(levels)
names(res) <- levels
c(list(none = ""), res)
}
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.