n <- 50
x <- rnorm(n)*10
y <- rnorm(n)*10
plot(x, y, col = "red", pch = 20)
pointLabel(x, y, as.character(round(x,5)), offset = 0, cex = .7)
plot(x, y, col = "red", pch = 20)
pointLabel(x, y, expression(over(alpha, beta[123])), offset = 0, cex = .8)
res <- getinfo.shape(system.file("shapes/fylk-val.shp", package="maptools")[1])
res
str(res)
xx <- readShapeLines(system.file("shapes/fylk-val.shp", package="maptools")[1],
proj4string=CRS("+proj=utm +zone=33 +datum=WGS84"))
plot(xx, col="blue")
summary(xx)
xxx <- xx[xx$LENGTH > 30000,]
plot(xxx, col="red", add=TRUE)
tmpfl <- paste(tempdir(), "xxline", sep="/")
writeLinesShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
axx <- readShapeLines(tmpfl, proj4string=CRS("+proj=utm +zone=33 +datum=WGS84"))
plot(xxx, col="black", lwd=4)
plot(axx, col="yellow", lwd=1, add=TRUE)
unlink(paste(tmpfl, ".*", sep=""))
xx <- readShapeLines(system.file("shapes/sids.shp", package="maptools")[1],
proj4string=CRS("+proj=longlat +datum=NAD27"))
plot(xx, col="blue")
library(maptools)
xx <- readShapeSpatial(system.file("shapes/sids.shp", package="maptools")[1],
IDvar="FIPSNO", proj4string=CRS("+proj=longlat +ellps=clrk66"))
summary(xx)
xxx <- xx[xx$SID74 < 2,]
tmpfl <- paste(tempdir(), "xxpoly", sep="/")
writeSpatialShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
unlink(paste(tmpfl, ".*", sep=""))
xx <- readShapeSpatial(system.file("shapes/fylk-val.shp",
package="maptools")[1], proj4string=CRS("+proj=utm +zone=33 +datum=WGS84"))
summary(xx)
xxx <- xx[xx$LENGTH > 30000,]
plot(xxx, col="red", add=TRUE)
tmpfl <- paste(tempdir(), "xxline", sep="/")
writeSpatialShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
unlink(paste(tmpfl, ".*", sep=""))
xx <- readShapeSpatial(system.file("shapes/baltim.shp", package="maptools")[1])
summary(xx)
xxx <- xx[xx$PRICE < 40,]
tmpfl <- paste(tempdir(), "xxpts", sep="/")
writeSpatialShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
unlink(paste(tmpfl, ".*", sep=""))
library(maptools)
xx <- readShapePoly(system.file("shapes/sids.shp", package="maptools")[1],
IDvar="FIPSNO", proj4string=CRS("+proj=longlat +ellps=clrk66"))
plot(xx, border="blue", axes=TRUE, las=1)
text(coordinates(xx), labels=row.names(xx), cex=0.6)
as(xx, "data.frame")[1:5, 1:6]
xxx <- xx[xx$SID74 < 2,]
plot(xxx, border="red", add=TRUE)
tmpfl <- paste(tempdir(), "xxpoly", sep="/")
writePolyShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
axx <- readShapePoly(tmpfl, proj4string=CRS("+proj=longlat +ellps=clrk66"))
plot(xxx, border="black", lwd=4)
plot(axx, border="yellow", lwd=1, add=TRUE)
unlink(paste(tmpfl, ".*", sep=""))
library(maptools)
xx <- readShapePoints(system.file("shapes/baltim.shp", package="maptools")[1])
plot(xx)
summary(xx)
xxx <- xx[xx$PRICE < 40,]
tmpfl <- paste(tempdir(), "xxpts", sep="/")
writePointsShape(xxx, tmpfl)
getinfo.shape(paste(tmpfl, ".shp", sep=""))
axx <- readShapePoints(tmpfl)
plot(axx, col="red", add=TRUE)
unlink(paste(tmpfl, ".*", sep=""))
xx <- readShapePoints(system.file("shapes/pointZ.shp", package="maptools")[1])
dimensions(xx)
plot(xx)
summary(xx)
n <- 15
x <- rnorm(n)*10
y <- rnorm(n)*10
labels <- as.character(round(x, 5))
myTheme <- list(add.text=list(
cex=0.7,
col='midnightblue',
fontface=2,
fontfamily='mono'))
library(lattice)
xyplot(y~x,
labels=labels,
par.settings=myTheme,
panel=function(x, y, labels, ...){
panel.xyplot(x, y, ...)
panel.pointLabel(x, y, labels=labels, ...)
})
data(meuse.grid)
coordinates(meuse.grid) = ~x+y
proj4string(meuse.grid) <- CRS("+init=epsg:28992")
gridded(meuse.grid) = TRUE
pts <- spsample(meuse.grid, n=15, type="random")
Rauthors <- readLines(file.path(R.home("doc"), "AUTHORS"))[9:28]
someAuthors <- Rauthors[seq_along(pts)]
sl1 <- list('sp.points', pts, pch=19, cex=.8, col='midnightblue')
sl2 <- list('sp.pointLabel', pts, label=someAuthors,
cex=0.7, col='midnightblue',
fontfamily='Palatino')
run <- FALSE
if (require("RColorBrewer", quietly=TRUE)) run <- TRUE
if (run) {
myCols <- adjustcolor(colorRampPalette(brewer.pal(n=9, 'Reds'))(100), .85)
spplot(meuse.grid["dist"], col.regions=myCols, sp.layout=list(sl1, sl2))
}
data(meuse.grid)
coordinates(meuse.grid) = ~x+y
proj4string(meuse.grid) <- CRS("+init=epsg:28992")
gridded(meuse.grid) = TRUE
data(meuse)
coordinates(meuse) = ~x+y
data(meuse.riv)
meuse.sl <- SpatialLines(list(Lines(list(Line(meuse.riv)), "1")))
run <- FALSE
if (require("RColorBrewer", quietly=TRUE)) run <- TRUE
if (run) {
myCols <- adjustcolor(colorRampPalette(brewer.pal(n=9, 'Reds'))(100), .85)
labs <- label(meuse.sl, 'Meuse River')
## Maximum depth
sl1 <- list('sp.lineLabel', meuse.sl, label=labs,
position='below', textloc='maxDepth',
spar=.2,
col='darkblue', cex=1,
fontfamily='Palatino',
fontface=2)
spplot(meuse.grid["dist"],
col.regions=myCols,
sp.layout = sl1)
## Constant slope
sl2 <- modifyList(sl1, list(textloc = 'constantSlope')) ## Default
spplot(meuse.grid["dist"],
col.regions=myCols,
sp.layout = sl2)
## Location defined by its numeric index
sl3 <- modifyList(sl1, list(textloc = 140, position='above'))
spplot(meuse.grid["dist"],
col.regions=myCols,
sp.layout = sl3)
}
## Location of Helsinki, Finland, in decimal degrees,
## as listed in NOAA's website
hels <- matrix(c(24.97, 60.17), nrow=1)
Hels <- SpatialPoints(hels, proj4string=CRS("+proj=longlat +datum=WGS84"))
d041224 <- as.POSIXct("2004-12-24", tz="EET")
## Astronomical dawn
crepuscule(hels, d041224, solarDep=18, direction="dawn", POSIXct.out=TRUE)
crepuscule(Hels, d041224, solarDep=18, direction="dawn", POSIXct.out=TRUE)
## Nautical dawn
crepuscule(hels, d041224, solarDep=12, direction="dawn", POSIXct.out=TRUE)
crepuscule(Hels, d041224, solarDep=12, direction="dawn", POSIXct.out=TRUE)
## Civil dawn
crepuscule(hels, d041224, solarDep=6, direction="dawn", POSIXct.out=TRUE)
crepuscule(Hels, d041224, solarDep=6, direction="dawn", POSIXct.out=TRUE)
solarnoon(hels, d041224, POSIXct.out=TRUE)
solarnoon(Hels, d041224, POSIXct.out=TRUE)
solarpos(hels, as.POSIXct(Sys.time(), tz="EET"))
solarpos(Hels, as.POSIXct(Sys.time(), tz="EET"))
sunriset(hels, d041224, direction="sunrise", POSIXct.out=TRUE)
sunriset(Hels, d041224, direction="sunrise", POSIXct.out=TRUE)
## Using a sequence of dates
Hels_seq <- seq(from=d041224, length.out=365, by="days")
up <- sunriset(Hels, Hels_seq, direction="sunrise", POSIXct.out=TRUE)
down <- sunriset(Hels, Hels_seq, direction="sunset", POSIXct.out=TRUE)
day_length <- down$time - up$time
plot(Hels_seq, day_length, type="l")
opt_exask <- options(example.ask=FALSE)
qk <- SpatialPointsDataFrame(quakes[, c(2:1)], quakes)
summary(Sobj_SpatialGrid(qk)$SG)
t2 <- Sobj_SpatialGrid(qk, n=10000)$SG
summary(t2)
prod(slot(slot(t2, "grid"), "cells.dim"))
proj4string(qk) <- CRS("+proj=longlat +ellps=WGS84")
tf <- tempfile()
SGqk <- GE_SpatialGrid(qk)
png(file=paste(tf, ".png", sep=""), width=SGqk$width, height=SGqk$height,
bg="transparent")
par(mar=c(0,0,0,0), xaxs="i", yaxs="i")
plot(qk, xlim=SGqk$xlim, ylim=SGqk$ylim, setParUsrBB=TRUE)
dev.off()
kmlOverlay(SGqk, paste(tf, ".kml", sep=""), paste(tf, ".png", sep=""))
options(example.ask=opt_exask)
data(wrld_simpl)
## creates a KML file containing the polygons of South Africa (plus hole)
sw <- slot(wrld_simpl[wrld_simpl$NAME=="South Africa",], "polygons")[[1]]
tf <- tempfile()
kmlPolygon(sw, kmlfile=tf, name="South Africa", col="#df0000aa", lwd=5,
border=4, kmlname="R Test",
kmldescription="This is only a R test.")
zz <- getKMLcoordinates(tf, ignoreAltitude=TRUE)
str(zz)
zz <- getKMLcoordinates(system.file("shapes/Testing.kml", package="maptools"))
str(zz)
xx <- readShapeSpatial(system.file("shapes/fylk-val-ll.shp",
package="maptools")[1], proj4string=CRS("+proj=longlat +ellps=WGS84"))
out <- sapply(slot(xx, "lines"), function(x) { kmlLine(x,
name=slot(x, "ID"), col="blue", lwd=1.5,
description=paste("river:", slot(x, "ID"))) })
tf <- tempfile()
kmlFile <- file(tf, "w")
tf
cat(kmlLine(kmlname="R Test", kmldescription="Hello")$header,
file=kmlFile, sep="\n")
cat(unlist(out["style",]), file=kmlFile, sep="\n")
cat(unlist(out["content",]), file=kmlFile, sep="\n")
cat(kmlLine()$footer, file=kmlFile, sep="\n")
close(kmlFile)
rivers <- readShapeSpatial(system.file("shapes/fylk-val-ll.shp",
package="maptools")[1], proj4string=CRS("+proj=longlat +ellps=WGS84"))
# create kml file
td <- tempdir()
kmlfile <- paste(td, "rivers.kml", sep="/")
kmlLines(rivers, kmlfile = kmlfile, name = "R Lines",
description = "Hello!", col = "blue", visibility = 1, lwd = 1,
kmlname = "", kmldescription = "")
opt_exask <- options(example.ask=FALSE)
qk <- SpatialPointsDataFrame(quakes[, c(2:1)], quakes)
proj4string(qk) <- CRS("+proj=longlat +ellps=WGS84")
tf <- tempfile()
SGqk <- GE_SpatialGrid(qk)
png(file=paste(tf, ".png", sep=""), width=SGqk$width, height=SGqk$height,
bg="transparent")
par(mar=c(0,0,0,0), xaxs="i", yaxs="i")
plot(qk, xlim=SGqk$xlim, ylim=SGqk$ylim, setParUsrBB=TRUE)
dev.off()
kmlOverlay(SGqk, paste(tf, ".kml", sep=""), paste(tf, ".png", sep=""))
options(example.ask=opt_exask)
data(SplashDams)
num <- length(SplashDams)
td <- tempdir()
kmlfile <- paste(td, "OregonSplashDams.kml", sep="/")
kmlname <- "Oregon Splash Dams"
kmldescription <- paste("Data for Splash Dams in western Oregon.",
"See http://www.fs.fed.us/pnw/lwm/aem/people/burnett.html#projects_activities",
"for more information.")
icon <- "http://www.gstatic.com/mapspro/images/stock/962-wht-diamond-blank.png"
name <- paste("Dam on",SplashDams$streamName)
description <- paste("owner:", SplashDams$owner, "dates:", SplashDams$datesUsed)
kmlPoints(SplashDams, kmlfile=kmlfile, name=name, description=description,
icon=icon, kmlname=kmlname, kmldescription=kmldescription)
data(wrld_simpl)
## creates a KML file containing the polygons of South Africa (plus hole)
sw <- slot(wrld_simpl[wrld_simpl$NAME=="South Africa",], "polygons")[[1]]
tf <- tempfile()
kmlPolygon(sw, kmlfile=tf, name="South Africa", col="#df0000aa", lwd=5,
border=4, kmlname="R Test",
kmldescription="This is only a R test.")
tf
## creates a KML file containing the polygons of South Africa, Switzerland, and Canada
sw <- wrld_simpl[wrld_simpl$NAME %in% c("South Africa", "Switzerland", "Canada"),]
out <- sapply(slot(sw, "polygons"), function(x) { kmlPolygon(x,
name=as(sw, "data.frame")[slot(x, "ID"), "NAME"],
col="red", lwd=1.5, border='black',
description=paste("ISO3:", slot(x, "ID"))) })
tf <- tempfile()
kmlFile <- file(tf, "w")
tf
cat(kmlPolygon(kmlname="R Test", kmldescription="Hello")$header,
file=kmlFile, sep="\n")
cat(unlist(out["style",]), file=kmlFile, sep="\n")
cat(unlist(out["content",]), file=kmlFile, sep="\n")
cat(kmlPolygon()$footer, file=kmlFile, sep="\n")
close(kmlFile)
data(wrld_simpl)
td <- tempdir()
kmlfile <- paste(td, "worldPolitical.kml", sep="/")
## creates a KML file containing the polygons of a political world map
kmlPolygons(wrld_simpl, kmlfile = kmlfile, name = "KML Polygons",
description = "the world", col = "red",
visibility = 1, lwd = 1, border = "white", kmlname = "R Test",
kmldescription = "This is only a R test.")
data(wrld_simpl)
## create a KML file containing the polygons of Brazil, Uganda, and Canada
regions <- c("Brazil","Canada","Uganda")
wrld_simpl_subset <- wrld_simpl[wrld_simpl$NAME %in% regions,]
kmlfile <- paste(td, "worldPoliticalSubset.kml", sep="/")
kmlPolygons(wrld_simpl_subset, kmlfile = kmlfile,
name = "KML Polygons subset", description = "three countries", col = "blue",
visibility = 1, lwd = 1, border = "white", kmlname = "R Test 2",
kmldescription = "This is only a R test.")
## combine to make a list of polygon objects to plot
polList <- c(regions,wrld_simpl)
kmlfile <- paste(td, "worldPoliticalandSubset.kml", sep="/")
kmlPolygons(wrld_simpl_subset, kmlfile = kmlfile,
name = "KML Polygons subset", description = "three countries highlighted in world",
col = sample(colours(), length(polList)), visibility = 1, lwd = 1, border = "white",
kmlname = "R Test 2",
kmldescription = "This is only a R test.")
Run the code above in your browser using DataCamp Workspace