ggmap(ggmap)
ggmap()所属R语言包：ggmap
Plot a ggmap object
绘制一个ggmap对象
译者：生物统计家园网 机器人LoveR
描述----------Description----------
ggmap plots the raster object produced by get_map.
ggmap图的光栅产生的get_map的对象。
用法----------Usage----------
ggmap(ggmap, extent = "panel", base_layer,
maprange = FALSE, legend = "right", padding = 0.02,
darken = c(0, "black"), ...)
参数----------Arguments----------
参数：ggmap
an object of class ggmap (from function get_map)
一个对象的类ggmap（从功能get_map）
参数：extent
how much of the plot should the map take up? 'normal', 'panel', or 'device' (default)
多少的图的图吗？ “正常”，“面板”，或“装置”（默认）
参数：base_layer
a ggplot(aes(...), ...) call; see examples
中一个ggplot（AES（...），...）调用，看到的例子
参数：maprange
logical for use with base_layer; should the map define the x and y limits?
逻辑用于与base_layer;应在图定义的x和y的限制？
参数：legend
'left', 'right' (default), 'bottom', 'top', 'bottomleft', 'bottomright', 'topleft', 'topright', 'none' (used with extent = 'device')
左，右（默认），底部，顶，bottomleft，bottomright“，”左上“，”topright，没有（使用程度=设备）
参数：padding
distance from legend to corner of the plot (used with legend, formerly b)
从传说到角落里的图（使用传说，以前b的距离）
参数：darken
vector of the form c(number, color), where number is in [0, 1] and color is a character string indicating the color of the darken. 0 indicates no darkening, 1 indicates a black-out.
向量的形式为c（号码，颜色），其中number为[0，1]和颜色是一个字符串，它表示的颜色的变暗。 0表示没有变黑，1表示一个黑。
参数：...
...
...
值----------Value----------
a ggplot object
一个ggplot对象
（作者）----------Author(s)----------
David Kahle <a href="mailto:david.kahle@gmail.com">david.kahle@gmail.com</a>
参见----------See Also----------
get_map, qmap
get_map，qmap
实例----------Examples----------
## Not run: [＃不运行：]
## extents and legends[＃范围和传说]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
hdf <- get_map()
ggmap(hdf, extent = 'normal')
ggmap(hdf) # extent = 'panel', note qmap defaults to extent = 'device'[程度=“面板”，注意qmap默认程度=设备]
ggmap(hdf, extent = 'device')
require(MASS)
mu <- c(-95.3632715, 29.7632836); nDataSets <- sample(4:10,1)
chkpts <- NULL
for(k in 1:nDataSets){
a <- rnorm(2); b <- rnorm(2); si <- 1/3000 * (outer(a,a) + outer(b,b))
chkpts <- rbind(chkpts, cbind(mvrnorm(rpois(1,50), jitter(mu, .01), si), k))
}
chkpts <- data.frame(chkpts)
names(chkpts) <- c('lon', 'lat','class')
chkpts$class <- factor(chkpts$class)
qplot(lon, lat, data = chkpts, colour = class)
ggmap(hdf, extent = 'normal') +
geom_point(aes(x = lon, y = lat, colour = class), data = chkpts, alpha = .5)
ggmap(hdf) +
geom_point(aes(x = lon, y = lat, colour = class), data = chkpts, alpha = .5)
ggmap(hdf, extent = 'device') +
geom_point(aes(x = lon, y = lat, colour = class), data = chkpts, alpha = .5)
theme_set(theme_bw())
ggmap(hdf, extent = 'device') +
geom_point(aes(x = lon, y = lat, colour = class), data = chkpts, alpha = .5)
ggmap(hdf, extent = 'device', legend = 'topleft') +
geom_point(aes(x = lon, y = lat, colour = class), data = chkpts, alpha = .5)
## maprange[＃maprange]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
hdf <- get_map()
mu <- c(-95.3632715, 29.7632836)
points <- data.frame(mvrnorm(1000, mu = mu, diag(c(.1, .1))))
names(points) <- c('lon', 'lat')
points$class <- sample(c('a','b'), 1000, replace = TRUE)
ggmap(hdf) + geom_point(data = points) # maprange built into extent = panel, device[maprange =面板，设备内置的程度]
ggmap(hdf) + geom_point(aes(colour = class), data = points)
ggmap(hdf, extent = 'normal') + geom_point(data = points)
# note that the following is not the same as extent = panel[请注意，以下是不一样的程度=面板]
ggmap(hdf, extent = 'normal', maprange = TRUE) + geom_point(data = points)
# and if you need your data to run off on a extent = device (legend included)[如果您需要您的数据运行程度=设备（包括传说）]
ggmap(hdf, extent = 'normal', maprange = TRUE) +
geom_point(aes(colour = class), data = points) +
theme_nothing() + opts(legend.position = 'right')
## cool examples[＃酷例子]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
# contour overlay[重叠等高线]
ggmap(get_map(maptype = 'satellite'), extent = 'device') +
stat_density2d(aes(x = lon, y = lat, colour = class), data = chkpts, bins = 5)
# adding additional content[增加额外的内容]
library(grid)
baylor <- get_map('baylor university', zoom = 15, maptype = 'satellite')
ggmap(baylor)
# use gglocator to find lon/lat's of interest[使用gglocator找到经度/纬度的利益]
(clicks <- clicks <- gglocator(2) )
expand.grid(lon = clicks$lon, lat = clicks$lat)
ggmap(baylor) + theme_bw() +
annotate('rect', xmin=-97.11920, ymin=31.5439, xmax=-97.101, ymax=31.5452,
fill = I('black'), alpha = I(3/4)) +
annotate('segment', x=-97.110, xend=-97.11920, y=31.5450, yend=31.5482,
colour=I('red'), arrow = arrow(length=unit(0.3,"cm")), size = 1.5) +
annotate('text', x=-97.110, y=31.5445, label = 'Department of Statistical Science',
colour = I('red'), size = 6) +
labs(x = 'Longitude', y = 'Latitude') + opts(title = 'Baylor University')
baylor <- get_map('baylor university', zoom = 16, maptype = 'satellite')
ggmap(baylor, extent = 'device') +
annotate('rect', xmin=-97.1164, ymin=31.5441, xmax=-97.1087, ymax=31.5449,
fill = I('black'), alpha = I(3/4)) +
annotate('segment', x=-97.1125, xend=-97.11920, y=31.5449, yend=31.5482,
colour=I('red'), arrow = arrow(length=unit(0.4,"cm")), size = 1.5) +
annotate('text', x=-97.1125, y=31.5445, label = 'Department of Statistical Science',
colour = I('red'), size = 6)
# a shapefile like layer[这样的shapefile层]
data(zips)
ggmap(get_map(maptype = 'satellite', zoom = 8), extent = 'device') +
geom_polygon(aes(x = lon, y = lat, group = plotOrder),
data = zips, colour = NA, fill = 'red', alpha = .2) +
geom_path(aes(x = lon, y = lat, group = plotOrder),
data = zips, colour = 'white', alpha = .4, size = .4)
library(plyr)
zipsLabels <- ddply(zips, .(zip), function(df){
df[1,c("area", "perimeter", "zip", "lonCent", "latCent")]
})
ggmap(get_map(maptype = 'satellite', zoom = 9),
extent = 'device', legend = 'none', darken = .5) +
geom_text(aes(x = lonCent, y = latCent, label = zip, size = area),
data = zipsLabels, colour = I('red')) +
scale_size(range = c(1.5,6))
## crime data example[＃犯罪数据的例子]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
# only violent crimes[只有暴力犯罪]
violent_crimes <- subset(crime,
offense != 'auto theft' &
offense != 'theft' &
offense != 'burglary'
)
# rank violent crimes[排名暴力犯罪]
violent_crimes$offense <-
factor(violent_crimes$offense,
levels = c('robbery', 'aggravated assault',
'rape', 'murder')
)
# restrict to downtown[限制到市中心]
violent_crimes <- subset(violent_crimes,
-95.39681 <= lon & lon <= -95.34188 &
29.73631 <= lat & lat <= 29.78400
)
# get map and bounding box[获得图和边框]
theme_set(theme_bw(16))
HoustonMap <- qmap('houston', zoom = 14, color = 'bw',
extent = 'device', legend = 'topleft')
# the bubble chart[在气泡图]
library(grid)
HoustonMap +
geom_point(aes(x = lon, y = lat, colour = offense, size = offense), data = violent_crimes) +
scale_colour_discrete('Offense', labels = c('Robery','Aggravated Assault','Rape','Murder')) +
scale_size_discrete('Offense', labels = c('Robery','Aggravated Assault','Rape','Murder'),
range = c(1.75,6)) +
guides(size = guide_legend(override.aes = list(size = 6))) +
opts(
legend.key.size = unit(1.8,'lines'),
legend.title = theme_text(size = 16, face = 'bold'),
legend.text = theme_text(size = 14)
) +
labs(colour = 'Offense', size = 'Offense')
# a contour plot[的等高线图]
HoustonMap +
stat_density2d(aes(x = lon, y = lat, colour = offense),
size = 3, bins = 2, alpha = 3/4, data = violent_crimes) +
scale_colour_discrete('Offense', labels = c('Robery','Aggravated Assault','Rape','Murder')) +
opts(
legend.text = theme_text(size = 15, vjust = .5),
legend.title = theme_text(size = 15,face='bold'),
legend.key.size = unit(1.8,'lines')
)
# a filled contour plot...[填充的等高线图...]
HoustonMap +
stat_bin2d(aes(x = lon, y = lat, colour = offense, fill = offense),
size = .5, bins = 30, alpha = 2/4, data = violent_crimes) +
scale_colour_discrete('Offense',
labels = c('Robery','Aggravated Assault','Rape','Murder'),
guide = FALSE) +
scale_fill_discrete('Offense', labels = c('Robery','Aggravated Assault','Rape','Murder')) +
opts(
legend.text = theme_text(size = 15, vjust = .5),
legend.title = theme_text(size = 15,face='bold'),
legend.key.size = unit(1.8,'lines')
)
# ... with hexagonal bins[...六角箱]
HoustonMap +
stat_binhex(aes(x = lon, y = lat, colour = offense, fill = offense),
size = .5, binwidth = c(.00225,.00225), alpha = 2/4, data = violent_crimes) +
scale_colour_discrete('Offense',
labels = c('Robery','Aggravated Assault','Rape','Murder'),
guide = FALSE) +
scale_fill_discrete('Offense', labels = c('Robery','Aggravated Assault','Rape','Murder')) +
opts(
legend.text = theme_text(size = 15, vjust = .5),
legend.title = theme_text(size = 15,face='bold'),
legend.key.size = unit(1.8,'lines')
)
# changing gears (get a color map)[换档（得到一个彩色图）]
houston <- get_map('houston', zoom = 14)
HoustonMap <- ggmap(houston, extent = 'device', legend = 'topleft')
# a filled contour plot...[填充的等高线图...]
HoustonMap +
stat_density2d(aes(x = lon, y = lat, fill = ..level.., alpha = ..level..),
size = 2, bins = 4, data = violent_crimes, geom = 'polygon') +
scale_fill_gradient('Violent\nCrime\nDensity') +
scale_alpha(range = c(.4, .75), guide = FALSE) +
guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10))
# ... with an insert[...具有插入件]
overlay <- stat_density2d(aes(x = lon, y = lat, fill = ..level.., alpha = ..level..),
bins = 4, geom = 'polygon', data = violent_crimes)
HoustonMap +
stat_density2d(aes(x = lon, y = lat, fill = ..level.., alpha = ..level..),
bins = 4, geom = 'polygon', data = violent_crimes) +
scale_fill_gradient('Violent\nCrime\nDensity') +
scale_alpha(range = c(.4, .75), guide = FALSE) +
guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10)) +
inset(
grob = ggplotGrob(ggplot() + overlay +
scale_fill_gradient('Violent\nCrime\nDensity') +
scale_alpha(range = c(.4, .75), guide = FALSE) +
theme_inset()
),
xmin = attr(houston,'bb')$ll.lon +
(7/10) * (attr(houston,'bb')$ur.lon - attr(houston,'bb')$ll.lon),
xmax = Inf,
ymin = -Inf,
ymax = attr(houston,'bb')$ll.lat +
(3/10) * (attr(houston,'bb')$ur.lat - attr(houston,'bb')$ll.lat)
)
## more examples[＃更多的例子]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
# you can layer anything on top of the maps (even meaningless stuff)[你的图（甚至是毫无意义的东西之上的层上的任何东西）]
df <- data.frame(
lon = rep(seq(-95.39, -95.35, length.out = 8), each = 20),
lat = sapply(
rep(seq(29.74, 29.78, length.out = 8), each = 20),
function(x) rnorm(1, x, .002)
),
class = rep(letters[1:8], each = 20)
)
qplot(lon, lat, data = df, geom = 'boxplot', fill = class)
HoustonMap +
geom_boxplot(aes(x = lon, y = lat, fill = class), data = df)
## the base_layer argument - faceting[＃base_layer参数 - 小面]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
df <- data.frame(
x = rnorm(1000, -95.36258, .2),
y = rnorm(1000, 29.76196, .2)
)
# no apparent change because ggmap sets maprange = TRUE with extent = 'panel'[没有明显的变化，因为ggmap和套maprange = TRUE程度=“面板”]
ggmap(get_map(), base_layer = ggplot(aes(x = x, y = y), data = df)) +
geom_point(colour = 'red')
# ... but there is a difference[...但是有差别]
ggmap(get_map(), base_layer = ggplot(aes(x = x, y = y), data = df), extent = 'normal') +
geom_point(colour = 'red')
# maprange can fix it (so can extent = 'panel')[maprange可以修复它（所以程度=“面板”）]
ggmap(get_map(), maprange = TRUE, extent = 'normal',
base_layer = ggplot(aes(x = x, y = y), data = df)) +
geom_point(colour = 'red')
# base_layer makes faceting possible[base_layer使刻面可能]
df <- data.frame(
x = rnorm(10*100, -95.36258, .075),
y = rnorm(10*100, 29.76196, .075),
year = rep(paste('year',format(1:10)), each = 100)
)
ggmap(get_map(), base_layer = ggplot(aes(x = x, y = y), data = df)) +
geom_point() + facet_wrap(~ year)
ggmap(get_map(), base_layer = ggplot(aes(x = x, y = y), data = df), extent = 'device') +
geom_point() + facet_wrap(~ year)
## neat faceting examples[＃整洁的小面的例子]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
# simulated example[模拟例子]
df <- data.frame(
x = rnorm(10*100, -95.36258, .05),
y = rnorm(10*100, 29.76196, .05),
year = rep(paste('year',format(1:10)), each = 100)
)
for(k in 0:9){
df$x[1:100 + 100*k] <- df$x[1:100 + 100*k] + sqrt(.05)*cos(2*pi*k/10)
df$y[1:100 + 100*k] <- df$y[1:100 + 100*k] + sqrt(.05)*sin(2*pi*k/10)
}
options('device')$device(width = 10.93, height = 7.47)
ggmap(get_map(),
base_layer = ggplot(aes(x = x, y = y), data = df)) +
stat_density2d(aes(fill = ..level.., alpha = ..level..),
bins = 4, geom = 'polygon') +
scale_fill_gradient2(low = 'white', mid = 'orange', high = 'red', midpoint = 10) +
scale_alpha(range = c(.2, .75), guide = FALSE) +
facet_wrap(~ year)
# crime example by month[例如每月犯罪]
levels(violent_crimes$month) <- paste(
toupper(substr(levels(violent_crimes$month),1,1)),
substr(levels(violent_crimes$month),2,20), sep = ''
)
houston <- get_map(location = 'houston', zoom = 14, source = 'osm', color = 'bw')
HoustonMap <- ggmap(houston,
base_layer = ggplot(aes(x = lon, y = lat), data = violent_crimes)
)
HoustonMap +
stat_density2d(aes(x = lon, y = lat, fill = ..level.., alpha = ..level..),
bins = I(5), geom = 'polygon', data = violent_crimes) +
scale_fill_gradient2('Violent\nCrime\nDensity',
low = 'white', mid = 'orange', high = 'red', midpoint = 500) +
labs(x = 'Longitude', y = 'Latitude') + facet_wrap(~ month) +
scale_alpha(range = c(.2, .55), guide = FALSE) +
opts(title = 'Violent Crime Contour Map of Downtown Houston by Month') +
guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10))
## distances example[＃距离，例如]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
origin <- 'marrs mclean science, baylor university'
gc_origin <- geocode(origin)
destinations <- data.frame(
place = c("Administration", "Baseball Stadium", "Basketball Arena",
"Salvation Army", "HEB Grocery", "Cafe Cappuccino", "Ninfa's Mexican",
"Dr Pepper Museum", "Buzzard Billy's", "Mayborn Museum","Flea Market"
),
address = c("pat neff hall, baylor university", "baylor ballpark",
"ferrell center", "1225 interstate 35 s, waco, tx",
"1102 speight avenue, waco, tx", "100 n 6th st # 100, waco, tx",[100，德克萨斯州Waco“]
"220 south 3rd street, waco, tx", "300 south 5th street, waco, tx",
"100 north jack kultgen expressway, waco, tx",
"1300 south university parks drive, waco, tx",
"2112 state loop 491, waco, tx"
),
stringsAsFactors = FALSE
)
gc_dests <- geocode(destinations$address)
(dist <- mapdist(origin, destinations$address, mode = 'bicycling'))
dist <- within(dist, {
place = destinations$place
fromlon = gc_origin$lon
fromlat = gc_origin$lat
tolon = gc_dests$lon
tolat = gc_dests$lat
})
dist$minutes <- cut(dist$minutes, c(0,3,5,7,10,Inf),
labels = c('0-3','3-5', '5-7', '7-10', '10+'))
library(scales)
qmap('baylor university', zoom = 14, legend = 'bottomright',
base_layer = ggplot(aes(x = lon, y = lat), data = gc_origin)) +
geom_rect(aes(
x = tolon, y = tolat,
xmin = tolon-.00028*nchar(place), xmax = tolon+.00028*nchar(place),
ymin = tolat-.0005, ymax = tolat+.0005, fill = minutes, colour = 'black'
), alpha = .7, data = dist) +
geom_text(aes(x = tolon, y = tolat, label = place, colour = 'white'), size = 3, data = dist) +
geom_rect(aes(
xmin = lon-.004, xmax = lon+.004,
ymin = lat-.00075, ymax = lat+.00075, colour = 'black'
), alpha = .5, fill = I('green'), data = gc_origin) +
geom_text(aes(x = lon, y = lat, label = 'My Office', colour = 'black'), size = 5) +
scale_fill_manual('Minutes\nAway\nby Bike',
values = colorRampPalette(c(muted('green'), 'blue', 'red'))(5)) +
scale_colour_identity(guide = 'none') +
opts(
legend.direction = 'horizontal',
legend.key.size = unit(2, 'lines')
) +
guides(
fill = guide_legend(
title.theme = theme_text(size = 16, face = 'bold', colour = 'black'),
label.theme = theme_text(size = 14, colour = 'black'),
label.position = 'bottom',
override.aes = list(alpha = 1)
)
)
## darken argument[＃变暗的说法]
##################################################[＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃]
ggmap(get_map())
ggmap(get_map(), darken = .5)
ggmap(get_map(), darken = c(.5,'white'))
ggmap(get_map(), darken = c(.5,'red')) # why?[为什么呢？]
## End(Not run)[＃（不执行）]
转载请注明:出自 生物统计家园网(http://www.biostatistic.net)。
注：
注1：为了方便大家学习，本文档为生物统计家园网机器人LoveR翻译而成，仅供个人R语言学习参考使用，生物统计家园保留版权。
注2：由于是机器人自动翻译，难免有不准确之处，使用时仔细对照中、英文内容进行反复理解，可以帮助R语言的学习。
注3：如遇到不准确之处，请在本贴的后面进行回帖，我们会逐渐进行修订。
|
发表于 2012-9-18 20:34:37
