### OUTPUT: routines to create the new source files
map.export <- function(ww, outfile, type="bin", ...) {
if (type=="bin") map.export.bin(ww,outfile,...)
else map.export.ascii(ww,outfile,...)
}
map.export.ascii <- function(ww, outfile, scale=pi/180, ndec=10) {
nline <- dim(ww$line)[1]
ngon <- dim(ww$gon)[1]
# line data
lfile <- paste(outfile,'.line',sep='')
lx <- round(ww$x * scale,ndec)
ly <- round(ww$y * scale,ndec)
system(paste('rm -f',lfile))
if (is.null(ww$line$left)) ww <- map.LR(ww)
for(i in 1:nline){
write(paste(ww$line$left[i],ww$line$right[i]),file=lfile,append=TRUE)
write(rbind('',format(
rbind(lx[ww$line$begin[i]:ww$line$end[i]],
ly[ww$line$begin[i]:ww$line$end[i]]),
nsmall=ndec)),
file=lfile,append=TRUE,ncolumns=3)
write('EOR', file=lfile,append=TRUE)
}
# linestat
lsfile <- paste(outfile,'.linestats',sep='')
system(paste('rm -f',lsfile))
write(paste(nline,max(ww$line$length)),file=lsfile,append=TRUE)
# gon
ind <- 1:ngon
gfile <- paste(outfile,'.gon',sep='')
system(paste('rm -f',gfile))
for(i in 1:ngon){
### for exact match: 1 blank before the numbers
write(paste('',ww$gondata[ww$gon$begin[i]:ww$gon$end[i]]),
file=gfile,append=TRUE,ncolumns=1)
write('EOR', file=gfile,append=TRUE)
}
# gonstat
gsfile <- paste(outfile,'.gonstats',sep='')
system(paste('rm -f',gsfile))
write(paste(ngon,max(ww$gon$length)),file=gsfile,append=TRUE)
## names
nfile <- paste(outfile,'.name',sep='')
system(paste('rm -f',nfile))
write.table(cbind(ww$names,seq_along(ww$names)),sep='\t',
quote=FALSE,col.names=FALSE,row.names=FALSE,
file=nfile)
}
##########################################
# write directly to 'maps' binary format #
##########################################
# the original C code is much more efficient, but this routine runs
# without compilation and without first writing to ASCII
### R can not write "unsigned"!
### So we have to assume some limitations:
### line length must be < 2^15 rather than < 2^16
### (OK for 1:10 world map: just over 2^14 = 16384, worldHires has ~19000 )
### file size must be < 2^31 (OK)
### UNFORTUNATELY: the original C code writes the struct directly -> compiler-dependent padding...
map.export.bin <- function(ww, outfile, scale=pi/180){
nline <- dim(ww$line)[1]
ngon <- dim(ww$gon)[1]
type_settings <- .C("mapsizes",result=integer(4))$result
names(type_settings)=c("char","short","int","float")
# cat("platform:",type_settings,"\n")
type_settings <- as.list(type_settings)
#############
# LINE DATA #
#############
lfile <- paste(outfile,'.L',sep='')
system(paste('rm -f',lfile))
lx <- ww$x *scale
ly <- ww$y *scale
# SW and NE limits of every line element:
line.limits <- data.frame(
W = vapply(1:nline,function(ll) min(lx[ww$line$begin[ll]:ww$line$end[ll]]),FUN.VALUE=1),
S = vapply(1:nline,function(ll) min(ly[ww$line$begin[ll]:ww$line$end[ll]]),FUN.VALUE=1),
E = vapply(1:nline,function(ll) max(lx[ww$line$begin[ll]:ww$line$end[ll]]),FUN.VALUE=1),
N = vapply(1:nline,function(ll) max(ly[ww$line$begin[ll]:ww$line$end[ll]]),FUN.VALUE=1)
)
lf <- file(lfile, open="wb")
# header part
writeBin(as.integer(2),lf,size=type_settings$int) # 2=line type "sphere"
writeBin(as.integer(nline),lf,size=type_settings$int)
# for every line: offset, npair, left & right polygon, SW & NE limits
offset <- 2*type_settings$int + nline * (type_settings$int + 4*type_settings$short + 4*type_settings$float)
if (any(ww$line$length >= 2^(8*type_settings$short - 1))) stop("Line length too long: R can not write unsigned short.")
for(i in 1:nline){
writeBin(as.integer(offset),lf,size=type_settings$int)
writeBin(as.integer(ww$line$length[i]),lf,size=type_settings$short)
writeBin(as.integer(ww$line$left[i]),lf,size=type_settings$short)
writeBin(as.integer(ww$line$right[i]),lf,size=type_settings$short)
writeBin(as.integer(0),lf,size=type_settings$short) # padding: a hack
writeBin(as.numeric(line.limits[i,]),lf,size=type_settings$float)
offset <- offset + 2*ww$line$length[i]*type_settings$float
}
# xy data
xy <- rbind(lx,ly)[,!is.na(lx)]
writeBin(as.numeric(xy),lf,size=type_settings$float)
close(lf)
################
# POLYGON DATA #
################
gfile <- paste(outfile,'.G',sep='')
system(paste('rm -f',gfile))
# SW and NE limits of every polygon (calculate from the line element limits OR reconstitute whole polygon)
gon.limits <- data.frame(
W = vapply(1:ngon, function(gg) min(line.limits$W[which(1:nline %in%
abs(ww$gondata[ww$gon$begin[gg]:ww$gon$end[gg]]))]),FUN.VALUE=1),
S = vapply(1:ngon, function(gg) min(line.limits$S[which(1:nline %in%
abs(ww$gondata[ww$gon$begin[gg]:ww$gon$end[gg]]))]),FUN.VALUE=1),
E = vapply(1:ngon, function(gg) max(line.limits$E[which(1:nline %in%
abs(ww$gondata[ww$gon$begin[gg]:ww$gon$end[gg]]))]),FUN.VALUE=1),
N = vapply(1:ngon, function(gg) max(line.limits$N[which(1:nline %in%
abs(ww$gondata[ww$gon$begin[gg]:ww$gon$end[gg]]))]),FUN.VALUE=1)
)
gf <- file(gfile, open="wb")
# header
writeBin(as.integer(ngon),gf,size=type_settings$short)
offset <- type_settings$short + ngon * (type_settings$int + 4*type_settings$char + 4*type_settings$float)
for (i in 1:ngon) {
writeBin(as.integer(offset),gf,size=type_settings$int)
writeBin(as.integer(ww$gon$length[i]),gf,size=type_settings$char)
writeBin(integer(3),gf,size=type_settings$char) #padding
writeBin(as.numeric(gon.limits[i,]),gf,size=type_settings$float)
offset <- offset + ww$gon$length[i] * type_settings$int
}
# data
writeBin(as.integer(ww$gondata[!is.na(ww$gondata)]),gf,size=type_settings$int)
close(gf)
#########
# NAMES # (identical to ascii version!)
#########
nfile <- paste(outfile,'.N',sep='')
system(paste('rm -f',nfile))
write.table(cbind(ww$names,seq_along(ww$names)),sep='\t',
quote=FALSE,col.names=FALSE,row.names=FALSE,
file=nfile)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.