@ -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") |
|
||||
|
|
||||
) |
|
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) |
|
||||
} |
|
||||
} |
|
||||
} |
|