回复 第6楼 的 jiangshq:这个代码是初期写的有些问题,其实坐标变换和代码都有点问题后来有修正
之前发的那个版本dubigmap中缺少一个size赋值:
getdumap函数:是获取百度地图,并且利用谷歌的坐标变换(目前坐标已经较准确了),将其坐标关系映射到百度地图上,等价于原来那个获取谷歌地图的函数,不过目前有用的只有center(中心坐标) , zoom(放大倍数),size(图形尺寸)这三个参数,其他的还没添加。
dubigmap函数:是将小地图500*500拼接成任意大小分辨率的地图。现在只写了拼接算法,可拼接数量之只能是奇数级的。调用getdumap获取的坐标映射是准确的,所以,可以截除较大的图后,利用经纬坐标切割成自己想要的。
三个参数:center(地图中心);zoom(放大倍数);lgsize(地图尺寸)
lgsize=1时,500*500,一张图
lgsize=2时,1500*1500,9张图
lgsize=3时,2500*2500,25张图
。。。。。。。
目前尚加入自动预防读图错误机制。下载过程中一张图错误都会导致函数崩溃。[s:12](原计划加上,不过后来在研究别的就忘了)
最新的dubigmap、getdumap代码如下:
<br />
dubigmap<-function(center=c(116.403874,39.914888),zoom=15,lgsize=2){<br />
#缺了这句<br />
size<-c(500,500)<br />
des<-c(2.3313056/2^zoom * size[1], 1.86832416/2^zoom * size[2])<br />
#map<-vector("list",(lgsize*2-1)^2)<br />
#map<-getdumap(center=c(116.403874,39.914888),zoom,size)<br />
for(i in 1:(lgsize*2-1)){<br />
for(j in 1:(lgsize*2-1)){<br />
maptmp<-getdumap(center +c(des[1],des[2])*c(i-lgsize,j-lgsize),zoom,size)<br />
if(j==1){<br />
if(i==1){<br />
xmin <- attr(maptmp, "bb")$ll.lon<br />
ymin <- attr(maptmp, "bb")$ll.lat<br />
}<br />
maplat<-maptmp<br />
}else{<br />
maplat<-cbind(maptmp,maplat)<br />
}<br />
}<br />
if(i==1){<br />
map<-maplat<br />
}else{<br />
map<-rbind(map,maplat)<br />
}<br />
}<br />
xmax <- attr(maptmp, "bb")$ur.lon<br />
ymax <- attr(maptmp, "bb")$ur.lat<br />
class(map) <- c("ggmap", "raster")<br />
attr(map, "bb") <- data.frame(ll.lat = ymin, ll.lon = xmin,ur.lat = ymax, ur.lon = xmax)<br />
map</p>
<p> #map2<-getdumap(center=c(116.403874,39.914888)+c(des[1],0),zoom,size)<br />
}<br />
</p>
最新后的getdumap函数如下:
<br />
getdumap<-function (center = c(lon = -95.3632715, lat = 29.7632836),<br />
zoom = 10,<br />
size = c(640, 640),<br />
scale = 2,<br />
format = c("png8", "gif", "jpg", "jpg-baseline", "png32"),<br />
maptype = c("terrain","satellite", "roadmap", "hybrid"),<br />
language = "en-EN", region, markers, path, visible, style,<br />
sensor = FALSE, messaging = FALSE,<br />
urlonly = FALSE, filename = "ggmapTemp",<br />
color = c("color", "bw"), ...)<br />
{<br />
#读取字符串<br />
args <- as.list(match.call(expand.dots = TRUE)[-1])<br />
argsgiven <- names(args)<br />
#中心判别<br />
if ("center" %in% argsgiven) {<br />
if (!((is.numeric(center) && length(center) == 2) ||<br />
(is.character(center) && length(center) == 1))) {<br />
stop("center of map misspecified, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
if (all(is.numeric(center))) {<br />
lon <- center[1]<br />
lat <- center[2]<br />
if (lon < -180 || lon > 180) {<br />
stop("longitude of center must be between -180 and 180 degrees.",<br />
" note ggmap uses lon/lat, not lat/lon.", call. = F)<br />
}<br />
if (lat < -90 || lat > 90) {<br />
stop("latitude of center must be between -90 and 90 degrees.",<br />
" note ggmap uses lon/lat, not lat/lon.", call. = F)<br />
}<br />
}<br />
}<br />
#放大倍数判别<br />
if ("zoom" %in% argsgiven) {<br />
if (!(is.numeric(zoom) && zoom == round(zoom) && zoom ><br />
0)) {<br />
stop("zoom must be a whole number between 1 and 21",<br />
call. = F)<br />
}<br />
}<br />
#图片尺寸<br />
if ("size" %in% argsgiven) {<br />
stopifnot(all(is.numeric(size)) && all(size == round(size)) &&<br />
all(size > 0))<br />
}<br />
#图片精细度<br />
if ("scale" %in% argsgiven) {<br />
stopifnot(scale %in% c(1, 2, 4))<br />
}<br />
#标注<br />
if ("markers" %in% argsgiven) {<br />
markers_stop <- TRUE<br />
if (is.data.frame(markers) && all(apply(markers[, 1:2],<br />
2, is.numeric)))<br />
markers_stop <- FALSE<br />
if (class(markers) == "list" && all(sapply(markers, function(elem) {<br />
is.data.frame(elem) && all(apply(elem[, 1:2], 2,<br />
is.numeric))<br />
})))<br />
markers_stop <- FALSE<br />
if (is.character(markers) && length(markers) == 1)<br />
markers_stop <- FALSE<br />
if (markers_stop)<br />
stop("improper marker specification, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
#折现标注<br />
if ("path" %in% argsgiven) {<br />
path_stop <- TRUE<br />
if (is.data.frame(path) && all(apply(path[, 1:2], 2,<br />
is.numeric)))<br />
path_stop <- FALSE<br />
if (class(path) == "list" && all(sapply(path, function(elem) {<br />
is.data.frame(elem) && all(apply(elem[, 1:2], 2,<br />
is.numeric))<br />
})))<br />
path_stop <- FALSE<br />
if (is.character(path) && length(path) == 1)<br />
path_stop <- FALSE<br />
if (path_stop)<br />
stop("improper path specification, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
#出现此标识推出<br />
if ("visible" %in% argsgiven) {<br />
message("visible argument untested.")<br />
visible_stop <- TRUE<br />
if (is.data.frame(visible) && all(apply(visible[, 1:2],<br />
2, is.numeric)))<br />
visible_stop <- FALSE<br />
if (is.character(visible))<br />
visible_stop <- FALSE<br />
if (visible_stop)<br />
stop("improper visible specification, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
#地图类型<br />
if ("style" %in% argsgiven) {<br />
message("style argument untested.")<br />
style_stop <- TRUE<br />
if (is.character(style) && length(style) == 1)<br />
style_stop <- FALSE<br />
if (style_stop)<br />
stop("improper style specification, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
if ("sensor" %in% argsgiven)<br />
stopifnot(is.logical(sensor))<br />
if ("messaging" %in% argsgiven)<br />
stopifnot(is.logical(messaging))<br />
if ("urlonly" %in% argsgiven)<br />
stopifnot(is.logical(urlonly))<br />
if ("filename" %in% argsgiven) {<br />
filename_stop <- TRUE<br />
if (is.character(filename) && length(filename) == 1)<br />
filename_stop <- FALSE<br />
if (filename_stop)<br />
stop("improper filename specification, see ?get_googlemap.",<br />
call. = F)<br />
}<br />
if ("checkargs" %in% argsgiven) {<br />
.Deprecated(msg = "checkargs argument deprecated, args are always checked after v2.1.")<br />
}<br />
format <- match.arg(format)<br />
if (format != "png8")<br />
stop("currently only the png format is supported.", call. = F)<br />
maptype <- match.arg(maptype)<br />
color <- match.arg(color)<br />
if (!missing(markers) && class(markers) == "list")<br />
markers <- plyr:::list_to_dataframe(markers)<br />
if (!missing(path) && is.data.frame(path))<br />
path <- list(path)<br />
#修改1:开始连接变量<br />
base_url <- "http://api.map.baidu.com/staticimage?"<br />
center_url <- if (all(is.numeric(center))) {<br />
center <- round(center, digits = 6)<br />
lon <- center[1]<br />
lat <- center[2]<br />
#修改4<br />
paste("center=", paste(lon , lat, sep = ","), sep = "")<br />
}<br />
else {<br />
centerPlus <- gsub(" ", "+", center)<br />
paste("center=", centerPlus, sep = "")<br />
}<br />
zoom_url <- paste("zoom=", zoom, sep = "")<br />
#修改2,<br />
#修改为百度长短格式,高度增加20%,用来删除百度标签<br />
size_url <- paste(paste("height=",size[2]*1.2,sep=""),paste("width=",size[1],sep=""),sep="&")<br />
scale_url <- if (!missing(scale)) {<br />
paste("scale=", scale)<br />
}<br />
else {<br />
""<br />
}<br />
format_url <- if (!missing(format) && format != "png8") {<br />
paste("format=", format)<br />
}<br />
else {<br />
""<br />
}<br />
maptype_url <- paste("maptype=", maptype, sep = "")<br />
language_url <- if (!missing(language)) {<br />
paste("language=", language)<br />
}<br />
else {<br />
""<br />
}<br />
region_url <- if (!missing(region)) {<br />
paste("region=", region)<br />
}<br />
else {<br />
""<br />
}<br />
markers_url <- if (!missing(markers)) {<br />
if (is.data.frame(markers)) {<br />
paste("markers=", paste(apply(markers, 1, function(v) paste(rev(round(v,6)), collapse = ",")), collapse = "|"), sep = "")<br />
}<br />
else {<br />
paste("markers=", markers, sep = "")<br />
}<br />
}<br />
else {<br />
""<br />
}<br />
path_url <- if (!missing(path)) {<br />
if (is.list(path)) {<br />
ps <- sapply(path, function(one_path) {<br />
paste("path=", paste(apply(one_path, 1, function(v) paste(rev(round(v,6)), collapse = ",")), collapse = "|"), sep = "")<br />
})<br />
paste(ps, collapse = "&")<br />
}<br />
else {<br />
paste("path=", path, sep = "")<br />
}<br />
}<br />
else {<br />
""<br />
}<br />
visible_url <- if (!missing(visible)) {<br />
if (is.data.frame(visible)) {<br />
paste("visible=", paste(apply(visible, 1, function(v) paste(rev(round(v,6)), collapse = ",")), collapse = "|"), sep = "")<br />
}<br />
else {<br />
paste("visible=", paste(visible, collapse = "|"),<br />
sep = "")<br />
}<br />
}<br />
else {<br />
""<br />
}<br />
style_url <- if (!missing(style)) {<br />
paste("style=", style)<br />
}<br />
else {<br />
""<br />
}<br />
sensor_url <- paste("sensor=", tolower(as.character(sensor)),<br />
sep = "")<br />
#修改3<br />
#post_url <- paste(center_url, zoom_url, size_url,sep = "&")</p>
<p> post_url <- paste(center_url, zoom_url, size_url, scale_url,<br />
format_url, language_url, region_url, markers_url,<br />
path_url, visible_url, style_url, sep = "&")<br />
url <- paste(base_url, post_url, sep = "")<br />
url <- gsub("[&]+", "&", url)<br />
if (substr(url, nchar(url), nchar(url)) == "&") {<br />
url <- substr(url, 1, nchar(url) - 1)<br />
}<br />
url <- URLencode(url)<br />
if (urlonly)<br />
return(url)<br />
if (nchar(url) > 2048)<br />
stop("max url length is 2048 characters.", call. = FALSE)<br />
destfile <- if (format %in% c("png8", "png32")) {<br />
paste(filename, "png", sep = ".")<br />
}<br />
else if (format %in% c("jpg", "jpg-baseline")) {<br />
paste(filename, "jpg", sep = ".")<br />
}<br />
else {<br />
paste(filename, "gif", sep = ".")<br />
}<br />
download.file(url, destfile = destfile, quiet = !messaging,<br />
mode = "wb")<br />
message(paste0("Map from URL : ", url))<br />
message("Google Maps API Terms of Service : http://developers.google.com/maps/terms")<br />
map <- readPNG(destfile)<br />
#取出来的图切除上下各10%<br />
#map<-map[,(0.1*size[1]):size[1]]<br />
map<-map[(0.1*size[2]+1):(size[2]*1.1),,]<br />
if (color == "color") {<br />
map <- apply(map, 2, rgb)<br />
}<br />
else if (color == "bw") {<br />
mapd <- dim(map)<br />
map <- gray(0.3 * map[, , 1] + 0.59 * map[, , 2] + 0.11 *<br />
map[, , 3])<br />
dim(map) <- mapd[1:2]<br />
}<br />
class(map) <- c("ggmap", "raster")<br />
if (is.character(center))<br />
center <- as.numeric(geocode(center))<br />
#修改六,发现谷妹度嫂的坐标变换关系不一致<br />
#我采集了一些点分析百度坐标的变换关系测试,发现度嫂的坐标变换极大可能是平面变换。。。。<br />
#ll <- center-c(2.3313056/2^zoom * size[2]/2,1.86832416/2^zoom * size[1]/2)<br />
#ur <- center+c(2.3313056/2^zoom * size[2]/2,1.86832416/2^zoom * size[1]/2)<br />
ll <- XY2LatLon(list(lat = center[2],lon = center[1] , zoom = zoom),<br />
#注意以下需要先long后lat<br />
-size[1]*5.05/6, -size[2]*5.05/6)<br />
ur <- XY2LatLon(list(lat = center[2],lon = center[1], zoom = zoom),<br />
size[1]*5/6, size[2]*5.07/6)<br />
attr(map, "bb") <- data.frame(ll.lat = ll[1], ll.lon = ll[2],<br />
ur.lat = ur[1], ur.lon = ur[2])<br />
#修改七<br />
map<-t(map)<br />
dim(map)<-c(size[2],size[1])<br />
map<br />
}</p>
<p>
</p>
我也正在学习,资料主要是看RgoogleMaps、ggmap相关函数文档,以及自己试着解读他们内部的函数构造。
目前业余时间正在学习sp包文档,尝试制作GIS地图蒙版