Compare commits
3 Commits
| Author | SHA1 | Date |
|---|---|---|
 boB Rudis
|
19e04a3fc0 | 3 years ago |
|
boB Rudis
|
a8c1e8315c | 5 years ago |
|
boB Rudis
|
776e164709 | 5 years ago |
@ -1,353 +0,0 @@ |
|||
#' Similar to \code{coord_map} but uses the PROJ.4 library/package for projection |
|||
#' transformation |
|||
#' |
|||
#' The representation of a portion of the earth, which is approximately |
|||
#' spherical, onto a flat 2D plane requires a projection. This is what |
|||
#' \code{coord_proj} does, using the \code{proj4::project()} function from |
|||
#' the \code{proj4} package. |
|||
#' |
|||
#' \if{html}{ |
|||
#' A sample of the output from \code{coord_proj()} using the Winkel-Tripel projection: |
|||
#' |
|||
#' \figure{coordproj01.png}{options: width="100\%" alt="Figure: coordproj01.png"} |
|||
#' } |
|||
#' |
|||
#' \if{latex}{ |
|||
#' A sample of the output from \code{coord_proj()} using the Winkel-Tripel projection: |
|||
#'`` |
|||
#' \figure{coordproj01.png}{options: width=10cm} |
|||
#' } |
|||
#' |
|||
#' @note It is recommended that you use \code{geom_cartogram} with this coordinate system |
|||
#' @param proj projection definition. If left \code{NULL} will default to |
|||
#' a Robinson projection |
|||
#' @param inverse if \code{TRUE} inverse projection is performed (from a |
|||
#' cartographic projection into lat/long), otherwise projects from |
|||
#' lat/long into a cartographic projection. |
|||
#' @param degrees if \code{TRUE} then the lat/long data is assumed to be in |
|||
#' degrees, otherwise in radians |
|||
#' @param ellps.default default ellipsoid that will be added if no datum or |
|||
#' ellipsoid parameter is specified in proj. Older versions of PROJ.4 |
|||
#' didn't require a datum (and used sphere by default), but 4.5.0 and |
|||
#' higher always require a datum or an ellipsoid. Set to \code{NA} if no |
|||
#' datum should be added to proj (e.g. if you specify an ellipsoid |
|||
#' directly). |
|||
#' @param xlim manually specify x limits (in degrees of longitude) |
|||
#' @param ylim manually specify y limits (in degrees of latitude) |
|||
#' @note When \code{inverse} is \code{FALSE} \code{coord_proj} makes a fairly |
|||
#' large assumption that the coordinates being transformed are within |
|||
#' -180:180 (longitude) and -90:90 (latitude). As such, it truncates |
|||
#' all longitude & latitude input to fit within these ranges. More updates |
|||
#' to this new \code{coord_} are planned. |
|||
#' @export |
|||
#' @examples \dontrun{ |
|||
#' # World in Winkel-Tripel |
|||
# world <- map_data("world") |
|||
# world <- world[world$region != "Antarctica",] |
|||
# |
|||
# gg <- ggplot() |
|||
# gg <- gg + geom_cartogram(data=world, map=world, |
|||
# aes(x=long, y=lat, map_id=region)) |
|||
# gg <- gg + coord_proj("+proj=wintri") |
|||
# gg |
|||
#' |
|||
#' # U.S.A. Albers-style |
|||
#' usa <- world[world$region == "USA",] |
|||
#' usa <- usa[!(usa$subregion %in% c("Alaska", "Hawaii")),] |
|||
#' |
|||
#' gg <- ggplot() |
|||
#' gg <- gg + geom_cartogram(data=usa, map=usa, |
|||
#' aes(x=long, y=lat, map_id=region)) |
|||
#' gg <- gg + coord_proj( |
|||
#' paste0("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96", |
|||
#' " +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs")) |
|||
#' gg |
|||
#' |
|||
#' # Showcase Greenland (properly) |
|||
#' greenland <- world[world$region == "Greenland",] |
|||
#' |
|||
#' gg <- ggplot() |
|||
#' gg <- gg + geom_cartogram(data=greenland, map=greenland, |
|||
#' aes(x=long, y=lat, map_id=region)) |
|||
#' gg <- gg + coord_proj( |
|||
#' paste0("+proj=stere +lat_0=90 +lat_ts=70 +lon_0=-45 +k=1 +x_0=0", |
|||
#' " +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")) |
|||
#' gg |
|||
#' } |
|||
coord_proj <- function(proj=NULL, inverse = FALSE, degrees = TRUE, |
|||
ellps.default="sphere", xlim = NULL, ylim = NULL) { |
|||
|
|||
if (is.null(proj)) { |
|||
proj <- paste0(c("+proj=robin +lon_0=0 +x_0=0 +y_0=0", |
|||
"+ellps=WGS84 +datum=WGS84 +units=m +no_defs"), |
|||
collapse=" ") |
|||
} |
|||
|
|||
ggproto(NULL, CoordProj, |
|||
proj = proj, |
|||
inverse = inverse, |
|||
ellps.default = ellps.default, |
|||
degrees = degrees, |
|||
limits = list(x = xlim, y = ylim), |
|||
params= list() # parameters are encoded in the proj4 string |
|||
) |
|||
|
|||
} |
|||
|
|||
#' Geom Proto |
|||
#' @rdname ggalt-ggproto |
|||
#' @format NULL |
|||
#' @usage NULL |
|||
#' @keywords internal |
|||
#' @export |
|||
CoordProj <- ggproto("CoordProj", Coord, |
|||
|
|||
transform = function(self, data, panel_params) { |
|||
|
|||
trans <- project4(self, data$x, data$y) |
|||
out <- cunion(trans[c("x", "y")], data) |
|||
|
|||
out$x <- rescale(out$x, 0:1, panel_params$x.proj) |
|||
out$y <- rescale(out$y, 0:1, panel_params$y.proj) |
|||
|
|||
out |
|||
|
|||
}, |
|||
|
|||
distance = function(x, y, panel_params) { |
|||
max_dist <- dist_central_angle(panel_params$x.range, panel_params$y.range) |
|||
dist_central_angle(x, y) / max_dist |
|||
}, |
|||
|
|||
aspect = function(ranges) { |
|||
diff(ranges$y.proj) / diff(ranges$x.proj) |
|||
}, |
|||
|
|||
train = function(self, scale_details) { |
|||
|
|||
# range in scale |
|||
ranges <- list() |
|||
for (n in c("x", "y")) { |
|||
|
|||
scale <- scale_details[[n]] |
|||
limits <- self$limits[[n]] |
|||
|
|||
if (is.null(limits)) { |
|||
range <- scale$dimension(expand_default(scale)) |
|||
} else { |
|||
range <- range(scale$transform(limits)) |
|||
} |
|||
ranges[[n]] <- range |
|||
} |
|||
|
|||
orientation <- self$orientation %||% c(90, 0, mean(ranges$x)) |
|||
|
|||
# Increase chances of creating valid boundary region |
|||
grid <- expand.grid( |
|||
x = seq(ranges$x[1], ranges$x[2], length.out = 50), |
|||
y = seq(ranges$y[1], ranges$y[2], length.out = 50) |
|||
) |
|||
|
|||
ret <- list(x = list(), y = list()) |
|||
|
|||
# range in map |
|||
proj <- project4(self, grid$x, grid$y)$range |
|||
ret$x$proj <- proj[1:2] |
|||
ret$y$proj <- proj[3:4] |
|||
|
|||
for (n in c("x", "y")) { |
|||
out <- scale_details[[n]]$break_info(ranges[[n]]) |
|||
ret[[n]]$range <- out$range |
|||
ret[[n]]$major <- out$major_source |
|||
ret[[n]]$minor <- out$minor_source |
|||
ret[[n]]$labels <- out$labels |
|||
} |
|||
|
|||
details <- list( |
|||
orientation = orientation, |
|||
x.range = ret$x$range, y.range = ret$y$range, |
|||
x.proj = ret$x$proj, y.proj = ret$y$proj, |
|||
x.major = ret$x$major, x.minor = ret$x$minor, x.labels = ret$x$labels, |
|||
y.major = ret$y$major, y.minor = ret$y$minor, y.labels = ret$y$labels |
|||
) |
|||
details |
|||
}, |
|||
setup_panel_params = function(self, scale_x, scale_y, params = list()) { |
|||
|
|||
# range in scale |
|||
ranges <- list() |
|||
for (n in c("x", "y")) { |
|||
|
|||
scale <- get(paste0("scale_", n)) |
|||
limits <- self$limits[[n]] |
|||
|
|||
if (is.null(limits)) { |
|||
range <- scale$dimension(expand_default(scale)) |
|||
} else { |
|||
range <- range(scale$transform(limits)) |
|||
} |
|||
ranges[[n]] <- range |
|||
} |
|||
|
|||
orientation <- self$orientation %||% c(90, 0, mean(ranges$x)) |
|||
|
|||
# Increase chances of creating valid boundary region |
|||
grid <- expand.grid( |
|||
x = seq(ranges$x[1], ranges$x[2], length.out = 50), |
|||
y = seq(ranges$y[1], ranges$y[2], length.out = 50) |
|||
) |
|||
|
|||
ret <- list(x = list(), y = list()) |
|||
|
|||
# range in map |
|||
proj <- project4(self, grid$x, grid$y)$range |
|||
ret$x$proj <- proj[1:2] |
|||
ret$y$proj <- proj[3:4] |
|||
|
|||
for (n in c("x", "y")) { |
|||
out <- get(paste0("scale_", n))$break_info(ranges[[n]]) |
|||
# out <- panel_params[[n]]$break_info(ranges[[n]]) |
|||
ret[[n]]$range <- out$range |
|||
ret[[n]]$major <- out$major_source |
|||
ret[[n]]$minor <- out$minor_source |
|||
ret[[n]]$labels <- out$labels |
|||
} |
|||
|
|||
details <- list( |
|||
orientation = orientation, |
|||
x.range = ret$x$range, y.range = ret$y$range, |
|||
x.proj = ret$x$proj, y.proj = ret$y$proj, |
|||
x.major = ret$x$major, x.minor = ret$x$minor, x.labels = ret$x$labels, |
|||
y.major = ret$y$major, y.minor = ret$y$minor, y.labels = ret$y$labels |
|||
) |
|||
details |
|||
}, |
|||
|
|||
render_bg = function(self, panel_params, theme) { |
|||
|
|||
xrange <- expand_range(panel_params$x.range, 0.2) |
|||
yrange <- expand_range(panel_params$y.range, 0.2) |
|||
|
|||
# Limit ranges so that lines don't wrap around globe |
|||
xmid <- mean(xrange) |
|||
ymid <- mean(yrange) |
|||
xrange[xrange < xmid - 180] <- xmid - 180 |
|||
xrange[xrange > xmid + 180] <- xmid + 180 |
|||
yrange[yrange < ymid - 90] <- ymid - 90 |
|||
yrange[yrange > ymid + 90] <- ymid + 90 |
|||
|
|||
xgrid <- with(panel_params, expand.grid( |
|||
y = c(seq(yrange[1], yrange[2], length.out = 50), NA), |
|||
x = x.major |
|||
)) |
|||
ygrid <- with(panel_params, expand.grid( |
|||
x = c(seq(xrange[1], xrange[2], length.out = 50), NA), |
|||
y = y.major |
|||
)) |
|||
|
|||
xlines <- self$transform(xgrid, panel_params) |
|||
ylines <- self$transform(ygrid, panel_params) |
|||
|
|||
if (nrow(xlines) > 0) { |
|||
grob.xlines <- element_render( |
|||
theme, "panel.grid.major.x", |
|||
xlines$x, xlines$y, default.units = "native" |
|||
) |
|||
} else { |
|||
grob.xlines <- zeroGrob() |
|||
} |
|||
|
|||
if (nrow(ylines) > 0) { |
|||
grob.ylines <- element_render( |
|||
theme, "panel.grid.major.y", |
|||
ylines$x, ylines$y, default.units = "native" |
|||
) |
|||
} else { |
|||
grob.ylines <- zeroGrob() |
|||
} |
|||
|
|||
ggname("grill", grobTree( |
|||
element_render(theme, "panel.background"), |
|||
grob.xlines, grob.ylines |
|||
)) |
|||
}, |
|||
|
|||
render_axis_h = function(self, panel_params, theme) { |
|||
arrange <- panel_params$x.arrange %||% c("primary", "secondary") |
|||
|
|||
if (is.null(panel_params$x.major)) { |
|||
return(list( |
|||
top = zeroGrob(), |
|||
bottom = zeroGrob() |
|||
)) |
|||
} |
|||
|
|||
x_intercept <- with(panel_params, data.frame( |
|||
x = x.major, |
|||
y = y.range[1] |
|||
)) |
|||
pos <- self$transform(x_intercept, panel_params) |
|||
|
|||
axes <- list( |
|||
bottom = guide_axis(pos$x, panel_params$x.labels, "bottom", theme), |
|||
top = guide_axis(pos$x, panel_params$x.labels, "top", theme) |
|||
) |
|||
axes[[which(arrange == "secondary")]] <- zeroGrob() |
|||
axes |
|||
}, |
|||
|
|||
render_axis_v = function(self, panel_params, theme) { |
|||
arrange <- panel_params$y.arrange %||% c("primary", "secondary") |
|||
|
|||
if (is.null(panel_params$y.major)) { |
|||
return(list( |
|||
left = zeroGrob(), |
|||
right = zeroGrob() |
|||
)) |
|||
} |
|||
|
|||
x_intercept <- with(panel_params, data.frame( |
|||
x = x.range[1], |
|||
y = y.major |
|||
)) |
|||
pos <- self$transform(x_intercept, panel_params) |
|||
|
|||
axes <- list( |
|||
left = guide_axis(pos$y, panel_params$y.labels, "left", theme), |
|||
right = guide_axis(pos$y, panel_params$y.labels, "right", theme) |
|||
) |
|||
axes[[which(arrange == "secondary")]] <- zeroGrob() |
|||
axes |
|||
} |
|||
|
|||
) |
|||
|
|||
|
|||
project4 <- function(coord, x, y) { |
|||
|
|||
df <- data.frame(x=x, y=y) |
|||
|
|||
if (!coord$inverse) { |
|||
|
|||
# map extremes cause issues with projections both with proj4 & |
|||
# spTransform. this compensates for them. |
|||
|
|||
df$x <- ifelse(df$x <= -180, -179.99999999999, df$x) |
|||
df$x <- ifelse(df$x >= 180, 179.99999999999, df$x) |
|||
df$y <- ifelse(df$y <= -90, -89.99999999999, df$y) |
|||
df$y <- ifelse(df$y >= 90, 89.99999999999, df$y) |
|||
|
|||
} |
|||
|
|||
suppressWarnings({ |
|||
res <- proj4::project(list(x=df$x, y=df$y), |
|||
proj = coord$proj, |
|||
inverse = coord$inverse, |
|||
degrees = coord$degrees, |
|||
ellps.default = coord$ellps.default) |
|||
res$range <- c(range(res$x, na.rm=TRUE), range(res$y, na.rm=TRUE)) |
|||
res$error <- 0 |
|||
res |
|||
}) |
|||
} |
|||
|
|||
@ -1,152 +0,0 @@ |
|||
#' Map polygons layer enabling the display of show statistical information |
|||
#' |
|||
#' This replicates the old behaviour of \code{geom_map()}, enabling specifying of |
|||
#' \code{x} and \code{y} aesthetics. |
|||
#' |
|||
#' @section Aesthetics: |
|||
#' \code{geom_cartogram} understands the following aesthetics (required aesthetics are in bold): |
|||
#' \itemize{ |
|||
#' \item \code{map_id} |
|||
#' \item \code{alpha} |
|||
#' \item \code{colour} |
|||
#' \item \code{fill} |
|||
#' \item \code{group} |
|||
#' \item \code{linetype} |
|||
#' \item \code{size} |
|||
#' \item \code{x} |
|||
#' \item \code{y} |
|||
#' } |
|||
#' |
|||
#' @export |
|||
#' @param map Data frame that contains the map coordinates. This will |
|||
#' typically be created using \code{\link{fortify}} on a spatial object. |
|||
#' It must contain columns \code{x}, \code{long} or \code{longitude}, |
|||
#' \code{y}, \code{lat} or \code{latitude} and \code{region} or \code{id}. |
|||
#' @inheritParams ggplot2::layer |
|||
#' @inheritParams ggplot2::geom_point |
|||
#' @examples \dontrun{ |
|||
#' # When using geom_polygon, you will typically need two data frames: |
|||
#' # one contains the coordinates of each polygon (positions), and the |
|||
#' # other the values associated with each polygon (values). An id |
|||
#' # variable links the two together |
|||
#' |
|||
#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3")) |
|||
#' |
|||
#' values <- data.frame( |
|||
#' id = ids, |
|||
#' value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5) |
|||
#' ) |
|||
#' |
|||
#' positions <- data.frame( |
|||
#' id = rep(ids, each = 4), |
|||
#' x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3, |
|||
#' 0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3), |
|||
#' y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5, |
|||
#' 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) |
|||
#' ) |
|||
#' |
|||
#' ggplot() + |
|||
#' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) |
|||
#' |
|||
#' ggplot() + |
|||
#' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + |
|||
#' geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) |
|||
#' |
|||
#' ggplot() + |
|||
#' geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + |
|||
#' geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) + |
|||
#' ylim(0, 3) |
|||
#' |
|||
#' # Better example |
|||
#' crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) |
|||
#' crimesm <- reshape2::melt(crimes, id = 1) |
|||
#' |
|||
#' if (require(maps)) { |
|||
#' |
|||
#' states_map <- map_data("state") |
|||
#' |
|||
#' ggplot() + |
|||
#' geom_cartogram(aes(long, lat, map_id = region), map = states_map, data=states_map) + |
|||
#' geom_cartogram(aes(fill = Murder, map_id = state), map=states_map, data=crimes) |
|||
#' |
|||
#' last_plot() + coord_map("polyconic") |
|||
#' |
|||
#' ggplot() + |
|||
#' geom_cartogram(aes(long, lat, map_id=region), map = states_map, data=states_map) + |
|||
#' geom_cartogram(aes(fill = value, map_id=state), map = states_map, data=crimesm) + |
|||
#' coord_map("polyconic") + |
|||
#' facet_wrap( ~ variable) |
|||
#' } |
|||
#' } |
|||
geom_cartogram <- function(mapping = NULL, data = NULL, |
|||
stat = "identity", |
|||
..., |
|||
map, |
|||
na.rm = FALSE, |
|||
show.legend = NA, |
|||
inherit.aes = TRUE) { |
|||
|
|||
# Get map input into correct form |
|||
|
|||
stopifnot(is.data.frame(map)) |
|||
|
|||
if (!is.null(map$latitude)) map$y <- map$latitude |
|||
if (!is.null(map$lat)) map$y <- map$lat |
|||
|
|||
if (!is.null(map$longitude)) map$x <- map$longitude |
|||
if (!is.null(map$long)) map$x <- map$long |
|||
|
|||
if (!is.null(map$region)) map$id <- map$region |
|||
|
|||
stopifnot(all(c("x", "y", "id") %in% names(map))) |
|||
|
|||
layer( |
|||
data = data, |
|||
mapping = mapping, |
|||
stat = stat, |
|||
geom = GeomCartogram, |
|||
position = PositionIdentity, |
|||
show.legend = show.legend, |
|||
inherit.aes = inherit.aes, |
|||
params = list( |
|||
map = map, |
|||
na.rm = na.rm, |
|||
... |
|||
) |
|||
) |
|||
} |
|||
|
|||
#' Geom Cartogram |
|||
#' @rdname ggplot2-ggproto |
|||
#' @format NULL |
|||
#' @usage NULL |
|||
#' @export |
|||
GeomCartogram <- ggproto("GeomCartogram", GeomPolygon, |
|||
draw_panel = function(data, panel_scales, coord, map) { |
|||
# Only use matching data and map ids |
|||
common <- intersect(data$map_id, map$id) |
|||
data <- data[data$map_id %in% common, , drop = FALSE] |
|||
map <- map[map$id %in% common, , drop = FALSE] |
|||
|
|||
# Munch, then set up id variable for polygonGrob - |
|||
# must be sequential integers |
|||
coords <- coord_munch(coord, map, panel_scales) |
|||
coords$group <- coords$group %||% coords$id |
|||
grob_id <- match(coords$group, unique(coords$group)) |
|||
|
|||
# Align data with map |
|||
data_rows <- match(coords$id[!duplicated(grob_id)], data$map_id) |
|||
data <- data[data_rows, , drop = FALSE] |
|||
|
|||
grid::polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id, |
|||
gp = gpar( |
|||
col = data$colour, fill = alpha(data$fill, data$alpha), |
|||
lwd = data$size * .pt |
|||
) |
|||
) |
|||
}, |
|||
|
|||
optional_aes = c("x", "y"), |
|||
required_aes = c("map_id") |
|||
|
|||
) |
|||
@ -0,0 +1,41 @@ |
|||
#' Jitter points to avoid overplotting |
|||
#' |
|||
#' Designed primarily for [geom_dumbbell()] to jitter the second point vertically |
|||
#' when both x values are equal. |
|||
#' |
|||
#' @family position adjustments |
|||
#' @param amount Amount of vertical jitter (0..1) |
|||
#' @export |
|||
position_jitter_on_equal <- function(amount = 0) { |
|||
|
|||
ggproto( |
|||
NULL, |
|||
PositionJitterOnEqual, |
|||
amount = amount |
|||
) |
|||
} |
|||
|
|||
#' @rdname ggplot2-ggproto |
|||
#' @format NULL |
|||
#' @usage NULL |
|||
#' @export |
|||
PositionJitterOnEqual <- ggproto( |
|||
"PositionJitterOnEqual", Position, |
|||
required_aes = c("x", "y"), |
|||
|
|||
setup_params = function(self, data) { |
|||
list( |
|||
amount = self$amount |
|||
) |
|||
}, |
|||
|
|||
compute_layer = function(self, data, params, layout) { |
|||
|
|||
data[data$x == data$xend,]$point_y <- |
|||
data[data$x == data$xend,]$point_y + (data[data$x == data$xend,]$point_y * params$amount) |
|||
|
|||
data |
|||
|
|||
} |
|||
|
|||
) |
|||
|
Before Width: | Height: | Size: 32 KiB After Width: | Height: | Size: 32 KiB |
|
Before Width: | Height: | Size: 33 KiB After Width: | Height: | Size: 33 KiB |
|
Before Width: | Height: | Size: 40 KiB After Width: | Height: | Size: 40 KiB |
|
Before Width: | Height: | Size: 235 KiB After Width: | Height: | Size: 235 KiB |
|
Before Width: | Height: | Size: 112 KiB After Width: | Height: | Size: 112 KiB |
|
Before Width: | Height: | Size: 63 KiB After Width: | Height: | Size: 63 KiB |
|
Before Width: | Height: | Size: 63 KiB After Width: | Height: | Size: 63 KiB |
|
Before Width: | Height: | Size: 63 KiB After Width: | Height: | Size: 63 KiB |
|
Before Width: | Height: | Size: 63 KiB After Width: | Height: | Size: 63 KiB |
|
Before Width: | Height: | Size: 102 KiB After Width: | Height: | Size: 102 KiB |
|
Before Width: | Height: | Size: 73 KiB After Width: | Height: | Size: 73 KiB |
|
Before Width: | Height: | Size: 88 KiB After Width: | Height: | Size: 88 KiB |
|
Before Width: | Height: | Size: 84 KiB After Width: | Height: | Size: 85 KiB |
|
Before Width: | Height: | Size: 120 KiB After Width: | Height: | Size: 120 KiB |
|
Before Width: | Height: | Size: 36 KiB After Width: | Height: | Size: 37 KiB |
|
Before Width: | Height: | Size: 49 KiB After Width: | Height: | Size: 48 KiB |
|
Before Width: | Height: | Size: 59 KiB After Width: | Height: | Size: 57 KiB |
|
Before Width: | Height: | Size: 62 KiB After Width: | Height: | Size: 61 KiB |
|
Before Width: | Height: | Size: 54 KiB After Width: | Height: | Size: 53 KiB |
|
Before Width: | Height: | Size: 48 KiB After Width: | Height: | Size: 46 KiB |
|
Before Width: | Height: | Size: 84 KiB After Width: | Height: | Size: 84 KiB |
|
Before Width: | Height: | Size: 84 KiB After Width: | Height: | Size: 84 KiB |
|
Before Width: | Height: | Size: 795 KiB After Width: | Height: | Size: 809 KiB |
|
Before Width: | Height: | Size: 147 KiB After Width: | Height: | Size: 147 KiB |
|
Before Width: | Height: | Size: 135 KiB After Width: | Height: | Size: 136 KiB |
|
Before Width: | Height: | Size: 108 KiB After Width: | Height: | Size: 120 KiB |
|
Before Width: | Height: | Size: 134 KiB After Width: | Height: | Size: 140 KiB |
|
Before Width: | Height: | Size: 138 KiB After Width: | Height: | Size: 147 KiB |
|
Before Width: | Height: | Size: 137 KiB After Width: | Height: | Size: 146 KiB |
|
Before Width: | Height: | Size: 134 KiB After Width: | Height: | Size: 142 KiB |
|
Before Width: | Height: | Size: 131 KiB After Width: | Height: | Size: 137 KiB |
|
Before Width: | Height: | Size: 137 KiB After Width: | Height: | Size: 144 KiB |
|
Before Width: | Height: | Size: 138 KiB After Width: | Height: | Size: 148 KiB |
|
Before Width: | Height: | Size: 112 KiB After Width: | Height: | Size: 109 KiB |
|
Before Width: | Height: | Size: 39 KiB After Width: | Height: | Size: 39 KiB |
|
Before Width: | Height: | Size: 39 KiB After Width: | Height: | Size: 38 KiB |
@ -1,88 +0,0 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/coord_proj.r |
|||
\name{coord_proj} |
|||
\alias{coord_proj} |
|||
\title{Similar to \code{coord_map} but uses the PROJ.4 library/package for projection |
|||
transformation} |
|||
\usage{ |
|||
coord_proj(proj = NULL, inverse = FALSE, degrees = TRUE, |
|||
ellps.default = "sphere", xlim = NULL, ylim = NULL) |
|||
} |
|||
\arguments{ |
|||
\item{proj}{projection definition. If left \code{NULL} will default to |
|||
a Robinson projection} |
|||
|
|||
\item{inverse}{if \code{TRUE} inverse projection is performed (from a |
|||
cartographic projection into lat/long), otherwise projects from |
|||
lat/long into a cartographic projection.} |
|||
|
|||
\item{degrees}{if \code{TRUE} then the lat/long data is assumed to be in |
|||
degrees, otherwise in radians} |
|||
|
|||
\item{ellps.default}{default ellipsoid that will be added if no datum or |
|||
ellipsoid parameter is specified in proj. Older versions of PROJ.4 |
|||
didn't require a datum (and used sphere by default), but 4.5.0 and |
|||
higher always require a datum or an ellipsoid. Set to \code{NA} if no |
|||
datum should be added to proj (e.g. if you specify an ellipsoid |
|||
directly).} |
|||
|
|||
\item{xlim}{manually specify x limits (in degrees of longitude)} |
|||
|
|||
\item{ylim}{manually specify y limits (in degrees of latitude)} |
|||
} |
|||
\description{ |
|||
The representation of a portion of the earth, which is approximately |
|||
spherical, onto a flat 2D plane requires a projection. This is what |
|||
\code{coord_proj} does, using the \code{proj4::project()} function from |
|||
the \code{proj4} package. |
|||
} |
|||
\details{ |
|||
\if{html}{ |
|||
A sample of the output from \code{coord_proj()} using the Winkel-Tripel projection: |
|||
|
|||
\figure{coordproj01.png}{options: width="100\%" alt="Figure: coordproj01.png"} |
|||
} |
|||
|
|||
\if{latex}{ |
|||
A sample of the output from \code{coord_proj()} using the Winkel-Tripel projection: |
|||
`` |
|||
\figure{coordproj01.png}{options: width=10cm} |
|||
} |
|||
} |
|||
\note{ |
|||
It is recommended that you use \code{geom_cartogram} with this coordinate system |
|||
|
|||
When \code{inverse} is \code{FALSE} \code{coord_proj} makes a fairly |
|||
large assumption that the coordinates being transformed are within |
|||
-180:180 (longitude) and -90:90 (latitude). As such, it truncates |
|||
all longitude & latitude input to fit within these ranges. More updates |
|||
to this new \code{coord_} are planned. |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
# World in Winkel-Tripel |
|||
|
|||
# U.S.A. Albers-style |
|||
usa <- world[world$region == "USA",] |
|||
usa <- usa[!(usa$subregion \%in\% c("Alaska", "Hawaii")),] |
|||
|
|||
gg <- ggplot() |
|||
gg <- gg + geom_cartogram(data=usa, map=usa, |
|||
aes(x=long, y=lat, map_id=region)) |
|||
gg <- gg + coord_proj( |
|||
paste0("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96", |
|||
" +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs")) |
|||
gg |
|||
|
|||
# Showcase Greenland (properly) |
|||
greenland <- world[world$region == "Greenland",] |
|||
|
|||
gg <- ggplot() |
|||
gg <- gg + geom_cartogram(data=greenland, map=greenland, |
|||
aes(x=long, y=lat, map_id=region)) |
|||
gg <- gg + coord_proj( |
|||
paste0("+proj=stere +lat_0=90 +lat_ts=70 +lon_0=-45 +k=1 +x_0=0", |
|||
" +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")) |
|||
gg |
|||
} |
|||
} |
|||
@ -1,132 +0,0 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/geom_cartogram.r |
|||
\name{geom_cartogram} |
|||
\alias{geom_cartogram} |
|||
\title{Map polygons layer enabling the display of show statistical information} |
|||
\usage{ |
|||
geom_cartogram(mapping = NULL, data = NULL, stat = "identity", ..., |
|||
map, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) |
|||
} |
|||
\arguments{ |
|||
\item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or |
|||
\code{\link[=aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the |
|||
default), it is combined with the default mapping at the top level of the |
|||
plot. You must supply \code{mapping} if there is no plot mapping.} |
|||
|
|||
\item{data}{The data to be displayed in this layer. There are three |
|||
options: |
|||
|
|||
If \code{NULL}, the default, the data is inherited from the plot |
|||
data as specified in the call to \code{\link[=ggplot]{ggplot()}}. |
|||
|
|||
A \code{data.frame}, or other object, will override the plot |
|||
data. All objects will be fortified to produce a data frame. See |
|||
\code{\link[=fortify]{fortify()}} for which variables will be created. |
|||
|
|||
A \code{function} will be called with a single argument, |
|||
the plot data. The return value must be a \code{data.frame}, and |
|||
will be used as the layer data.} |
|||
|
|||
\item{stat}{The statistical transformation to use on the data for this |
|||
layer, as a string.} |
|||
|
|||
\item{...}{Other arguments passed on to \code{\link[=layer]{layer()}}. These are |
|||
often aesthetics, used to set an aesthetic to a fixed value, like |
|||
\code{colour = "red"} or \code{size = 3}. They may also be parameters |
|||
to the paired geom/stat.} |
|||
|
|||
\item{map}{Data frame that contains the map coordinates. This will |
|||
typically be created using \code{\link{fortify}} on a spatial object. |
|||
It must contain columns \code{x}, \code{long} or \code{longitude}, |
|||
\code{y}, \code{lat} or \code{latitude} and \code{region} or \code{id}.} |
|||
|
|||
\item{na.rm}{If \code{FALSE}, the default, missing values are removed with |
|||
a warning. If \code{TRUE}, missing values are silently removed.} |
|||
|
|||
\item{show.legend}{logical. Should this layer be included in the legends? |
|||
\code{NA}, the default, includes if any aesthetics are mapped. |
|||
\code{FALSE} never includes, and \code{TRUE} always includes. |
|||
It can also be a named logical vector to finely select the aesthetics to |
|||
display.} |
|||
|
|||
\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, |
|||
rather than combining with them. This is most useful for helper functions |
|||
that define both data and aesthetics and shouldn't inherit behaviour from |
|||
the default plot specification, e.g. \code{\link[=borders]{borders()}}.} |
|||
} |
|||
\description{ |
|||
This replicates the old behaviour of \code{geom_map()}, enabling specifying of |
|||
\code{x} and \code{y} aesthetics. |
|||
} |
|||
\section{Aesthetics}{ |
|||
|
|||
\code{geom_cartogram} understands the following aesthetics (required aesthetics are in bold): |
|||
\itemize{ |
|||
\item \code{map_id} |
|||
\item \code{alpha} |
|||
\item \code{colour} |
|||
\item \code{fill} |
|||
\item \code{group} |
|||
\item \code{linetype} |
|||
\item \code{size} |
|||
\item \code{x} |
|||
\item \code{y} |
|||
} |
|||
} |
|||
|
|||
\examples{ |
|||
\dontrun{ |
|||
# When using geom_polygon, you will typically need two data frames: |
|||
# one contains the coordinates of each polygon (positions), and the |
|||
# other the values associated with each polygon (values). An id |
|||
# variable links the two together |
|||
|
|||
ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3")) |
|||
|
|||
values <- data.frame( |
|||
id = ids, |
|||
value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5) |
|||
) |
|||
|
|||
positions <- data.frame( |
|||
id = rep(ids, each = 4), |
|||
x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3, |
|||
0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3), |
|||
y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5, |
|||
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) |
|||
) |
|||
|
|||
ggplot() + |
|||
geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) |
|||
|
|||
ggplot() + |
|||
geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + |
|||
geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) |
|||
|
|||
ggplot() + |
|||
geom_cartogram(aes(x, y, map_id = id), map = positions, data=positions) + |
|||
geom_cartogram(data=values, map=positions, aes(fill = value, map_id=id)) + |
|||
ylim(0, 3) |
|||
|
|||
# Better example |
|||
crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) |
|||
crimesm <- reshape2::melt(crimes, id = 1) |
|||
|
|||
if (require(maps)) { |
|||
|
|||
states_map <- map_data("state") |
|||
|
|||
ggplot() + |
|||
geom_cartogram(aes(long, lat, map_id = region), map = states_map, data=states_map) + |
|||
geom_cartogram(aes(fill = Murder, map_id = state), map=states_map, data=crimes) |
|||
|
|||
last_plot() + coord_map("polyconic") |
|||
|
|||
ggplot() + |
|||
geom_cartogram(aes(long, lat, map_id=region), map = states_map, data=states_map) + |
|||
geom_cartogram(aes(fill = value, map_id=state), map = states_map, data=crimesm) + |
|||
coord_map("polyconic") + |
|||
facet_wrap( ~ variable) |
|||
} |
|||
} |
|||
} |
|||
@ -0,0 +1,16 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/position-jitter-on-equal.R |
|||
\name{position_jitter_on_equal} |
|||
\alias{position_jitter_on_equal} |
|||
\title{Jitter points to avoid overplotting} |
|||
\usage{ |
|||
position_jitter_on_equal(amount = 0) |
|||
} |
|||
\arguments{ |
|||
\item{amount}{Amount of vertical jitter (0..1)} |
|||
} |
|||
\description{ |
|||
Designed primarily for [geom_dumbbell()] to jitter the second point vertically |
|||
when both x values are equal. |
|||
} |
|||
\concept{position adjustments} |
|||