R/geom.R
In JunlueZhao/CourseraCapstone:
library(ggplot2)
library(grid)
##---------------------------------------------------------------------------------------------------------
StatTimeLine <- ggproto("StatTimeLine", Stat,
required_aes = c("x"),
default_aes = aes(),
compute_group = function(data, scales, xmin, xmax) {
if (substr(xmin,1,1)=="-")
xmin <- as.Date(-1*as.numeric(difftime(substr(xmin, 2, nchar(xmin)), "0000-01-01")), origin="0000-01-01")
else
xmin <- as.Date(xmin, origin="0000-01-01")
if (substr(xmax,1,1)=="-")
xmax <- as.Date(-1*as.numeric(difftime(substr(xmax, 2, nchar(xmax)), "0000-01-01")), origin="0000-01-01")
else
xmax <- as.Date(xmax, origin="0000-01-01")
data <- data[data$x >= xmin & data$x <= xmax, ]
data
})
GeomTimeLine <- ggproto("GeomTimeLine", Geom,
required_aes = c("x"),
# non_missing_aes = c("size", "shape", "colour"),
default_aes = aes(
shape = 19, colour = "grey", size = 7, fill = NA,
alpha = .5, stroke = 0.5, y=.2),
draw_key = draw_key_point,
draw_panel = function(data, panel_scales, coord) {
coords <- coord$transform(data, panel_scales)
line_ypos <- unique(coords$y)
lines <- data.frame("x"=c(1:2*length(line_ypos)) ,
"y"=c(1:2*length(line_ypos)) ,
"group"=c(1:2*length(line_ypos)))
for (i in 1:length(line_ypos)) {
lines[i, ] <- list(0, line_ypos[i], i)
lines[i+length(line_ypos), ] <- list(1, line_ypos[i], i)
}
print(coords$size)
print(data$colour)
grid::grobTree(
grid::polylineGrob(lines$x, lines$y, id=lines$group, gp=grid::gpar(col="grey")),
grid::pointsGrob(
coords$x, coords$y,
pch = ifelse(is.na(coords$size), 4, coords$shape),
gp = grid::gpar(
col = alpha(coords$colour, ifelse(coords$colour=="grey50", .2, coords$alpha)),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = ifelse(is.na(coords$size), 7, coords$size * .pt + coords$stroke * .stroke / 2),
lwd = coords$stroke * .stroke / 2
)
)
)
}
)
geom_timeline <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
xmin="2000-01-01", xmax="2018-01-01", ...) {
ggplot2::layer(
geom = GeomTimeLine, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(xmin=xmin, xmax=xmax, na.rm = na.rm, ...)
)
}
# --------------------ANnotation layer-------------------------
GeomTimeLineLabel <- ggproto("GeomTimeLineLabel", Geom,
required_aes = c("x", "label"),
default_aes = aes(y=.2),
draw_panel = function(data, panel_scales, coord, n_max) {
stopifnot("size" %in% colnames(data))
print(data)
n_max <- min(n_max, nrow(data))
data <- head(data[order(data$size,decreasing=TRUE), ], n_max)
data <- data[!is.na(data$size), ]
print(data)
coords <- coord$transform(data, panel_scales)
# str(coords)
lines <- data.frame("x"=c(1:2*nrow(coords)) ,
"y"=c(1:2*nrow(coords)) ,
"group"=c(1:2*nrow(coords)))
for (i in 1:nrow(coords)) {
lines[i, ] <- list(coords[i, "x"], coords[i, "y"], i)
lines[i+nrow(coords), ] <- list(coords[i,"x"], coords[i, "y"]+.05, i)
}
# print(nrow(coords))
# print(n_max)
# str(coords)
grid::grobTree( grid::polylineGrob(x=lines$x, y=lines$y,
id=lines$group,
gp=grid::gpar(col="grey")),
grid::textGrob(label=coords$label,
x=coords$x,
y=coords$y+.055,
rot=45, just='left'))
}
)
geom_timeline_label <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
n_max=5, ...) {
ggplot2::layer(
geom = GeomTimeLineLabel, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(n_max=n_max, na.rm = na.rm, ...)
)
}
#----------------------------------------------------------------------------------------------------------
ggplot(noaa[noaa$COUNTRY=="CHINA", ] ,
aes(DATE, COUNTRY, size=EQ_MAG_MW, colour=DEATHS)) +
geom_timeline(xmin="-1000-01-01", xmax="1000-01-01") + theme_classic() +
theme(legend.position="bottom", axis.line.y=element_blank()) + labs(y=NULL) +
geom_timeline_label(aes(label=LOCATION_NAME), n_max=10,xmin="-1000-01-01", xmax="1000-01-01")
#--------------------------------------------------------------------------------------------------------
library(faraway)
data("worldcup")
GeomAutoTransparent <- ggproto("GeomAutoTransparent", Geom,
required_aes = c("x"),
default_aes = aes(size = .02, shape = 19, alpha=.5, y = .5,
colour="red", fill="black", fontsize=1),
draw_key = draw_key_dotplot,
draw_panel = function(data, panel_scales, coord) {
coords <- coord$transform(data, panel_scales)
str(coords)
grid::pointsGrob(
x = coords$x,
y = coords$y,
pch = coords$shape,
size = unit(coords$size/100, "native"),
gp = grid::gpar(alpha = coords$alpha,
col = coords$colour)
)
})
geom_transparent <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
ggplot2::layer(
geom = GeomAutoTransparent, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
ggplot(data = worldcup, aes(Time, colour=Tackles/500, size=Passes)) + geom_transparent()
gr <- grid::pointsGrob(
x = c(100,200),
y = c(100,200),
pch = c(19,10),
size = unit(c(50,70), "native"),
gp = grid::gpar(alpha = c(1, 1), col = c("red", "green"))
)
grid::grid.draw(grid::polylineGrob(c(.1,.25, .5, .75 ), c(.1, .25, .8, .75), id=c(1,1,2,2)))
grid::grid.draw(grid::grobTree( grid::polygonGrob(x=c(.5,.5), y=c(.5,.69)),
grid::textGrob(label="someText", x=.5, y=.7, rot=45, just='left')))
JunlueZhao/CourseraCapstone documentation built on May 9, 2019, 3:26 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(ggplot2)
library(grid)
##---------------------------------------------------------------------------------------------------------
StatTimeLine <- ggproto("StatTimeLine", Stat,
required_aes = c("x"),
default_aes = aes(),
compute_group = function(data, scales, xmin, xmax) {
if (substr(xmin,1,1)=="-")
xmin <- as.Date(-1*as.numeric(difftime(substr(xmin, 2, nchar(xmin)), "0000-01-01")), origin="0000-01-01")
else
xmin <- as.Date(xmin, origin="0000-01-01")
if (substr(xmax,1,1)=="-")
xmax <- as.Date(-1*as.numeric(difftime(substr(xmax, 2, nchar(xmax)), "0000-01-01")), origin="0000-01-01")
else
xmax <- as.Date(xmax, origin="0000-01-01")
data <- data[data$x >= xmin & data$x <= xmax, ]
data
})
GeomTimeLine <- ggproto("GeomTimeLine", Geom,
required_aes = c("x"),
# non_missing_aes = c("size", "shape", "colour"),
default_aes = aes(
shape = 19, colour = "grey", size = 7, fill = NA,
alpha = .5, stroke = 0.5, y=.2),
draw_key = draw_key_point,
draw_panel = function(data, panel_scales, coord) {
coords <- coord$transform(data, panel_scales)
line_ypos <- unique(coords$y)
lines <- data.frame("x"=c(1:2*length(line_ypos)) ,
"y"=c(1:2*length(line_ypos)) ,
"group"=c(1:2*length(line_ypos)))
for (i in 1:length(line_ypos)) {
lines[i, ] <- list(0, line_ypos[i], i)
lines[i+length(line_ypos), ] <- list(1, line_ypos[i], i)
}
print(coords$size)
print(data$colour)
grid::grobTree(
grid::polylineGrob(lines$x, lines$y, id=lines$group, gp=grid::gpar(col="grey")),
grid::pointsGrob(
coords$x, coords$y,
pch = ifelse(is.na(coords$size), 4, coords$shape),
gp = grid::gpar(
col = alpha(coords$colour, ifelse(coords$colour=="grey50", .2, coords$alpha)),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = ifelse(is.na(coords$size), 7, coords$size * .pt + coords$stroke * .stroke / 2),
lwd = coords$stroke * .stroke / 2
)
)
)
}
)
geom_timeline <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
xmin="2000-01-01", xmax="2018-01-01", ...) {
ggplot2::layer(
geom = GeomTimeLine, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(xmin=xmin, xmax=xmax, na.rm = na.rm, ...)
)
}
# --------------------ANnotation layer-------------------------
GeomTimeLineLabel <- ggproto("GeomTimeLineLabel", Geom,
required_aes = c("x", "label"),
default_aes = aes(y=.2),
draw_panel = function(data, panel_scales, coord, n_max) {
stopifnot("size" %in% colnames(data))
print(data)
n_max <- min(n_max, nrow(data))
data <- head(data[order(data$size,decreasing=TRUE), ], n_max)
data <- data[!is.na(data$size), ]
print(data)
coords <- coord$transform(data, panel_scales)
# str(coords)
lines <- data.frame("x"=c(1:2*nrow(coords)) ,
"y"=c(1:2*nrow(coords)) ,
"group"=c(1:2*nrow(coords)))
for (i in 1:nrow(coords)) {
lines[i, ] <- list(coords[i, "x"], coords[i, "y"], i)
lines[i+nrow(coords), ] <- list(coords[i,"x"], coords[i, "y"]+.05, i)
}
# print(nrow(coords))
# print(n_max)
# str(coords)
grid::grobTree( grid::polylineGrob(x=lines$x, y=lines$y,
id=lines$group,
gp=grid::gpar(col="grey")),
grid::textGrob(label=coords$label,
x=coords$x,
y=coords$y+.055,
rot=45, just='left'))
}
)
geom_timeline_label <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
n_max=5, ...) {
ggplot2::layer(
geom = GeomTimeLineLabel, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(n_max=n_max, na.rm = na.rm, ...)
)
}
#----------------------------------------------------------------------------------------------------------
ggplot(noaa[noaa$COUNTRY=="CHINA", ] ,
aes(DATE, COUNTRY, size=EQ_MAG_MW, colour=DEATHS)) +
geom_timeline(xmin="-1000-01-01", xmax="1000-01-01") + theme_classic() +
theme(legend.position="bottom", axis.line.y=element_blank()) + labs(y=NULL) +
geom_timeline_label(aes(label=LOCATION_NAME), n_max=10,xmin="-1000-01-01", xmax="1000-01-01")
#--------------------------------------------------------------------------------------------------------
library(faraway)
data("worldcup")
GeomAutoTransparent <- ggproto("GeomAutoTransparent", Geom,
required_aes = c("x"),
default_aes = aes(size = .02, shape = 19, alpha=.5, y = .5,
colour="red", fill="black", fontsize=1),
draw_key = draw_key_dotplot,
draw_panel = function(data, panel_scales, coord) {
coords <- coord$transform(data, panel_scales)
str(coords)
grid::pointsGrob(
x = coords$x,
y = coords$y,
pch = coords$shape,
size = unit(coords$size/100, "native"),
gp = grid::gpar(alpha = coords$alpha,
col = coords$colour)
)
})
geom_transparent <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
ggplot2::layer(
geom = GeomAutoTransparent, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
ggplot(data = worldcup, aes(Time, colour=Tackles/500, size=Passes)) + geom_transparent()
gr <- grid::pointsGrob(
x = c(100,200),
y = c(100,200),
pch = c(19,10),
size = unit(c(50,70), "native"),
gp = grid::gpar(alpha = c(1, 1), col = c("red", "green"))
)
grid::grid.draw(grid::polylineGrob(c(.1,.25, .5, .75 ), c(.1, .25, .8, .75), id=c(1,1,2,2)))
grid::grid.draw(grid::grobTree( grid::polygonGrob(x=c(.5,.5), y=c(.5,.69)),
grid::textGrob(label="someText", x=.5, y=.7, rot=45, just='left')))
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.