Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

189 lines (158 sloc) 6.621 kb
GeomPath <- proto(Geom, {
draw_groups <- function(., ...) .$draw(...)
draw <- function(., data, scales, coordinates, arrow = NULL, lineend = "butt", linejoin = "round", linemitre = 1, ..., na.rm = FALSE) {
keep <- function(x) {
# from first non-missing to last non-missing
first <- match(FALSE, x, nomatch = 1) - 1
last <- length(x) - match(FALSE, rev(x), nomatch = 1) + 1
c(
rep(FALSE, first),
rep(TRUE, last - first),
rep(FALSE, length(x) - last))
}
# Drop missing values at the start or end of a line - can't drop in the
# middle since you expect those to be shown by a break in the line
missing <- !complete.cases(data[c("x", "y", "size", "colour",
"linetype")])
kept <- ave(missing, data$group, FUN=keep)
data <- data[kept, ]
if (!all(kept) && !na.rm) {
warning("Removed ", sum(!kept), " rows containing missing values",
" (geom_path).", call. = FALSE)
}
munched <- coordinates$munch(data, scales)
# Silently drop lines with less than two points, preserving order
rows <- ave(seq_len(nrow(munched)), munched$group, FUN = length)
munched <- munched[rows >= 2, ]
if (nrow(munched) < 2) return(zeroGrob())
# Work out whether we should use lines or segments
attr <- ddply(munched, .(group), function(df) {
data.frame(
solid = identical(unique(df$linetype), 1),
constant = nrow(unique(df[, c("alpha", "colour","size", "linetype")])) == 1
)
})
solid_lines <- all(attr$solid)
constant <- all(attr$constant)
if (!solid_lines && !constant) {
stop("geom_path: If you are using dotted or dashed lines",
", colour, size and linetype must be constant over the line",
call.=FALSE)
}
# Work out grouping variables for grobs
n <- nrow(munched)
group_diff <- munched$group[-1] != munched$group[-n]
start <- c(TRUE, group_diff)
end <- c(group_diff, TRUE)
if (!constant) {
with(munched,
segmentsGrob(
x[!end], y[!end], x[!start], y[!start],
default.units="native", arrow = arrow,
gp = gpar(
col = alpha(colour, alpha)[!end],
lwd = size[!end] * .pt, lty = linetype[!end],
lineend = lineend, linejoin = linejoin, linemitre = linemitre
)
)
)
} else {
with(munched,
polylineGrob(
x, y, id = as.integer(factor(group)),
default.units = "native", arrow = arrow,
gp = gpar(
col = alpha(colour, alpha)[start],
lwd = size[start] * .pt, lty = linetype[start],
lineend = lineend, linejoin = linejoin, linemitre = linemitre)
)
)
}
}
draw_legend <- function(., data, ...) {
data$arrow <- NULL
data <- aesdefaults(data, .$default_aes(), list(...))
with(data,
ggname(.$my_name(), segmentsGrob(0.1, 0.5, 0.9, 0.5, default.units="npc",
gp=gpar(col=alpha(colour, alpha), lwd=size * .pt,
lty=linetype, lineend="butt")))
)
}
objname <- "path"
desc <- "Connect observations, in original order"
desc_params <- list(
lineend = "Line end style (round, butt, square)",
linejoin = "Line join style (round, mitre, bevel)",
linemitre = "Line mitre limit (number greater than 1)",
arrow = "Arrow specification, as created by ?arrow"
)
default_stat <- function(.) StatIdentity
required_aes <- c("x", "y")
default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = 1)
icon <- function(.) linesGrob(c(0.2, 0.4, 0.8, 0.6, 0.5), c(0.2, 0.7, 0.4, 0.1, 0.5))
guide_geom <- function(.) "path"
seealso <- list(
geom_line = "Functional (ordered) lines",
geom_polygon = "Filled paths (polygons)",
geom_segment = "Line segments"
)
examples <- function(.) {
# Generate data
myear <- ddply(movies, .(year), plyr::colwise(mean, .(length, rating)))
p <- ggplot(myear, aes(length, rating))
p + geom_path()
# Add aesthetic mappings
p + geom_path(aes(size = year))
p + geom_path(aes(colour = year))
# Change scale
p + geom_path(aes(size = year)) + scale_size(to = c(1, 3))
# Set aesthetics to fixed value
p + geom_path(colour = "green")
# Control line join parameters
df <- data.frame(x = 1:3, y = c(4, 1, 9))
base <- ggplot(df, aes(x, y))
base + geom_path(size = 10)
base + geom_path(size = 10, lineend = "round")
base + geom_path(size = 10, linejoin = "mitre", lineend = "butt")
# Use qplot instead
qplot(length, rating, data=myear, geom="path")
# Using economic data:
# How is unemployment and personal savings rate related?
qplot(unemploy/pop, psavert, data=economics)
qplot(unemploy/pop, psavert, data=economics, geom="path")
qplot(unemploy/pop, psavert, data=economics, geom="path", size=as.numeric(date))
# How is rate of unemployment and length of unemployment?
qplot(unemploy/pop, uempmed, data=economics)
qplot(unemploy/pop, uempmed, data=economics, geom="path")
qplot(unemploy/pop, uempmed, data=economics, geom="path") +
geom_point(data=head(economics, 1), colour="red") +
geom_point(data=tail(economics, 1), colour="blue")
qplot(unemploy/pop, uempmed, data=economics, geom="path") +
geom_text(data=head(economics, 1), label="1967", colour="blue") +
geom_text(data=tail(economics, 1), label="2007", colour="blue")
# geom_path removes missing values on the ends of a line.
# use na.rm = T to suppress the warning message
df <- data.frame(
x = 1:5,
y1 = c(1, 2, 3, 4, NA),
y2 = c(NA, 2, 3, 4, 5),
y3 = c(1, 2, NA, 4, 5),
y4 = c(1, 2, 3, 4, 5))
qplot(x, y1, data = df, geom = c("point","line"))
qplot(x, y2, data = df, geom = c("point","line"))
qplot(x, y3, data = df, geom = c("point","line"))
qplot(x, y4, data = df, geom = c("point","line"))
# Setting line type vs colour/size
# Line type needs to be applied to a line as a whole, so it can
# not be used with colour or size that vary across a line
x <- seq(0.01, .99, length=100)
df <- data.frame(x = rep(x, 2), y = c(qlogis(x), 2 * qlogis(x)), group = rep(c("a","b"), each=100))
p <- ggplot(df, aes(x=x, y=y, group=group))
# Should work
p + geom_line(linetype = 2)
p + geom_line(aes(colour = group), linetype = 2)
p + geom_line(aes(colour = x))
# Should fail
p + geom_line(aes(colour = x), linetype=2)
}
})
Jump to Line
Something went wrong with that request. Please try again.